insertblock在CAD2010中总出错

157787698

# w6 \; [8 Z1 j* F用insertblock向图纸中插入块，代码如下：

1. 
   2 W5 H, u8 A5 ?' |  U; _( r2 d
2.     Dim insertionPnt(0 To 2) As Double
   + @' B  A$ I! B3 g/ p. b" w2 z
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)
   - e! ~( e8 @. ], T3 X3 Y' ^" D% k; H/ z& G3 K
6.     ZoomAll
   

复制代码

; P# q7 a" f# w6 N# i0 D
在CAD2006中没有问题，但是一旦拿到CAD2010中就有问题：
当在第一次使用的图纸中重复使用时，没有问题；
, O2 f( a' f( x: ^3 @但是一旦关掉第一次使用的那张图纸，在新建的图纸中使用的时候就会跳错，提示如下：

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

157787698

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

157787698

难道是因为CAD2010中的thisdrawing需要重新激活？
) c, [5 p5 M# B9 k
0 i4 |; ~5 g6 x$ l. o但为神马其他方法方法没有问题？只发现了insertblock有问题

woaishuijia

貌似这是 ACAD 高版本 ActiveX 的一个BUG,到目前为止我们似乎还只能绕开它.
3 U: \# H0 A9 m8 i9 H' g可用的方法大体上有下面几种:
/ l5 `% n' O# b! F, _: u" W! |一.使用 Document 对象的 SendCommand 方法

1. 
   / ]" r0 z' Y; q" {3 `
2. ThisDrawing.SendCommand "-insert d:\drawing8.dwg" & vbCr & "2,2,0 1 1 0 "
   4 d9 q! i# l: d# P" R# E

复制代码

二.首先创建一个用于过渡(中间?辅助?)的新文档,并做为全局变量,用 InsertBlock 方法插入外部块参照.当其它文档需要插入该外部块参照时,从这个过渡(中间?辅助?)文档中拷贝过来,而不再使用 InsertBlock 方法
; A0 g$ g1 t5 x, O9 \下面两段代码中都引用了 ObjectDbx 类库,目的是在后台运行这个过渡(中间?辅助?)文档,以免它在前台添乱.运行下面两段代码前应引用 ObjectDbx 类库
, _1 y0 ]1 o7 Q3 f

1. 
   * {* [/ m1 Q  X3 n- ?
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
   6 W- w: \& @9 }% W. z" l8 t( Y
6.     Dim blockRefObj As AcadBlockReference
   . M# W! ]  w, G- B
7.     Dim V As Variant, P(2) As Double
   
8.    
   
9.     If Not Inserted Then
   / O- q% S6 y* X- x  Z7 Z
10.         Set Objs(0) = AxDbDoc.ModelSpace.InsertBlock(P, "d:\drawing8.dwg", 1, 1, 1, 0)
    
11.         Inserted = True
    
12.     End If
    
13.    
    6 h% F( n6 t/ i( W# C
14.     V = AxDbDoc.CopyObjects(Objs, ThisDrawing.ModelSpace)
    : q7 j- i0 Z9 ?: @
15.     Set blockRefObj = V(0)
    , f, D4 M% Y3 _$ |
16.     insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0
    
17.     blockRefObj.Move P, insertionPnt
    
18.    
    / i1 B5 `7 S, S# T  n% y4 E
19.     ZoomAll
    - U# m; Q8 I; K4 w- u) s/ a3 X; Y
20. End Sub
    ) A" N% r/ }4 @. c

复制代码

三.自己编写一段插入外部块的函数,代替 InsertBlock 方法插入外部块
0 r, p4 a2 H$ G3 D

1. 
   ' `0 C* U, b' U7 c6 x* ^
2. Sub Sub2()
   $ x) P$ P0 b4 [9 Z6 w7 }
3.     Dim insertionPnt(0 To 2) As Double
   ) ~1 h/ a6 t5 B  C6 t9 p
4.     Dim blockRefObj As AcadBlockReference
   ( I6 p% Q" I3 x: N2 |
5.     insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0
   $ m/ j0 P: t" O* ]0 u4 S
6.     Set blockRefObj = InsertBlock(ThisDrawing.ModelSpace, insertionPnt, "d:\drawing8.dwg", 1#, 1#, 1#, 0)
   ) x  _6 v7 @, U$ i3 O! J
7.     ZoomAll
   
8. End Sub
   ' I, C# q- `2 {. D, F
9. 
   9 V) j; b3 q8 s1 n8 j1 g: Q
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, _
    8 x  X# x( w' l" x
12. ByVal Rotation As Double) As AcadBlockReference
    % ^! C# o- W/ x( i/ i
13.     Dim BlockName As String
    
14.     Dim D As New AxDbDocument, E() As AcadEntity, I As Integer, B As AcadBlock, P(2) As Double
    . c# `6 ^* Z1 T' A( K: |/ ^
15.    
    
16.     On Error Resume Next
    0 ]7 A: r5 H2 z+ k
17.    
    . S& k4 p2 Y' V
18.     BlockName = Right(Name, Len(Name) - InStrRev(Name, ""))
    ) I, ]: z) F  Y" `. ^
19.     BlockName = Left(BlockName, InStrRev(BlockName, ".") - 1)
    
20.    
    & {0 l! p+ l7 L( f
21.     Set InsertBlock = Block.InsertBlock(InsertionPoint, BlockName, Xscale, Yscale, Zscale, Rotation)
    8 i% x9 F  I9 t3 T* h
22.    
    ! B9 W) V, h) `) g1 n
23.     If Err Then
    
24.         D.Open Name
    
25.         If D.ModelSpace.Count > 0 Then
    " {( W) D/ o- _0 d
26.             ReDim E(D.ModelSpace.Count - 1)
    2 b. R9 A/ k! A& [; h1 w7 G7 o1 i
27.             For I = 0 To D.ModelSpace.Count - 1
      V4 |% A9 I1 ~; ]% Z. Q' e
28.                 Set E(I) = D.ModelSpace.Item(I)
    1 |4 c) Q: m( c: l/ g! |! h1 T, A
29.             Next
    
30.             Set B = Block.Document.Blocks.Add(P, BlockName)
    
31.             D.CopyObjects E, B
    6 e( K: @7 L% y/ V+ Q" ~$ V% l
32.         End If
    5 q& v+ @* [3 J3 ^" P( T
33.         Set InsertBlock = Block.InsertBlock(InsertionPoint, BlockName, Xscale, Yscale, Zscale, Rotation)
    % A/ g* K; v/ O/ m
34.     End If
    
35. End Function
    

复制代码

157787698

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

157787698

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

是不是也要引用ObjectDbx 类库？
% s- l$ v2 P4 X  Y+ S$ }' y
' g* K2 ?. Y" f  h% u6 D  x还有如何引用ObjectDbx 类库？我在引用列表里没有找到

157787698

通过在开发人员帮助中搜索ObjectDbx找到了
+ p3 F5 `. S) D) `% c6 R
谢谢斑竹

157787698

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

本来应该在低版本CAD中引用低版本类库，然后在高版本CAD中应该自动继承为高版本类库
# X. m# U4 g9 r+ d8 U5 c  V3 U
4 P" @4 V4 ^- q7 j3 ?* {可实际上并不会自动向前继承

4 V' V$ }. F# f; d3 O请问此问题有没有办法解决呢？