insertblock在CAD2010中总出错

157787698

用insertblock向图纸中插入块，代码如下：
5 g( E6 f8 m- ~9 q

1. 
   4 a, u- ~& f  B
2.     Dim insertionPnt(0 To 2) As Double
   " l3 b, w1 D; N) e7 R
3.     Dim blockRefObj As AcadBlockReference
   7 y2 a( X$ z4 q; r6 O* L) H
4.     insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0
   ! u8 N' B6 o# r1 @* u: A/ E
5.     Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, "d:\drawing8.dwg", 1#, 1#, 1#, 0)
   + b" h" p  Z, r- T
6.     ZoomAll
   ( o" I% W; r5 O4 D6 R5 B* @

复制代码

+ N, {5 H! d, r% V) ~
在CAD2006中没有问题，但是一旦拿到CAD2010中就有问题：
$ @$ g; m% x7 p; h7 a  g当在第一次使用的图纸中重复使用时，没有问题；
但是一旦关掉第一次使用的那张图纸，在新建的图纸中使用的时候就会跳错，提示如下：
" L7 I. L2 G+ y# w' O! @! Q
请大虾们帮助解决，或提供其他思路，非常感谢。

157787698

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

157787698

难道是因为CAD2010中的thisdrawing需要重新激活？

但为神马其他方法方法没有问题？只发现了insertblock有问题

woaishuijia

貌似这是 ACAD 高版本 ActiveX 的一个BUG,到目前为止我们似乎还只能绕开它.
可用的方法大体上有下面几种:
" a' E, m5 p% P一.使用 Document 对象的 SendCommand 方法

1. 
   % d% @) Y# A5 y6 a" }
2. ThisDrawing.SendCommand "-insert d:\drawing8.dwg" & vbCr & "2,2,0 1 1 0 "
   

复制代码

二.首先创建一个用于过渡(中间?辅助?)的新文档,并做为全局变量,用 InsertBlock 方法插入外部块参照.当其它文档需要插入该外部块参照时,从这个过渡(中间?辅助?)文档中拷贝过来,而不再使用 InsertBlock 方法
$ O: d2 [4 b& t' f7 T% e% B下面两段代码中都引用了 ObjectDbx 类库,目的是在后台运行这个过渡(中间?辅助?)文档,以免它在前台添乱.运行下面两段代码前应引用 ObjectDbx 类库
) E: a; m/ z6 M0 v1 y

1. 
   
2. Dim AxDbDoc As New AxDbDocument, Objs(0) As AcadBlockReference, Inserted As Boolean
   
3.    
   / M) |" G; Z: S! j4 \
4. Sub Sub1()
   7 z$ h3 y8 F2 z2 X) [( R2 }
5.     Dim insertionPnt(0 To 2) As Double
   
6.     Dim blockRefObj As AcadBlockReference
   $ V# a6 A2 U1 `& X$ R( c: A
7.     Dim V As Variant, P(2) As Double
   + X/ Z* g( [: P; ^. w* D
8.    
   
9.     If Not Inserted Then
   : ?  e1 p) G" x# @9 n
10.         Set Objs(0) = AxDbDoc.ModelSpace.InsertBlock(P, "d:\drawing8.dwg", 1, 1, 1, 0)
    1 d3 p0 V$ A) P; ~( \9 S& K
11.         Inserted = True
    " R8 T( K8 d9 e' T& @# K% }2 E- P
12.     End If
    
13.    
      ]/ I& S1 ]9 B. ]
14.     V = AxDbDoc.CopyObjects(Objs, ThisDrawing.ModelSpace)
    * M, n, ~, R- _. x+ R
15.     Set blockRefObj = V(0)
    
16.     insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0
    
17.     blockRefObj.Move P, insertionPnt
    8 m' b4 m* F, W6 {* t* k, E+ L
18.    
    
19.     ZoomAll
    
20. End Sub
    7 H& N8 R: h; ^' A3 `3 C

复制代码

. ?4 F7 r# t7 S" z1 p9 J& L+ L三.自己编写一段插入外部块的函数,代替 InsertBlock 方法插入外部块
% D9 N  ?5 r  a8 G4 @0 Y

1. 
   
2. Sub Sub2()
   ) y! u3 @! Y. D  D
3.     Dim insertionPnt(0 To 2) As Double
   
4.     Dim blockRefObj As AcadBlockReference
   
5.     insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0
   / t2 Q( C5 o4 ?8 S* O( X
6.     Set blockRefObj = InsertBlock(ThisDrawing.ModelSpace, insertionPnt, "d:\drawing8.dwg", 1#, 1#, 1#, 0)
   
7.     ZoomAll
   ' e) x; [9 ?. g- o* u7 U6 }: Z
8. End Sub
   
9. 
     P* q1 N1 q% R. _4 ]/ {2 X
10. Private Function InsertBlock(ByVal Block As AcadBlock, ByVal InsertionPoint As Variant, _
    ; ^+ u) N  P' H, w$ D- a- M
11. ByVal Name As String, ByVal Xscale As Double, ByVal Yscale As Double, ByVal Zscale As Double, _
      x" j: n( c% V$ W
12. ByVal Rotation As Double) As AcadBlockReference
    
13.     Dim BlockName As String
    5 e$ `4 T, p- j8 y
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
    
17.    
    , L5 p0 ?2 Z1 C- |/ E& H% T$ k: i- Z
18.     BlockName = Right(Name, Len(Name) - InStrRev(Name, ""))
    8 S# Y2 o$ U  f* v9 T; p
19.     BlockName = Left(BlockName, InStrRev(BlockName, ".") - 1)
    
20.    
    9 X) R# ]8 S( k& S# G2 x
21.     Set InsertBlock = Block.InsertBlock(InsertionPoint, BlockName, Xscale, Yscale, Zscale, Rotation)
    
22.    
    
23.     If Err Then
    
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
    
28.                 Set E(I) = D.ModelSpace.Item(I)
    
29.             Next
    
30.             Set B = Block.Document.Blocks.Add(P, BlockName)
    
31.             D.CopyObjects E, B
    : R" Q# J3 `# {* H, z! \9 S
32.         End If
    
33.         Set InsertBlock = Block.InsertBlock(InsertionPoint, BlockName, Xscale, Yscale, Zscale, Rotation)
    : [. j  V3 ^& q$ p8 h1 D8 \/ K' }/ p3 K
34.     End If
    4 j+ W0 B# \9 F. x) I- m
35. End Function
    ) A7 }) t4 J, @) s% {, |

复制代码

157787698

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

157787698

数据类型AxDbDocument有提示说用户定义类型未定义
; j" Z" H- ]( D( E* Y4 J
4 ]2 s2 \2 X5 h/ C; T7 ^% ?. [是不是也要引用ObjectDbx 类库？
6 J4 ]0 O; N, Z! e4 Z5 u0 x, S" }
还有如何引用ObjectDbx 类库？我在引用列表里没有找到

157787698

通过在开发人员帮助中搜索ObjectDbx找到了
, r6 p. D- D+ ~6 M; t
; t% ]. J  ]- q" ~谢谢斑竹

157787698

在引用类库的过程中出现问题
$ Y) U# r5 \1 u" D' G9 x' `+ KCAD2006对应的类库版本号为16.0
CAD2008对应的类库版本号为17.0
. S) [% c/ `9 f2 `4 VCAD2010对应的类库版本号为18.0
1 |0 G+ R2 l: h5 y1 W
! `/ f* t+ J9 Q: R本来应该在低版本CAD中引用低版本类库，然后在高版本CAD中应该自动继承为高版本类库

; J: a+ D9 Z7 p* w$ I9 i0 K3 s! C; F可实际上并不会自动向前继承

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