insertblock在CAD2010中总出错

157787698

: N# ~- j1 R* X5 L8 `: r9 q, `用insertblock向图纸中插入块，代码如下：
2 o6 h1 Y' {- ~2 m+ \) Q$ W- g9 [

1. 
   ; v8 b6 l9 I! w$ v; @5 c6 M4 ?
2.     Dim insertionPnt(0 To 2) As Double
   # D* `; p- f* l: S) q& {& j
3.     Dim blockRefObj As AcadBlockReference
   
4.     insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0
   
5.     Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, "d:\drawing8.dwg", 1#, 1#, 1#, 0)
   / x$ y' I  v7 P1 n. o; x; h, p4 Z6 l
6.     ZoomAll
   

复制代码

  k3 _! F' b' T7 s
9 b  O# G. V3 O3 F0 C在CAD2006中没有问题，但是一旦拿到CAD2010中就有问题：
当在第一次使用的图纸中重复使用时，没有问题；
. E4 e: H" s$ G% x但是一旦关掉第一次使用的那张图纸，在新建的图纸中使用的时候就会跳错，提示如下：

: h6 o+ p5 e8 j$ o9 \/ E8 s请大虾们帮助解决，或提供其他思路，非常感谢。

157787698

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

157787698

难道是因为CAD2010中的thisdrawing需要重新激活？
8 }6 z8 I9 h7 Y( x0 }( U/ {
9 E; l7 y7 w% t# p( E8 G但为神马其他方法方法没有问题？只发现了insertblock有问题

woaishuijia

貌似这是 ACAD 高版本 ActiveX 的一个BUG,到目前为止我们似乎还只能绕开它.
可用的方法大体上有下面几种:
. ?* G6 D: f% B0 x" H) [4 r# {一.使用 Document 对象的 SendCommand 方法
! K7 q9 H5 o! U0 y

1. 
   # P/ r& z+ v7 i. g# v. E
2. ThisDrawing.SendCommand "-insert d:\drawing8.dwg" & vbCr & "2,2,0 1 1 0 "
   

复制代码

二.首先创建一个用于过渡(中间?辅助?)的新文档,并做为全局变量,用 InsertBlock 方法插入外部块参照.当其它文档需要插入该外部块参照时,从这个过渡(中间?辅助?)文档中拷贝过来,而不再使用 InsertBlock 方法
* _% ~# k8 H% y( p4 x2 i下面两段代码中都引用了 ObjectDbx 类库,目的是在后台运行这个过渡(中间?辅助?)文档,以免它在前台添乱.运行下面两段代码前应引用 ObjectDbx 类库

1. 
   
2. Dim AxDbDoc As New AxDbDocument, Objs(0) As AcadBlockReference, Inserted As Boolean
   & T6 y1 f6 ~0 H  W; E+ T
3.    
   
4. Sub Sub1()
   ' b4 t1 U* T# K- V
5.     Dim insertionPnt(0 To 2) As Double
   ( |* y5 ^& j) D5 G- |8 F$ z* @
6.     Dim blockRefObj As AcadBlockReference
   $ w% a/ T% b  L* o
7.     Dim V As Variant, P(2) As Double
   ; F2 l- f7 j9 B; B
8.    
   - F4 b; I$ A  \$ w
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.    
    
14.     V = AxDbDoc.CopyObjects(Objs, ThisDrawing.ModelSpace)
    & q( n( B$ q6 ~  ~3 J) E. H
15.     Set blockRefObj = V(0)
    ( b" c7 e1 W& k* F9 O
16.     insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0
    . k' g% `: h9 |0 t
17.     blockRefObj.Move P, insertionPnt
    1 |* Z( N- {3 {. {5 J6 f' s9 N
18.    
    
19.     ZoomAll
    4 Q2 _+ |; B# b9 K& K
20. End Sub
    7 g! c9 H, l! s8 ~8 F- Q

复制代码

三.自己编写一段插入外部块的函数,代替 InsertBlock 方法插入外部块
2 W5 E8 }+ }) @5 Z( S

1. 
   
2. Sub Sub2()
   
3.     Dim insertionPnt(0 To 2) As Double
   - l7 Q9 ]# s0 j8 y9 q+ z
4.     Dim blockRefObj As AcadBlockReference
   * D8 t+ G4 \' U4 A+ _7 r: f  H
5.     insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0
   * O2 O- d% n. t5 n2 d
6.     Set blockRefObj = InsertBlock(ThisDrawing.ModelSpace, insertionPnt, "d:\drawing8.dwg", 1#, 1#, 1#, 0)
   
7.     ZoomAll
   : t/ O2 ~5 |: e% g. P# n
8. End Sub
   
9. 
   
10. Private Function InsertBlock(ByVal Block As AcadBlock, ByVal InsertionPoint As Variant, _
    ; ~2 i0 v' A7 \6 Z" Y2 B9 y, _# j
11. ByVal Name As String, ByVal Xscale As Double, ByVal Yscale As Double, ByVal Zscale As Double, _
    % e7 Q; E- M/ \  j- K
12. ByVal Rotation As Double) As AcadBlockReference
    
13.     Dim BlockName As String
    6 D* E6 @4 ^2 i: h5 B
14.     Dim D As New AxDbDocument, E() As AcadEntity, I As Integer, B As AcadBlock, P(2) As Double
    - y8 j' c5 B" Q. |' r: c$ n
15.    
    
16.     On Error Resume Next
    ( Z$ J% G) l8 M. e! C
17.    
    8 u* R; ?/ C! ?) B6 q* g' u0 P8 P
18.     BlockName = Right(Name, Len(Name) - InStrRev(Name, ""))
    
19.     BlockName = Left(BlockName, InStrRev(BlockName, ".") - 1)
    7 }- f& K1 v+ z
20.    
    - L) s1 Q! z9 O8 ]7 b
21.     Set InsertBlock = Block.InsertBlock(InsertionPoint, BlockName, Xscale, Yscale, Zscale, Rotation)
    
22.    
    
23.     If Err Then
    
24.         D.Open Name
    2 d. q  k3 G8 \3 }! L
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)
    ; |% a; P5 c$ t+ H8 r' F* T
29.             Next
    : N+ Z* b  i  j. G! o
30.             Set B = Block.Document.Blocks.Add(P, BlockName)
    
31.             D.CopyObjects E, B
    ! P9 y8 v9 g% O
32.         End If
    / `2 \6 N- w# B% }9 q
33.         Set InsertBlock = Block.InsertBlock(InsertionPoint, BlockName, Xscale, Yscale, Zscale, Rotation)
    7 Z2 O( ~4 R) y3 I7 w. ]0 R
34.     End If
    4 Z( D* c) ?# a4 P
35. End Function
    3 @6 U! e3 Z0 Z

复制代码

157787698

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

157787698

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

是不是也要引用ObjectDbx 类库？

2 Y- q4 g- y: R( y还有如何引用ObjectDbx 类库？我在引用列表里没有找到

157787698

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

/ w9 D4 ~. t/ d+ I谢谢斑竹

157787698

在引用类库的过程中出现问题
) V5 E. f$ [) `& UCAD2006对应的类库版本号为16.0
' I3 g4 Z3 s5 y* j$ q; G& G% ~" fCAD2008对应的类库版本号为17.0
0 z+ ?- r" V/ z# V9 s- ~' R6 l2 ~2 BCAD2010对应的类库版本号为18.0

本来应该在低版本CAD中引用低版本类库，然后在高版本CAD中应该自动继承为高版本类库
1 y) s# x. C9 u1 K8 f6 T2 C
: {% g, m$ o- k- y" s可实际上并不会自动向前继承
6 d( P2 E* J! U: ]: l6 Q7 E
请问此问题有没有办法解决呢？