insertblock在CAD2010中总出错

157787698

$ A% X6 U7 T7 r9 W  A
用insertblock向图纸中插入块，代码如下：

1. 
   
2.     Dim insertionPnt(0 To 2) As Double
   
3.     Dim blockRefObj As AcadBlockReference
     i, _+ m% R  }+ W
4.     insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0
   . p0 _2 R, n9 Q$ `# {6 t2 ~
5.     Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, "d:\drawing8.dwg", 1#, 1#, 1#, 0)
   3 W  [0 h2 @/ j& W% _
6.     ZoomAll
   0 {9 \% Q4 W1 N5 j6 d: k

复制代码

9 G" S9 ]; M  f3 r
在CAD2006中没有问题，但是一旦拿到CAD2010中就有问题：
当在第一次使用的图纸中重复使用时，没有问题；
& R+ y1 E, t3 V但是一旦关掉第一次使用的那张图纸，在新建的图纸中使用的时候就会跳错，提示如下：

. F+ ~0 `% c" E; J+ j& e1 a请大虾们帮助解决，或提供其他思路，非常感谢。

157787698

其实图纸内容是神马都无所谓的，一样会跳错

157787698

难道是因为CAD2010中的thisdrawing需要重新激活？
. S+ L# Z0 P, _2 I, g9 v: J  Y6 Q
8 O& y- v6 g* P但为神马其他方法方法没有问题？只发现了insertblock有问题

woaishuijia

貌似这是 ACAD 高版本 ActiveX 的一个BUG,到目前为止我们似乎还只能绕开它.
可用的方法大体上有下面几种:
% t2 d0 t! i+ v一.使用 Document 对象的 SendCommand 方法

1. 
   ( j7 B- S2 ?0 x- L4 n" x% l$ W8 F. l, v8 n
2. ThisDrawing.SendCommand "-insert d:\drawing8.dwg" & vbCr & "2,2,0 1 1 0 "
   8 s& H+ Z/ v# _6 v/ _2 [) D

复制代码

) ^7 i# O1 J  n0 e6 ]) x5 [二.首先创建一个用于过渡(中间?辅助?)的新文档,并做为全局变量,用 InsertBlock 方法插入外部块参照.当其它文档需要插入该外部块参照时,从这个过渡(中间?辅助?)文档中拷贝过来,而不再使用 InsertBlock 方法
5 f5 \6 }' D4 J9 d% X6 h* S下面两段代码中都引用了 ObjectDbx 类库,目的是在后台运行这个过渡(中间?辅助?)文档,以免它在前台添乱.运行下面两段代码前应引用 ObjectDbx 类库

1. 
   
2. Dim AxDbDoc As New AxDbDocument, Objs(0) As AcadBlockReference, Inserted As Boolean
   * W+ B8 w* g; q! O, G. J7 j" P  m
3.    
   
4. Sub Sub1()
   
5.     Dim insertionPnt(0 To 2) As Double
   " d7 A" F5 Y: v! P
6.     Dim blockRefObj As AcadBlockReference
   
7.     Dim V As Variant, P(2) As Double
   5 u! J% e: W" O4 D6 O  s
8.    
   * I# ^, Z2 j  R' m& S7 W/ {4 h
9.     If Not Inserted Then
   % o" u5 P, |3 k8 M- {! D
10.         Set Objs(0) = AxDbDoc.ModelSpace.InsertBlock(P, "d:\drawing8.dwg", 1, 1, 1, 0)
    7 \4 J6 R- k( x; G! X# q) `
11.         Inserted = True
    
12.     End If
    # X; \3 |1 Q4 U. x
13.    
    ) w# q& f/ G+ z+ B# e2 U1 D
14.     V = AxDbDoc.CopyObjects(Objs, ThisDrawing.ModelSpace)
    
15.     Set blockRefObj = V(0)
    ) E6 m; K" p! P: S; j/ L- O8 }
16.     insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0
    
17.     blockRefObj.Move P, insertionPnt
    
18.    
    " o" y9 ?' G/ s
19.     ZoomAll
    1 d: f( E' W6 e: E9 }
20. End Sub
    # i3 J- ]; n5 V0 d* V" J  |$ j9 e

复制代码

三.自己编写一段插入外部块的函数,代替 InsertBlock 方法插入外部块
- K1 b0 v* Q, R, ~4 r; }" \7 Z

1. 
   
2. Sub Sub2()
   " L; ]% f  R; ]$ f* M) f
3.     Dim insertionPnt(0 To 2) As Double
   
4.     Dim blockRefObj As AcadBlockReference
   : w  f9 K; o# H# i1 G8 ~& @
5.     insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0
   / c8 ^$ P1 n1 v
6.     Set blockRefObj = InsertBlock(ThisDrawing.ModelSpace, insertionPnt, "d:\drawing8.dwg", 1#, 1#, 1#, 0)
   2 o+ d2 A4 `: }. h* C7 b8 Y- V! p
7.     ZoomAll
   2 D. A. A( G/ u% N; W# E' v* ?
8. End Sub
   
9. 
   # i: P* G; x* s- z1 A/ g' X
10. Private Function InsertBlock(ByVal Block As AcadBlock, ByVal InsertionPoint As Variant, _
    
11. ByVal Name As String, ByVal Xscale As Double, ByVal Yscale As Double, ByVal Zscale As Double, _
    + o6 p3 N/ j$ x; ], D. K/ b; g
12. ByVal Rotation As Double) As AcadBlockReference
    
13.     Dim BlockName As String
      }) [) e* U9 E! T; \4 z
14.     Dim D As New AxDbDocument, E() As AcadEntity, I As Integer, B As AcadBlock, P(2) As Double
    
15.    
    
16.     On Error Resume Next
    / t& V: r* O$ ?. g* w
17.    
    ' q. O) E" i- N0 ~
18.     BlockName = Right(Name, Len(Name) - InStrRev(Name, ""))
    ) c8 c/ {* u7 f. f6 h, y! j
19.     BlockName = Left(BlockName, InStrRev(BlockName, ".") - 1)
    - m' h: R3 P/ x( Q' X( D/ W5 c
20.    
    " K! ]' h- M0 _* m. }
21.     Set InsertBlock = Block.InsertBlock(InsertionPoint, BlockName, Xscale, Yscale, Zscale, Rotation)
    / u1 Q/ t/ v( l, T, Q0 p! Y: K+ E! p
22.    
    6 A! g0 a. b$ \# c; [5 K
23.     If Err Then
    
24.         D.Open Name
    1 J$ a1 ~) ^& X# N* ?. x) g% z3 S
25.         If D.ModelSpace.Count > 0 Then
    
26.             ReDim E(D.ModelSpace.Count - 1)
    
27.             For I = 0 To D.ModelSpace.Count - 1
    ) r7 y0 \6 w" C
28.                 Set E(I) = D.ModelSpace.Item(I)
    
29.             Next
    
30.             Set B = Block.Document.Blocks.Add(P, BlockName)
    3 b8 q' P! m: r: o
31.             D.CopyObjects E, B
    
32.         End If
    
33.         Set InsertBlock = Block.InsertBlock(InsertionPoint, BlockName, Xscale, Yscale, Zscale, Rotation)
    
34.     End If
    ! c8 u0 B( V* p" I5 k  t
35. End Function
    9 U! B/ l/ g6 ?1 |7 X# ~  Q

复制代码

157787698

斑竹老兄，你太强了，对你的崇拜犹如滔滔江水延绵不绝啊

157787698

数据类型AxDbDocument有提示说用户定义类型未定义
' T  C2 {4 c0 q/ g( K
; X: m$ Y7 K2 n& h2 n: ?1 d1 t. q是不是也要引用ObjectDbx 类库？
3 {. E) i* c7 a, V" a2 B2 r0 r
; b8 q. I7 |4 m- ]6 P还有如何引用ObjectDbx 类库？我在引用列表里没有找到

157787698

通过在开发人员帮助中搜索ObjectDbx找到了
8 L3 l. {/ L6 x3 o/ E
谢谢斑竹

157787698

在引用类库的过程中出现问题
CAD2006对应的类库版本号为16.0
CAD2008对应的类库版本号为17.0
CAD2010对应的类库版本号为18.0
' ]# h; D( t/ q* o& U+ U9 u- @
# p+ v! L: [$ T4 s# K本来应该在低版本CAD中引用低版本类库，然后在高版本CAD中应该自动继承为高版本类库

& Z1 f6 @3 n# d! z7 a+ f8 |可实际上并不会自动向前继承

5 ]" o" C3 F$ o3 h, ?请问此问题有没有办法解决呢？