insertblock在CAD2010中总出错

157787698

; X. `. S( ^1 t, O" O; G! I用insertblock向图纸中插入块，代码如下：
, V# \7 j0 z" z% s

1. 
   % {  m% N5 D1 s2 ~  x. n7 r
2.     Dim insertionPnt(0 To 2) As Double
   % I! _6 E+ X; `- i  G. v# r# n
3.     Dim blockRefObj As AcadBlockReference
   0 Z* L4 |, i# C( l" {( [% u5 t
4.     insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0
   
5.     Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, "d:\drawing8.dwg", 1#, 1#, 1#, 0)
   0 c! }. \; ^, w
6.     ZoomAll
   & C! E+ w* K$ k& I* c' C& F& B2 b

复制代码

, ?5 G% D7 l8 S" `在CAD2006中没有问题，但是一旦拿到CAD2010中就有问题：
当在第一次使用的图纸中重复使用时，没有问题；
但是一旦关掉第一次使用的那张图纸，在新建的图纸中使用的时候就会跳错，提示如下：
, ^7 n! z6 m  v* L3 G6 f; W
请大虾们帮助解决，或提供其他思路，非常感谢。

157787698

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

157787698

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

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

woaishuijia

貌似这是 ACAD 高版本 ActiveX 的一个BUG,到目前为止我们似乎还只能绕开它.
可用的方法大体上有下面几种:
" z, `: y  b4 M3 l一.使用 Document 对象的 SendCommand 方法
/ |$ v$ a. W- |2 |

1. 
   " Q5 d+ t1 N* q% d+ c# V1 m( ^. l4 d, Z8 V; m
2. ThisDrawing.SendCommand "-insert d:\drawing8.dwg" & vbCr & "2,2,0 1 1 0 "
   ! ]% Y* O- I/ Y! h: M, g

复制代码

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

1. 
   9 _! w0 Y. u# K' m/ D. e
2. Dim AxDbDoc As New AxDbDocument, Objs(0) As AcadBlockReference, Inserted As Boolean
   
3.    
   / t$ _+ s* j/ G$ f+ m, a
4. Sub Sub1()
   
5.     Dim insertionPnt(0 To 2) As Double
   
6.     Dim blockRefObj As AcadBlockReference
   ) m9 S# S( b2 z0 {0 D
7.     Dim V As Variant, P(2) As Double
   
8.    
   # O0 U( ]0 \, s3 Q, v+ D5 K
9.     If Not Inserted Then
   $ e* M7 Y/ t$ Z9 y# Y: z6 a
10.         Set Objs(0) = AxDbDoc.ModelSpace.InsertBlock(P, "d:\drawing8.dwg", 1, 1, 1, 0)
    * k8 i) r4 C7 T! q% C
11.         Inserted = True
    
12.     End If
    ! X) C, L5 c% q9 X; M
13.    
    
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
    ! U% E/ G; ?7 }0 e
18.    
    % i' I0 g0 T! m1 @7 }
19.     ZoomAll
    6 |/ H; c5 b# r- L, I
20. End Sub
    1 f6 J9 Z& l4 x" K2 S

复制代码

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

1. 
   
2. Sub Sub2()
   
3.     Dim insertionPnt(0 To 2) As Double
   " _8 p4 y) m% d' `6 O& U& M
4.     Dim blockRefObj As AcadBlockReference
   ; I0 N& p+ e, y% e
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
   . s! K' i0 R  y8 d0 D1 K, c) x
9. 
   $ z7 i1 K6 y" O5 a1 J
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, _
    * y7 D; B9 o+ ]/ i# {9 B9 J$ w; O
12. ByVal Rotation As Double) As AcadBlockReference
    8 S3 X9 K( Y) J4 i$ M6 G7 y& t
13.     Dim BlockName As String
    
14.     Dim D As New AxDbDocument, E() As AcadEntity, I As Integer, B As AcadBlock, P(2) As Double
    : e$ B) ~# [5 p1 T$ }2 u) t/ B
15.    
    
16.     On Error Resume Next
    
17.    
    - P3 a: [3 l  S8 A* H4 ^% ~
18.     BlockName = Right(Name, Len(Name) - InStrRev(Name, ""))
    
19.     BlockName = Left(BlockName, InStrRev(BlockName, ".") - 1)
    0 K! k2 F& g* Z4 W7 \8 `
20.    
    
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
    ' {: `, y' @7 `2 [1 O5 I
26.             ReDim E(D.ModelSpace.Count - 1)
    - }$ W; v: i# H/ w
27.             For I = 0 To D.ModelSpace.Count - 1
    
28.                 Set E(I) = D.ModelSpace.Item(I)
    0 z6 d; w( U/ Z9 R
29.             Next
    
30.             Set B = Block.Document.Blocks.Add(P, BlockName)
    
31.             D.CopyObjects E, B
    " K# l. f5 O/ x: G
32.         End If
    ' k  O8 {+ a$ s9 u: ]
33.         Set InsertBlock = Block.InsertBlock(InsertionPoint, BlockName, Xscale, Yscale, Zscale, Rotation)
    " l* D: q; h9 f9 G
34.     End If
    
35. End Function
    

复制代码

157787698

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

157787698

数据类型AxDbDocument有提示说用户定义类型未定义

是不是也要引用ObjectDbx 类库？

1 @+ p: z7 }! _+ K还有如何引用ObjectDbx 类库？我在引用列表里没有找到

157787698

通过在开发人员帮助中搜索ObjectDbx找到了
: s0 O. ^- l; }  U
谢谢斑竹

157787698

在引用类库的过程中出现问题
CAD2006对应的类库版本号为16.0
CAD2008对应的类库版本号为17.0
+ d9 S4 E+ k. V3 x$ ~( a( e% [CAD2010对应的类库版本号为18.0

& y; {  t7 T+ g# {/ g本来应该在低版本CAD中引用低版本类库，然后在高版本CAD中应该自动继承为高版本类库

. Q: ~) v9 v& y. p可实际上并不会自动向前继承
% I4 n1 E7 u% m9 m1 A) L( d' t
* S4 x# N) f' K6 d& C: h/ Y请问此问题有没有办法解决呢？