insertblock在CAD2010中总出错

157787698

  `6 D# B- C; R% Z用insertblock向图纸中插入块，代码如下：

1. 
   
2.     Dim insertionPnt(0 To 2) As Double
   
3.     Dim blockRefObj As AcadBlockReference
   
4.     insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0
   + `5 i9 d# {. B- t5 [; b  p+ w
5.     Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, "d:\drawing8.dwg", 1#, 1#, 1#, 0)
   . G) B' [2 t6 \, T/ C) C  b
6.     ZoomAll
   % w4 c  i5 u  z* K

复制代码

在CAD2006中没有问题，但是一旦拿到CAD2010中就有问题：
$ @9 ^, A7 q1 W( ?* P9 D7 ]8 ^+ M当在第一次使用的图纸中重复使用时，没有问题；
$ k) K% }2 n: n7 V但是一旦关掉第一次使用的那张图纸，在新建的图纸中使用的时候就会跳错，提示如下：

; \) h1 o* l6 [- ~2 Z请大虾们帮助解决，或提供其他思路，非常感谢。

157787698

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

157787698

难道是因为CAD2010中的thisdrawing需要重新激活？
* r% F4 c0 @6 x$ x7 H7 _0 f- N
但为神马其他方法方法没有问题？只发现了insertblock有问题

woaishuijia

貌似这是 ACAD 高版本 ActiveX 的一个BUG,到目前为止我们似乎还只能绕开它.
可用的方法大体上有下面几种:
/ t  ?( b7 h4 b一.使用 Document 对象的 SendCommand 方法

1. 
   
2. ThisDrawing.SendCommand "-insert d:\drawing8.dwg" & vbCr & "2,2,0 1 1 0 "
   

复制代码

二.首先创建一个用于过渡(中间?辅助?)的新文档,并做为全局变量,用 InsertBlock 方法插入外部块参照.当其它文档需要插入该外部块参照时,从这个过渡(中间?辅助?)文档中拷贝过来,而不再使用 InsertBlock 方法
下面两段代码中都引用了 ObjectDbx 类库,目的是在后台运行这个过渡(中间?辅助?)文档,以免它在前台添乱.运行下面两段代码前应引用 ObjectDbx 类库

1. 
   / f5 t0 K; `9 k* E* T
2. Dim AxDbDoc As New AxDbDocument, Objs(0) As AcadBlockReference, Inserted As Boolean
   9 z3 W/ C' P/ H& ?
3.    
   
4. Sub Sub1()
   
5.     Dim insertionPnt(0 To 2) As Double
   : {( u& ?7 Q; ?; ~' o* H) h
6.     Dim blockRefObj As AcadBlockReference
   - j* d' O2 m3 j6 o. m5 j
7.     Dim V As Variant, P(2) As Double
   
8.    
   9 T2 y% C. B- X# ?
9.     If Not Inserted Then
   ( _+ ?, R$ r3 L3 w9 U
10.         Set Objs(0) = AxDbDoc.ModelSpace.InsertBlock(P, "d:\drawing8.dwg", 1, 1, 1, 0)
    
11.         Inserted = True
    ( g8 V( f+ U# o& _2 q
12.     End If
    5 j2 i3 M/ T& G$ L" Q
13.    
    1 n5 f" c) C: Q1 b3 u8 Q
14.     V = AxDbDoc.CopyObjects(Objs, ThisDrawing.ModelSpace)
    
15.     Set blockRefObj = V(0)
    
16.     insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0
    
17.     blockRefObj.Move P, insertionPnt
    
18.    
    
19.     ZoomAll
    5 x& @" a- `2 }% \
20. End Sub
    9 U9 |& ]& T+ M( m; I

复制代码

  w; w3 n9 p$ Q: i. z6 S7 k" n三.自己编写一段插入外部块的函数,代替 InsertBlock 方法插入外部块

1. 
   ! g2 @, k' o! I6 R
2. Sub Sub2()
   
3.     Dim insertionPnt(0 To 2) As Double
   # ]1 s& N. {4 W% |) S
4.     Dim blockRefObj As AcadBlockReference
   
5.     insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0
   
6.     Set blockRefObj = InsertBlock(ThisDrawing.ModelSpace, insertionPnt, "d:\drawing8.dwg", 1#, 1#, 1#, 0)
   
7.     ZoomAll
   4 C' Z$ F# ~8 n' e6 ]7 M$ f
8. End Sub
   / t6 j( c" d9 I+ h5 @* t
9. 
   
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, _
    9 j( J" B) V3 r$ }  D7 \: _& O$ P
12. ByVal Rotation As Double) As AcadBlockReference
    
13.     Dim BlockName As String
    6 F3 y* j0 L* ~* T
14.     Dim D As New AxDbDocument, E() As AcadEntity, I As Integer, B As AcadBlock, P(2) As Double
    
15.    
    - ^% F) S( W5 @  Q% F2 c
16.     On Error Resume Next
    $ f  K! P4 c* N4 h9 X
17.    
    
18.     BlockName = Right(Name, Len(Name) - InStrRev(Name, ""))
    ' K5 i) l; o( f# _
19.     BlockName = Left(BlockName, InStrRev(BlockName, ".") - 1)
    
20.    
    . l3 `* g$ }. k9 h- U
21.     Set InsertBlock = Block.InsertBlock(InsertionPoint, BlockName, Xscale, Yscale, Zscale, Rotation)
    % b; D% `) ~7 J/ H4 ^, x
22.    
    - T* J2 h/ u5 y! D
23.     If Err Then
    / d  }+ W' ~  S" u6 v; D
24.         D.Open Name
    
25.         If D.ModelSpace.Count > 0 Then
    : s% ]" k8 s' e! a$ u
26.             ReDim E(D.ModelSpace.Count - 1)
    % K% J+ w% {: X  T5 s
27.             For I = 0 To D.ModelSpace.Count - 1
    
28.                 Set E(I) = D.ModelSpace.Item(I)
    
29.             Next
    
30.             Set B = Block.Document.Blocks.Add(P, BlockName)
    
31.             D.CopyObjects E, B
    
32.         End If
    # p  f( x. W$ C
33.         Set InsertBlock = Block.InsertBlock(InsertionPoint, BlockName, Xscale, Yscale, Zscale, Rotation)
    
34.     End If
    ; O" I" [+ j3 L% j4 a
35. End Function
    

复制代码

157787698

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

157787698

数据类型AxDbDocument有提示说用户定义类型未定义
7 R9 E& Q( h" e$ u
: H, D9 @$ j% l5 _是不是也要引用ObjectDbx 类库？
' M/ U0 ?8 m" |6 t
& a% a0 R1 i# L# m7 K  L还有如何引用ObjectDbx 类库？我在引用列表里没有找到

157787698

通过在开发人员帮助中搜索ObjectDbx找到了

谢谢斑竹

157787698

在引用类库的过程中出现问题
2 y& R. O5 i$ m. K5 ^. a% ECAD2006对应的类库版本号为16.0
CAD2008对应的类库版本号为17.0
+ ~# N# m6 e+ |" D% t0 CCAD2010对应的类库版本号为18.0

. ]2 b5 j9 i3 ?0 i本来应该在低版本CAD中引用低版本类库，然后在高版本CAD中应该自动继承为高版本类库

可实际上并不会自动向前继承

请问此问题有没有办法解决呢？