|
|
发表于 2011-8-6 06:51:03
|
显示全部楼层
来自： 中国辽宁
貌似这是 ACAD 高版本 ActiveX 的一个BUG,到目前为止我们似乎还只能绕开它. % k7 S$ V) N" }9 s, J' H: J
可用的方法大体上有下面几种:
: X- h/ `; X% @7 m: I一.使用 Document 对象的 SendCommand 方法
3 l2 |* g- x$ V# M- W) B- & J1 K! n% F% L7 d
- ThisDrawing.SendCommand "-insert d:\drawing8.dwg" & vbCr & "2,2,0 1 1 0 " 9 Y+ C9 D, N2 {' E
S+ S5 r6 k# `' R二.首先创建一个用于过渡(中间?辅助?)的新文档,并做为全局变量,用 InsertBlock 方法插入外部块参照.当其它文档需要插入该外部块参照时,从这个过渡(中间?辅助?)文档中拷贝过来,而不再使用 InsertBlock 方法3 V3 I. `4 v' S; P5 Z" L# ^- N
下面两段代码中都引用了 ObjectDbx 类库,目的是在后台运行这个过渡(中间?辅助?)文档,以免它在前台添乱.运行下面两段代码前应引用 ObjectDbx 类库2 s, J9 K g: v" T5 _6 C
-
9 C( n/ H( ?5 ~' V3 a& V# {5 q+ W I - Dim AxDbDoc As New AxDbDocument, Objs(0) As AcadBlockReference, Inserted As Boolean7 I5 A6 U% d: u/ ]
- C, |7 B! Z: I7 R. T0 n) e6 b
- Sub Sub1()
2 m7 K- L i W i - Dim insertionPnt(0 To 2) As Double& U+ w% }" ^7 V9 g
- Dim blockRefObj As AcadBlockReference D! A a* I1 b# b2 f! r& ]9 U
- Dim V As Variant, P(2) As Double
" V4 B' H$ A+ U" f* a - 4 [2 G" x6 ?* C" B
- If Not Inserted Then
- k/ J* M6 b# }1 o3 O - Set Objs(0) = AxDbDoc.ModelSpace.InsertBlock(P, "d:\drawing8.dwg", 1, 1, 1, 0)
- g( U3 ~, ?0 q* _# f9 Q - Inserted = True9 h' N2 Y8 V: D! C% [
- End If
( e) }. h4 w# B: ` -
4 \- S" T! Q( e2 @$ Z0 w" k2 u& G8 Q - V = AxDbDoc.CopyObjects(Objs, ThisDrawing.ModelSpace)
' o/ |4 H* S" w2 x - Set blockRefObj = V(0)
1 D: z4 N, {$ c( y - insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 04 {! @% q( G8 T# Q2 p+ N/ e( f K& Q
- blockRefObj.Move P, insertionPnt6 W% H& z0 B) z
- + Q! d R& f( H* L; e9 h. z* ^3 c
- ZoomAll
" x' Z Z0 p ^! D - End Sub
2 a1 e9 c0 y7 F/ A. m2 w
三.自己编写一段插入外部块的函数,代替 InsertBlock 方法插入外部块; l" t8 }8 ?9 N( Y9 r! F" T
- 8 V6 g8 _4 Y" F% `6 i" S- a# R
- Sub Sub2()
& a# t% d6 h5 z7 s1 U g$ D; C - Dim insertionPnt(0 To 2) As Double
" ] Q* o* J) ]6 E% B9 ~3 w - Dim blockRefObj As AcadBlockReference
: C) J& o( S4 \! i! r - insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0
- F1 ]/ j. \' K0 S - Set blockRefObj = InsertBlock(ThisDrawing.ModelSpace, insertionPnt, "d:\drawing8.dwg", 1#, 1#, 1#, 0)4 Z# {) g) S8 u
- ZoomAll7 R: ? i9 t% R0 o, K3 v& E
- End Sub% T+ K) ~- d7 l, ~# ^
- 8 ^' V) x" [$ O5 E. }
- Private Function InsertBlock(ByVal Block As AcadBlock, ByVal InsertionPoint As Variant, _
+ |1 u5 i e% v9 a7 Y: Q& _% F4 Z - ByVal Name As String, ByVal Xscale As Double, ByVal Yscale As Double, ByVal Zscale As Double, _8 Y; u4 K. F( e7 n
- ByVal Rotation As Double) As AcadBlockReference
8 A+ W* K1 `3 D, T. D7 V - Dim BlockName As String1 T5 A1 F' T( C& H1 M- `$ `4 @0 V2 \
- Dim D As New AxDbDocument, E() As AcadEntity, I As Integer, B As AcadBlock, P(2) As Double
4 r5 S* P [0 `; ?, X3 E -
# x& x# H4 x6 Z. q# Z3 B - On Error Resume Next9 I9 p: w3 v0 z; s+ n- G
- ! O% p+ x0 H. A7 u
- BlockName = Right(Name, Len(Name) - InStrRev(Name, "")); [+ f* [6 g& I! r3 J# ~: ?8 }8 C
- BlockName = Left(BlockName, InStrRev(BlockName, ".") - 1)
- [$ |- {0 E5 M: W -
: F3 F- Y- p- Z - Set InsertBlock = Block.InsertBlock(InsertionPoint, BlockName, Xscale, Yscale, Zscale, Rotation)
# g' } C# z# L+ K) h1 F -
5 k2 r" d7 ^. |0 W8 e - If Err Then
8 {; G, n4 E2 Z/ c4 [: _ c2 F - D.Open Name
: r7 b% Q& H8 N$ g - If D.ModelSpace.Count > 0 Then! I" ]2 @. @5 s& B. [6 G; q: a
- ReDim E(D.ModelSpace.Count - 1)/ ~+ X6 v0 x, N
- For I = 0 To D.ModelSpace.Count - 12 k7 v% k1 w5 v) h5 Y
- Set E(I) = D.ModelSpace.Item(I)! v( | }7 e7 O9 i3 A8 B
- Next
: Y& W; ]* r. x9 j2 Z- F& C - Set B = Block.Document.Blocks.Add(P, BlockName)3 B! J& r/ @: ?# L- d$ J
- D.CopyObjects E, B! }. N# V3 a/ ~. D
- End If8 {+ k4 `! T0 t. K! V$ n- H
- Set InsertBlock = Block.InsertBlock(InsertionPoint, BlockName, Xscale, Yscale, Zscale, Rotation)3 `1 L* v. |& a2 y9 a# _- P
- End If
& L% X: \4 ?, s. _8 Q1 S2 H - End Function
4 Z* n" |6 ]. {5 @0 Y3 |; m2 V
|
|
发表于 2011-8-5 10:10:56
楼主