insertblock在CAD2010中总出错

157787698

9 i) s+ S! a# B' O0 C! a1 j用insertblock向图纸中插入块，代码如下：
- o! y5 A6 l! r

1. 
   
2.     Dim insertionPnt(0 To 2) As Double
   
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)
   
6.     ZoomAll
   $ v: Z! C' N$ O4 i- N) H3 H

复制代码

8 ^. I/ E; g2 L5 t. e在CAD2006中没有问题，但是一旦拿到CAD2010中就有问题：
当在第一次使用的图纸中重复使用时，没有问题；
. h) D% t8 l( j* K/ d9 f- I; s但是一旦关掉第一次使用的那张图纸，在新建的图纸中使用的时候就会跳错，提示如下：

4 b  ~) a* \" ~' t. T* R请大虾们帮助解决，或提供其他思路，非常感谢。

157787698

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

157787698

难道是因为CAD2010中的thisdrawing需要重新激活？
! `1 d7 |& P, a" g4 c6 q
但为神马其他方法方法没有问题？只发现了insertblock有问题

woaishuijia

貌似这是 ACAD 高版本 ActiveX 的一个BUG,到目前为止我们似乎还只能绕开它.
1 j6 T; z: b! Y0 U' e. c* w2 p可用的方法大体上有下面几种:
3 v5 O1 B  ]% f, }一.使用 Document 对象的 SendCommand 方法
3 W/ Z8 ]  O' \

1. 
   
2. ThisDrawing.SendCommand "-insert d:\drawing8.dwg" & vbCr & "2,2,0 1 1 0 "
   5 |* C3 X0 j, @% [. M

复制代码

二.首先创建一个用于过渡(中间?辅助?)的新文档,并做为全局变量,用 InsertBlock 方法插入外部块参照.当其它文档需要插入该外部块参照时,从这个过渡(中间?辅助?)文档中拷贝过来,而不再使用 InsertBlock 方法
) e) ?4 o$ n" J- P下面两段代码中都引用了 ObjectDbx 类库,目的是在后台运行这个过渡(中间?辅助?)文档,以免它在前台添乱.运行下面两段代码前应引用 ObjectDbx 类库
$ t* `% ]+ n* b; @

1. 
   8 Z( L* {& q3 K7 e* \. _% A% m" @; e' q
2. Dim AxDbDoc As New AxDbDocument, Objs(0) As AcadBlockReference, Inserted As Boolean
   
3.    
   ! i1 [" {2 P; ?) Z+ a3 I
4. Sub Sub1()
   ' O! c: L5 H2 a* n& ^) [
5.     Dim insertionPnt(0 To 2) As Double
   
6.     Dim blockRefObj As AcadBlockReference
   ; Q$ U4 Z4 }6 B4 r
7.     Dim V As Variant, P(2) As Double
   9 q6 t9 R: h8 A7 j* w4 ?; V% A# e, J
8.    
   0 L; D' ?- |9 S) p+ S$ a
9.     If Not Inserted Then
   # W1 V/ w, K5 o+ {2 o, f( ^# l0 a. W
10.         Set Objs(0) = AxDbDoc.ModelSpace.InsertBlock(P, "d:\drawing8.dwg", 1, 1, 1, 0)
    0 k7 y& U3 C) z
11.         Inserted = True
    : o/ m, Y! h9 G3 M& \1 g) F
12.     End If
    
13.    
    ! G( D3 v9 c5 }6 `! H% L
14.     V = AxDbDoc.CopyObjects(Objs, ThisDrawing.ModelSpace)
    / z" V( P& _" n* i# T- s, y
15.     Set blockRefObj = V(0)
    ) k$ O3 q( n' j& P
16.     insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0
    7 ~. L3 O8 }  s; ?+ m
17.     blockRefObj.Move P, insertionPnt
    + f# {8 |6 o' v  [) ]
18.    
    1 y5 N: P1 }9 {/ z
19.     ZoomAll
    
20. End Sub
    . F- m% p2 M) i

复制代码

; O; b$ a% c9 T/ O三.自己编写一段插入外部块的函数,代替 InsertBlock 方法插入外部块

1. 
   
2. Sub Sub2()
   ; e4 h" `+ P4 }1 c' ^
3.     Dim insertionPnt(0 To 2) As Double
   . Z& |# E& A, m# R: |6 W
4.     Dim blockRefObj As AcadBlockReference
   
5.     insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0
   
6.     Set blockRefObj = InsertBlock(ThisDrawing.ModelSpace, insertionPnt, "d:\drawing8.dwg", 1#, 1#, 1#, 0)
   ! p- o. \. O& v" R7 M' X
7.     ZoomAll
   
8. End Sub
   
9. 
   
10. Private Function InsertBlock(ByVal Block As AcadBlock, ByVal InsertionPoint As Variant, _
    * C/ z, A0 H7 [5 ^. W8 [& V
11. ByVal Name As String, ByVal Xscale As Double, ByVal Yscale As Double, ByVal Zscale As Double, _
    
12. ByVal Rotation As Double) As AcadBlockReference
    
13.     Dim BlockName As String
    ' z4 B# T- F7 c0 s
14.     Dim D As New AxDbDocument, E() As AcadEntity, I As Integer, B As AcadBlock, P(2) As Double
    1 v  F4 A8 B% Q* p* H2 x6 `- z( Z
15.    
    ) J3 T* B$ C% l
16.     On Error Resume Next
    . n5 p7 Z- G( y- q7 X1 t
17.    
    
18.     BlockName = Right(Name, Len(Name) - InStrRev(Name, ""))
    
19.     BlockName = Left(BlockName, InStrRev(BlockName, ".") - 1)
    + B5 ~1 i7 j! ]8 k7 @7 j2 @
20.    
    , ?$ p& e- z" y% h6 D# ]
21.     Set InsertBlock = Block.InsertBlock(InsertionPoint, BlockName, Xscale, Yscale, Zscale, Rotation)
    
22.    
    
23.     If Err Then
      ~6 L  d/ V# p5 X' n
24.         D.Open Name
    6 ^3 X1 s) b3 X5 k' r
25.         If D.ModelSpace.Count > 0 Then
    / e9 Z8 j! D$ M
26.             ReDim E(D.ModelSpace.Count - 1)
    ) U1 U0 U$ O9 d0 ~! B3 b" R
27.             For I = 0 To D.ModelSpace.Count - 1
    
28.                 Set E(I) = D.ModelSpace.Item(I)
    
29.             Next
    ' r. b5 K7 {/ ?4 p4 K, Q' y
30.             Set B = Block.Document.Blocks.Add(P, BlockName)
    
31.             D.CopyObjects E, B
    0 O" R' ]: r* D
32.         End If
    
33.         Set InsertBlock = Block.InsertBlock(InsertionPoint, BlockName, Xscale, Yscale, Zscale, Rotation)
    5 n" z7 `6 F+ {' y. C$ L
34.     End If
    
35. End Function
    

复制代码

157787698

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

157787698

数据类型AxDbDocument有提示说用户定义类型未定义
- B: Y: l. |' p+ b
* C9 _% W5 [7 l/ k9 N是不是也要引用ObjectDbx 类库？
( ?; e3 i" H* ?- g: A3 R
还有如何引用ObjectDbx 类库？我在引用列表里没有找到

157787698

通过在开发人员帮助中搜索ObjectDbx找到了
- e8 I$ j0 ]; D
谢谢斑竹

157787698

在引用类库的过程中出现问题
CAD2006对应的类库版本号为16.0
1 `0 c  {/ Z* }CAD2008对应的类库版本号为17.0
- s+ `1 D6 y4 m/ ?CAD2010对应的类库版本号为18.0
  F* {! y5 J% Z4 a* \; L
# A0 F) M( T% w1 t& }# P- Q本来应该在低版本CAD中引用低版本类库，然后在高版本CAD中应该自动继承为高版本类库
- Z1 \- N; _, Y& |% ]9 x
7 e8 I! Y& X7 k# Z# q7 k. u可实际上并不会自动向前继承
- i* u7 z$ h0 z3 w7 w* h5 c/ V
: g. v& U7 w0 v) T5 O, m# ]请问此问题有没有办法解决呢？