insertblock在CAD2010中总出错

157787698

5 Z* L# w& K3 r0 Z) P* A用insertblock向图纸中插入块，代码如下：

1. 
   , Z7 W6 u+ j% y4 T
2.     Dim insertionPnt(0 To 2) As Double
   : Y! p& F- z* ?! ^  j) V7 \! ?" {, I
3.     Dim blockRefObj As AcadBlockReference
   + M( C, F% O: x
4.     insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0
   - e! ?  D" T* n) A. q% B  f
5.     Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, "d:\drawing8.dwg", 1#, 1#, 1#, 0)
     ^+ O. ~4 ?# c" N- a
6.     ZoomAll
   ; N8 ^1 ^7 M& `& T8 ~

复制代码

5 g" D! G% f+ J: g7 q, K9 {4 @; ?  e
在CAD2006中没有问题，但是一旦拿到CAD2010中就有问题：
$ U- i5 a. }% N- |. V8 p当在第一次使用的图纸中重复使用时，没有问题；
但是一旦关掉第一次使用的那张图纸，在新建的图纸中使用的时候就会跳错，提示如下：
- T4 M1 a) f9 f: n! Z* M1 x. O
请大虾们帮助解决，或提供其他思路，非常感谢。

157787698

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

157787698

难道是因为CAD2010中的thisdrawing需要重新激活？
8 Z! |9 C; z) z( X
6 @9 a3 s" a# ^) P1 v. o# r  C但为神马其他方法方法没有问题？只发现了insertblock有问题

woaishuijia

貌似这是 ACAD 高版本 ActiveX 的一个BUG,到目前为止我们似乎还只能绕开它.
可用的方法大体上有下面几种:
一.使用 Document 对象的 SendCommand 方法
: |8 ]% z: `. ^; C' B, T

1. 
   
2. ThisDrawing.SendCommand "-insert d:\drawing8.dwg" & vbCr & "2,2,0 1 1 0 "
   4 U) c, w( k% A* s( n8 w6 O: M

复制代码

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

1. 
   ( s3 h1 M8 n" s% i
2. Dim AxDbDoc As New AxDbDocument, Objs(0) As AcadBlockReference, Inserted As Boolean
   0 W1 T6 j2 q$ N8 H. \
3.    
   
4. Sub Sub1()
   
5.     Dim insertionPnt(0 To 2) As Double
   : G. v) B$ k) S5 }$ I- J
6.     Dim blockRefObj As AcadBlockReference
   7 l( J/ _$ q% ]" a
7.     Dim V As Variant, P(2) As Double
   * w% [' `0 G% n+ {) F
8.    
   & H; d& V% r1 @& X9 H& c
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
      D0 D% X  `3 l" F4 j5 [0 Y+ V1 \
13.    
    ) u: `+ F5 X& e- P! ?' F6 X( [
14.     V = AxDbDoc.CopyObjects(Objs, ThisDrawing.ModelSpace)
    . L" B( S9 s1 I, |
15.     Set blockRefObj = V(0)
    
16.     insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0
    9 l6 y0 @" p! g. A! T4 v7 R2 N: Q
17.     blockRefObj.Move P, insertionPnt
    * j$ x- I8 T4 f6 {9 _
18.    
    
19.     ZoomAll
    3 I% u' f" ^+ ]. X8 C7 Q2 E
20. End Sub
    # T' {; x+ ]9 ]! U

复制代码

三.自己编写一段插入外部块的函数,代替 InsertBlock 方法插入外部块
0 Q1 o/ p- U, A& |% i. F

1. 
   
2. Sub Sub2()
   
3.     Dim insertionPnt(0 To 2) As Double
   8 ~% y- H- v' R
4.     Dim blockRefObj As AcadBlockReference
   $ U* _( O9 c( W* k) B. E, f  _
5.     insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0
   * I$ o; q! H7 k0 c1 i# C% k
6.     Set blockRefObj = InsertBlock(ThisDrawing.ModelSpace, insertionPnt, "d:\drawing8.dwg", 1#, 1#, 1#, 0)
   
7.     ZoomAll
   ( d& w# z6 }, d6 [. x# o
8. End Sub
   
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, _
    4 p8 z) Z! R0 K8 _. ^1 [7 H. U+ L+ y
12. ByVal Rotation As Double) As AcadBlockReference
    : b( F+ f% H+ I* V, P! ^
13.     Dim BlockName As String
    - c3 z6 n. `% e4 Z
14.     Dim D As New AxDbDocument, E() As AcadEntity, I As Integer, B As AcadBlock, P(2) As Double
    + m6 a' _/ D% E! f5 B$ {3 S
15.    
    4 w( B+ D1 o3 {/ a
16.     On Error Resume Next
    
17.    
    1 e0 h$ k. ^' @$ Y
18.     BlockName = Right(Name, Len(Name) - InStrRev(Name, ""))
    
19.     BlockName = Left(BlockName, InStrRev(BlockName, ".") - 1)
    / y2 K5 U+ [3 S2 W. B$ B
20.    
    
21.     Set InsertBlock = Block.InsertBlock(InsertionPoint, BlockName, Xscale, Yscale, Zscale, Rotation)
    5 _% d$ v2 \- O9 T9 |0 \
22.    
    
23.     If Err Then
    ' _9 L! i! U7 W* A
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
    0 Y$ r. H2 D3 p1 G# ^7 L
28.                 Set E(I) = D.ModelSpace.Item(I)
    
29.             Next
    
30.             Set B = Block.Document.Blocks.Add(P, BlockName)
    
31.             D.CopyObjects E, B
    1 h' T" W2 |; q- l( Q* x
32.         End If
    0 f7 E" @* i  f, I9 Z8 R* a
33.         Set InsertBlock = Block.InsertBlock(InsertionPoint, BlockName, Xscale, Yscale, Zscale, Rotation)
    
34.     End If
    % f3 U6 S, t+ N' |- b4 k) W
35. End Function
    7 {. ?- m+ r& ]/ d; K

复制代码

157787698

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

157787698

数据类型AxDbDocument有提示说用户定义类型未定义
0 F% C' n+ W, i0 e5 s  h+ n
是不是也要引用ObjectDbx 类库？

0 {% c7 {0 |2 T. V还有如何引用ObjectDbx 类库？我在引用列表里没有找到

157787698

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

谢谢斑竹

157787698

在引用类库的过程中出现问题
. K( W+ m) T; ~* N9 [& N7 QCAD2006对应的类库版本号为16.0
CAD2008对应的类库版本号为17.0
CAD2010对应的类库版本号为18.0
8 D  T# ?* t, U1 B: \
本来应该在低版本CAD中引用低版本类库，然后在高版本CAD中应该自动继承为高版本类库

0 X3 V8 b! Q  T& t- x可实际上并不会自动向前继承

& O1 |8 ?8 j3 m3 ~请问此问题有没有办法解决呢？