insertblock在CAD2010中总出错

157787698

用insertblock向图纸中插入块，代码如下：
1 e, M1 ^2 o- ^) J+ V% @

1. 
   
2.     Dim insertionPnt(0 To 2) As Double
   $ @; k; D& _7 M+ _6 U! s2 E9 Z
3.     Dim blockRefObj As AcadBlockReference
   
4.     insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0
   $ I* Z5 j& C$ I8 T
5.     Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, "d:\drawing8.dwg", 1#, 1#, 1#, 0)
   
6.     ZoomAll
   9 p, Q& l# h5 J; f

复制代码

% Z/ I3 ~/ u+ S' |$ s! m  }
. |, g6 ~: x9 U) C3 u2 i! b在CAD2006中没有问题，但是一旦拿到CAD2010中就有问题：
当在第一次使用的图纸中重复使用时，没有问题；
, i6 [" z/ s  q" j# y但是一旦关掉第一次使用的那张图纸，在新建的图纸中使用的时候就会跳错，提示如下：
1 [. m% J3 {7 m* t* S9 h
" t( A4 L  h/ K& S+ A. x, X请大虾们帮助解决，或提供其他思路，非常感谢。

157787698

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

157787698

难道是因为CAD2010中的thisdrawing需要重新激活？
' y1 X7 \7 G6 ~5 H: q) ]
/ g6 T0 v9 U! G0 o2 S; q; ^但为神马其他方法方法没有问题？只发现了insertblock有问题

woaishuijia

貌似这是 ACAD 高版本 ActiveX 的一个BUG,到目前为止我们似乎还只能绕开它.
. f5 U7 u6 k% [8 z5 _4 b4 x0 ^可用的方法大体上有下面几种:
% U1 x* M8 o" `5 A$ [$ g7 v一.使用 Document 对象的 SendCommand 方法

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

复制代码

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

1. 
   ' [, ]/ c5 D/ d! ~' B% t
2. Dim AxDbDoc As New AxDbDocument, Objs(0) As AcadBlockReference, Inserted As Boolean
   
3.    
   
4. Sub Sub1()
   
5.     Dim insertionPnt(0 To 2) As Double
   5 ^. n9 X( `% o9 u0 G
6.     Dim blockRefObj As AcadBlockReference
   % b* u3 B/ w6 k6 E- Q, v$ D
7.     Dim V As Variant, P(2) As Double
   9 z3 y# J( O+ h& l2 Y
8.    
   2 S& G: G) K3 s! {( D1 d2 q
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.    
    " D" v3 N3 o8 L3 A( k- ?
14.     V = AxDbDoc.CopyObjects(Objs, ThisDrawing.ModelSpace)
    . Y; m. L+ ^- B& w+ @- I0 B1 [
15.     Set blockRefObj = V(0)
    % C8 G, r5 g! N* u* S% K. _7 u
16.     insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0
    
17.     blockRefObj.Move P, insertionPnt
    " g# @! f: w5 Q) q' a" j8 J: t
18.    
    
19.     ZoomAll
    
20. End Sub
    0 }/ t4 |6 i+ W9 c# u6 r

复制代码

, e: U8 [! a# B6 ?  Z三.自己编写一段插入外部块的函数,代替 InsertBlock 方法插入外部块
2 [  e. l8 {7 H* g* A# X

1. 
   
2. Sub Sub2()
   / ]. F' M, d2 q# P
3.     Dim insertionPnt(0 To 2) As Double
   6 G" A" U( H# e8 |
4.     Dim blockRefObj As AcadBlockReference
   
5.     insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0
   ) V- _7 H2 S9 }7 F, Q! ^
6.     Set blockRefObj = InsertBlock(ThisDrawing.ModelSpace, insertionPnt, "d:\drawing8.dwg", 1#, 1#, 1#, 0)
     O- d5 d+ D! B
7.     ZoomAll
   
8. End Sub
   + k5 V& T+ ~- `: L: i; n- ?
9. 
   : {: p7 T# L  H1 O- k
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, _
    * [! y5 K/ s7 C  H
12. ByVal Rotation As Double) As AcadBlockReference
    
13.     Dim BlockName As String
    $ W/ r7 z/ R8 Q' d: X
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.    
    " B* o4 r+ N8 @
18.     BlockName = Right(Name, Len(Name) - InStrRev(Name, ""))
    
19.     BlockName = Left(BlockName, InStrRev(BlockName, ".") - 1)
    # |" l' g& C+ a, I9 F% D
20.    
    # K% I/ Y* P4 A* a
21.     Set InsertBlock = Block.InsertBlock(InsertionPoint, BlockName, Xscale, Yscale, Zscale, Rotation)
    1 m8 D; ^5 K- W2 G2 o
22.    
    
23.     If Err Then
    
24.         D.Open Name
    
25.         If D.ModelSpace.Count > 0 Then
    * h# J) ]8 A8 q
26.             ReDim E(D.ModelSpace.Count - 1)
    
27.             For I = 0 To D.ModelSpace.Count - 1
    , v& Q9 W2 z9 G5 c* P9 p; l1 q
28.                 Set E(I) = D.ModelSpace.Item(I)
    
29.             Next
    % g! n% p3 S+ W7 q; L6 A' z' y
30.             Set B = Block.Document.Blocks.Add(P, BlockName)
      [) g- X# H4 p7 q0 [+ n
31.             D.CopyObjects E, B
    
32.         End If
    ' `/ r: f& E* s  q0 o: B, z
33.         Set InsertBlock = Block.InsertBlock(InsertionPoint, BlockName, Xscale, Yscale, Zscale, Rotation)
    5 `* @1 d  |& J
34.     End If
    8 N' M. }' b1 Q: p8 v% T
35. End Function
    6 }% b2 A% x# [% f! C8 w! B6 V2 \; c4 p

复制代码

157787698

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

157787698

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

! k2 a. v) T( v: Z- c2 p. l  h是不是也要引用ObjectDbx 类库？
4 \# l+ h/ X: w
9 F8 B' \+ |% f8 l+ Z. Q& P! F* w还有如何引用ObjectDbx 类库？我在引用列表里没有找到

157787698

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

8 w) H8 y/ |- z. a& V1 y1 E谢谢斑竹

157787698

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

本来应该在低版本CAD中引用低版本类库，然后在高版本CAD中应该自动继承为高版本类库
' N% |" o! n6 }1 k
( X% W5 L* y' f; L/ `& i可实际上并不会自动向前继承
" ]8 X% E* \; z- {9 A0 ]
+ A1 p+ ?7 M$ F请问此问题有没有办法解决呢？