insertblock在CAD2010中总出错

157787698

- K  N6 [7 r; f7 |" z3 U用insertblock向图纸中插入块，代码如下：

1. 
   
2.     Dim insertionPnt(0 To 2) As Double
   
3.     Dim blockRefObj As AcadBlockReference
   
4.     insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0
   ! p0 O& z) ^+ t/ o9 x- |/ w! ~  ~# X' Z
5.     Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, "d:\drawing8.dwg", 1#, 1#, 1#, 0)
   , n% N: V' [; J1 s6 x6 h
6.     ZoomAll
   3 U. D+ O' [6 u2 [

复制代码

" n* x9 z8 s- ^- s# c
0 F0 N& y: d8 s- i& U. n) ]在CAD2006中没有问题，但是一旦拿到CAD2010中就有问题：
4 T* s1 S" h& P) H- X0 h. r当在第一次使用的图纸中重复使用时，没有问题；
但是一旦关掉第一次使用的那张图纸，在新建的图纸中使用的时候就会跳错，提示如下：

请大虾们帮助解决，或提供其他思路，非常感谢。

157787698

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

157787698

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

8 m7 O/ A1 f: @但为神马其他方法方法没有问题？只发现了insertblock有问题

woaishuijia

貌似这是 ACAD 高版本 ActiveX 的一个BUG,到目前为止我们似乎还只能绕开它.
7 K) o& v' v; R可用的方法大体上有下面几种:
一.使用 Document 对象的 SendCommand 方法
; T) K; Z4 F9 }  I" M, g. \2 @

1. 
   * {& T1 ]# e2 y; z; _" L
2. ThisDrawing.SendCommand "-insert d:\drawing8.dwg" & vbCr & "2,2,0 1 1 0 "
   

复制代码

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

1. 
   
2. Dim AxDbDoc As New AxDbDocument, Objs(0) As AcadBlockReference, Inserted As Boolean
   . r4 c' Q7 r0 L; h
3.    
   
4. Sub Sub1()
   6 l% i6 J" @8 P4 H3 o" [+ t: B0 ~9 S
5.     Dim insertionPnt(0 To 2) As Double
   " }9 Y7 V* `, F2 Q! s! z
6.     Dim blockRefObj As AcadBlockReference
   
7.     Dim V As Variant, P(2) As Double
   2 M# W) O- b. u; ?7 [7 m
8.    
   
9.     If Not Inserted Then
   . F8 D4 k3 y( {2 W
10.         Set Objs(0) = AxDbDoc.ModelSpace.InsertBlock(P, "d:\drawing8.dwg", 1, 1, 1, 0)
    
11.         Inserted = True
    # f( p' _) t5 N
12.     End If
    8 h3 {9 q& I9 B0 s, P
13.    
    
14.     V = AxDbDoc.CopyObjects(Objs, ThisDrawing.ModelSpace)
    
15.     Set blockRefObj = V(0)
    # k9 ~! p1 E: M7 \" ^. o' x
16.     insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0
    
17.     blockRefObj.Move P, insertionPnt
    
18.    
    
19.     ZoomAll
    
20. End Sub
    . ?2 R" h4 y' I: j7 [

复制代码

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

1. 
   ; t  _5 Y& z+ i$ M
2. Sub Sub2()
   
3.     Dim insertionPnt(0 To 2) As Double
   ) r. O& w% t1 P3 I, B
4.     Dim blockRefObj As AcadBlockReference
   . z3 v& t& h+ Y1 p
5.     insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0
   
6.     Set blockRefObj = InsertBlock(ThisDrawing.ModelSpace, insertionPnt, "d:\drawing8.dwg", 1#, 1#, 1#, 0)
   2 N- W1 g" Z0 \! V8 h" W/ y! m
7.     ZoomAll
   
8. End Sub
   ( W* }1 H' W/ g! L* r
9. 
   - o/ D2 B: D' i8 A
10. Private Function InsertBlock(ByVal Block As AcadBlock, ByVal InsertionPoint As Variant, _
      ?1 K3 L7 u! E: G
11. ByVal Name As String, ByVal Xscale As Double, ByVal Yscale As Double, ByVal Zscale As Double, _
    ( m+ p( G  @: \; [
12. ByVal Rotation As Double) As AcadBlockReference
    - z1 x- v8 F7 i/ j* W7 `) J
13.     Dim BlockName As String
    ! W& M4 h# E9 H+ \7 i0 D  M& O# r& q
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.    
    
18.     BlockName = Right(Name, Len(Name) - InStrRev(Name, ""))
    
19.     BlockName = Left(BlockName, InStrRev(BlockName, ".") - 1)
    : J* D1 c3 T; D. H# v( d& e
20.    
    , W  W5 F( Y8 u0 m9 K1 ?5 F+ L  n& p
21.     Set InsertBlock = Block.InsertBlock(InsertionPoint, BlockName, Xscale, Yscale, Zscale, Rotation)
    + J8 a- U( A8 M2 g, Z* X# \6 n$ D
22.    
    4 Q/ ~" j+ B* `
23.     If Err Then
    ' R( ?4 I; |# t4 m2 h" t
24.         D.Open Name
    
25.         If D.ModelSpace.Count > 0 Then
    9 A# I( m6 D2 B1 J+ u, D
26.             ReDim E(D.ModelSpace.Count - 1)
    
27.             For I = 0 To D.ModelSpace.Count - 1
    
28.                 Set E(I) = D.ModelSpace.Item(I)
    6 V6 @( q2 Z) X$ T& r8 J& D
29.             Next
    # E2 N' }4 f' H. F( f8 J
30.             Set B = Block.Document.Blocks.Add(P, BlockName)
    
31.             D.CopyObjects E, B
    1 x8 A3 k, `9 m0 L* @! J5 C
32.         End If
    
33.         Set InsertBlock = Block.InsertBlock(InsertionPoint, BlockName, Xscale, Yscale, Zscale, Rotation)
    9 x/ ?! S) f, g8 V7 u% @
34.     End If
    % f' X+ ]5 z* m9 E' I( w
35. End Function
    

复制代码

157787698

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

157787698

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

是不是也要引用ObjectDbx 类库？

3 n4 w3 R8 e, G' i& l* _还有如何引用ObjectDbx 类库？我在引用列表里没有找到

157787698

通过在开发人员帮助中搜索ObjectDbx找到了
6 a5 e# G# `$ Y# \9 O" E
谢谢斑竹

157787698

在引用类库的过程中出现问题
9 g+ [% S8 u# m# r& rCAD2006对应的类库版本号为16.0
/ ^  E! g# @) j% u5 \/ V! f& u" vCAD2008对应的类库版本号为17.0
CAD2010对应的类库版本号为18.0
" c& s  O! T. ?6 R
本来应该在低版本CAD中引用低版本类库，然后在高版本CAD中应该自动继承为高版本类库
# J, e0 z2 F9 h9 z& b& b
: B0 s/ m- R/ i, V$ g9 x/ a可实际上并不会自动向前继承
( j& e9 s% y: i! r
, @, X' j% W" C& {请问此问题有没有办法解决呢？