insertblock在CAD2010中总出错

157787698

' V4 P. m; c7 J& C' S; F用insertblock向图纸中插入块，代码如下：
( p+ ^# J$ |: f: x

1. 
   
2.     Dim insertionPnt(0 To 2) As Double
   
3.     Dim blockRefObj As AcadBlockReference
   
4.     insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0
   0 e, Q/ S8 Q3 B# P
5.     Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, "d:\drawing8.dwg", 1#, 1#, 1#, 0)
   
6.     ZoomAll
   4 c4 n# `0 o" |" z1 h

复制代码

. c  o: F% T  t6 v' ?3 `3 u9 m2 U' w& `在CAD2006中没有问题，但是一旦拿到CAD2010中就有问题：
- w. `" n0 L" Z4 u  W$ a当在第一次使用的图纸中重复使用时，没有问题；
( ]$ V, N1 g7 r; m# S. X4 L. d# z但是一旦关掉第一次使用的那张图纸，在新建的图纸中使用的时候就会跳错，提示如下：

请大虾们帮助解决，或提供其他思路，非常感谢。

157787698

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

157787698

难道是因为CAD2010中的thisdrawing需要重新激活？
1 a8 _" ~5 P" d) C) P# X
但为神马其他方法方法没有问题？只发现了insertblock有问题

woaishuijia

貌似这是 ACAD 高版本 ActiveX 的一个BUG,到目前为止我们似乎还只能绕开它.
4 u4 K  a# A; W$ [可用的方法大体上有下面几种:
一.使用 Document 对象的 SendCommand 方法
( Z, g. c/ i+ Z6 {  H  o& l/ P( w

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

复制代码

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

1. 
   / T6 V+ J& d1 b" O4 T
2. Dim AxDbDoc As New AxDbDocument, Objs(0) As AcadBlockReference, Inserted As Boolean
   
3.    
   - T8 \# s  E0 }4 D5 [6 b, u
4. Sub Sub1()
   - \3 R+ W! U( V% I- w- s
5.     Dim insertionPnt(0 To 2) As Double
   
6.     Dim blockRefObj As AcadBlockReference
   : a% f* p+ G8 A9 t6 y3 a. a
7.     Dim V As Variant, P(2) As Double
   
8.    
   $ e, n- j+ |% [6 H8 b0 ?
9.     If Not Inserted Then
   
10.         Set Objs(0) = AxDbDoc.ModelSpace.InsertBlock(P, "d:\drawing8.dwg", 1, 1, 1, 0)
    
11.         Inserted = True
    
12.     End If
    
13.    
      W: d2 M# c. x6 ^2 O
14.     V = AxDbDoc.CopyObjects(Objs, ThisDrawing.ModelSpace)
    * b: l0 N% }% S) h6 f; k/ k( d
15.     Set blockRefObj = V(0)
    0 a6 [: i' N# ^$ h
16.     insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0
    
17.     blockRefObj.Move P, insertionPnt
    0 \9 Q6 o( B0 t4 i" x/ V
18.    
    9 a$ @! h5 V. ?- w4 {
19.     ZoomAll
    0 W! f5 E  X( ~, k! Z. ~
20. End Sub
    9 G& J1 t% g- k5 e$ y

复制代码

三.自己编写一段插入外部块的函数,代替 InsertBlock 方法插入外部块

1. 
   
2. Sub Sub2()
   2 K4 T8 S* w: m% C
3.     Dim insertionPnt(0 To 2) As Double
   
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
   
8. End Sub
   
9. 
   
10. Private Function InsertBlock(ByVal Block As AcadBlock, ByVal InsertionPoint As Variant, _
    # A9 ?% o+ T4 W. B; |$ F1 C: v9 [0 M4 s
11. ByVal Name As String, ByVal Xscale As Double, ByVal Yscale As Double, ByVal Zscale As Double, _
    
12. ByVal Rotation As Double) As AcadBlockReference
    
13.     Dim BlockName As String
    8 I6 z8 w' `; p, a  a, ]
14.     Dim D As New AxDbDocument, E() As AcadEntity, I As Integer, B As AcadBlock, P(2) As Double
    . N; C% c' J! d; C1 Q
15.    
    9 W8 d  g; G! f  Y) U7 @; _! T
16.     On Error Resume Next
    0 p) V& w  M: v  {' j4 K
17.    
    ! f9 ~% u: ^$ s) _( y( p. _9 |
18.     BlockName = Right(Name, Len(Name) - InStrRev(Name, ""))
    + z6 B3 s) j: }1 H9 R
19.     BlockName = Left(BlockName, InStrRev(BlockName, ".") - 1)
    
20.    
    8 {" l  `! [: J; ?" x
21.     Set InsertBlock = Block.InsertBlock(InsertionPoint, BlockName, Xscale, Yscale, Zscale, Rotation)
    ; n2 g8 X3 v' ]
22.    
    
23.     If Err Then
    1 L. @  v/ J3 \! m! ?+ h
24.         D.Open Name
    
25.         If D.ModelSpace.Count > 0 Then
    
26.             ReDim E(D.ModelSpace.Count - 1)
    
27.             For I = 0 To D.ModelSpace.Count - 1
    2 C7 r3 ]  r9 ]6 F9 I) V2 D
28.                 Set E(I) = D.ModelSpace.Item(I)
    
29.             Next
    
30.             Set B = Block.Document.Blocks.Add(P, BlockName)
      q) |2 X- K8 T& h$ f1 W4 ^
31.             D.CopyObjects E, B
    ' L# c* p( C/ F) L
32.         End If
    1 P" K: k/ P% Z$ ~, p
33.         Set InsertBlock = Block.InsertBlock(InsertionPoint, BlockName, Xscale, Yscale, Zscale, Rotation)
    # R( t" G# u2 d7 C- `
34.     End If
    4 j: B8 {) w' Z, c
35. End Function
    

复制代码

157787698

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

157787698

数据类型AxDbDocument有提示说用户定义类型未定义
0 w2 Q: H% m7 i- F! |& A7 E
是不是也要引用ObjectDbx 类库？

+ f* q# c- y* Z还有如何引用ObjectDbx 类库？我在引用列表里没有找到

157787698

通过在开发人员帮助中搜索ObjectDbx找到了
1 `. r9 _) q6 V: R7 F
2 q6 A/ }4 q1 J$ R/ C$ m谢谢斑竹

157787698

在引用类库的过程中出现问题
CAD2006对应的类库版本号为16.0
CAD2008对应的类库版本号为17.0
CAD2010对应的类库版本号为18.0

本来应该在低版本CAD中引用低版本类库，然后在高版本CAD中应该自动继承为高版本类库

可实际上并不会自动向前继承
% p$ V- J' q( N1 t4 n$ V
请问此问题有没有办法解决呢？