vba中如何嵌套块？

tataki

' z7 M* p5 n2 g得到斑竹上次解答后，现在可以根据blockB的数量灵活插入需要的块了，（原帖http://www.3dportal.cn/discuz/viewthread.php?tid=1140006&;extra=page%3D3）但现在遇上一个新问题，不好意思又开了一个贴....
问题是这样的，图纸上右侧是原始块，左侧是我想要做成的块。
为简化问题，现在只要插入1个blockA，n个blockB，n的数量通过文本框来确定，blockC和blockD不用插入。
当我完成插入1个blockA，n个blockB后，我要把左侧这n+1个块组成一个新块 blockE，这应该算是嵌套块吧？可是这个创建blockE的代码怎么写呢？
1 R/ b9 @' T  \5 F/ g3 _0 m3 j6 \$ N+ l特别的是：n是不确定的，比如某一次是1个A，3个B块，另外一次是1个A，5个B块，怎么来处理这种情况呢？
我感觉不能通过块的名字嵌套吧，因为右侧的原始块有一样的名字，而且原始块是不能删除的。
谢谢，附上图纸和代码

1. Private Sub cmdInsert_Click()
   * g" P# P3 `5 I
2. Dim ptInsert(2) As Double
   . h2 u7 [' M7 x
3. Dim lastBlock As Variant
   - I& t" q  `# j' ?: F, i2 A5 B7 j* Q
4. ptInsert(0) = 0
   
5. ptInsert(1) = 0
   
6. ptInsert(2) = 0
   
7. 
   7 _0 A9 q/ P# X/ Z
8. '----------插入块A 仅仅一个---------------------------------
   3 ?: Y" F4 n% P  t( B; R. x1 A
9. Dim B As AcadBlockReference '声明一个块参照变量
   
10. Dim P As Variant '声明一个变体变量用于接收三维点坐标
    % q9 d( w' e% c. }3 \8 e
11. Set B = ThisDrawing.ModelSpace.InsertBlock(ptInsert, blkAName.Text, 1, 1, 1, 0)
    4 n- }# I% u5 L* P4 M6 w' ^* ~
12. P = B.InsertionPoint '提取上一步插入的块参照的插入点坐标,返回值是三元素双精度数组
    
13. '----------插入块A 完成---------------------------------
    
14. 
    
15. '----------插入块B---------------------------------
    ( R* R& S# n0 k; [# c- e
16. Dim pNew(2) As Double
    
17. pNew(0) = P(0) - 500
    
18. pNew(1) = P(1) + 1405.08
      D: W8 c: }, m$ T( g6 T$ o
19. pNew(2) = P(2)
    # T; K7 t* I! n7 o2 j1 w% M
20. Set B = ThisDrawing.ModelSpace.InsertBlock(pNew, blkBName.Text, 1, 1, 1, 0)
    
21. P = B.InsertionPoint '提取上一步插入的块参照的插入点坐标,返回值是三元素双精度数组
    / ?, Y2 E/ R# j0 _, C' x
22. 
    
23. 
    # o: \/ |- U* N3 R5 L
24. For i = 2 To Val(blkBNum.Text) Step 1
    
25. Dim pBNew(2) As Double
    
26. pBNew(0) = P(0)
    
27. pBNew(1) = P(1) + 2000
    
28. pBNew(2) = P(2)
    
29. Set B = ThisDrawing.ModelSpace.InsertBlock(pBNew, blkBName.Text, 1, 1, 1, 0)
    
30. P = B.InsertionPoint '提取上一步插入的块参照的插入点坐标,返回值是三元素双精度数组
    / ^; w, t$ e$ L7 P0 F" I) t
31. Next
    4 q7 J3 B3 E3 c; u* d
32. '----------插入块B完成---------------------------------
    1 A: ?# j8 ~! N6 o. G
33. '最后的效果是左侧的块A和B组成了一个最终的块BlockE
    0 o6 e" q; E- y; V* U- Y; i& W, q
34. 
      h1 W8 t9 L' A5 Y' _" v+ [
35. 
    
36. ThisDrawing.Regen acActiveViewport
    
37. 
    
38. End Sub
    

复制代码

woaishuijia

1# tataki

1. Private Sub cmdInsert_Click()
   
2. Dim ptInsert(2) As Double
   * V$ W/ Z) s# k- b# B0 N
3. Dim lastBlock As Variant
   
4. ptInsert(0) = 0
   
5. ptInsert(1) = 0
   5 C( G  ?7 F- _1 |, r) R6 H# k+ q
6. ptInsert(2) = 0
   ' l' @. }% h3 y1 H, F: c
7. Dim BR As AcadBlock
   
8. Set BR = ThisDrawing.Blocks.Add(ptInsert, "blockE")
   . E! y; ]# u0 Q' s* Z( d2 o7 C
9. 
   5 z! |# Q# X/ \4 j2 U4 l- r
10. '----------插入块A 仅仅一个---------------------------------
    7 E+ S* B1 X3 t& `2 I/ e- E
11. Dim B As AcadBlockReference '声明一个块参照变量
    
12. Dim P As Variant '声明一个变体变量用于接收三维点坐标
    
13. 'Set B = ThisDrawing.ModelSpace.InsertBlock(ptInsert, blkAName.Text, 1, 1, 1, 0)
    , j2 n0 J) |- y, `! \+ r5 u
14. Set B = BR.InsertBlock(ptInsert, blkAName.Text, 1, 1, 1, 0)
    1 ]/ S) E$ P  _: k; S9 F( @
15. P = B.InsertionPoint '提取上一步插入的块参照的插入点坐标,返回值是三元素双精度数组
    7 h" I- q6 n# f+ A+ z& `0 h8 |0 r# r
16. '----------插入块A 完成---------------------------------
    
17. 
    
18. '----------插入块B---------------------------------
    
19. Dim pNew(2) As Double
    
20. pNew(0) = P(0) - 500
    
21. pNew(1) = P(1) + 1405.08
    # k& j# v; C' J. V6 a/ I6 G( i* {
22. pNew(2) = P(2)
      i1 d8 S' x2 L# u
23. 'Set B = ThisDrawing.ModelSpace.InsertBlock(pNew, blkBName.Text, 1, 1, 1, 0)
    
24. Set B = BR.InsertBlock(pNew, blkBName.Text, 1, 1, 1, 0)
    
25. P = B.InsertionPoint '提取上一步插入的块参照的插入点坐标,返回值是三元素双精度数组
    
26. 
    
27. 
    1 H& `8 C5 o& V9 k/ E
28. For i = 2 To Val(blkBNum.Text) Step 1
    
29. Dim pBNew(2) As Double
    
30. pBNew(0) = P(0)
    
31. pBNew(1) = P(1) + 2000
    1 m, N. _& {0 x' _
32. pBNew(2) = P(2)
    
33. 'Set B = ThisDrawing.ModelSpace.InsertBlock(pBNew, blkBName.Text, 1, 1, 1, 0)
    5 \& [( q- Q2 @2 ^; B; r9 L
34. Set B = BR.InsertBlock(pBNew, blkBName.Text, 1, 1, 1, 0)
    1 X' ?8 A1 f+ k2 Y- y! I  ^
35. P = B.InsertionPoint '提取上一步插入的块参照的插入点坐标,返回值是三元素双精度数组
    
36. Next
    ( m# m" z- T" A5 N% x
37. '----------插入块B完成---------------------------------
    $ [( H+ M4 z4 ?- G) B! e  Q/ j
38. '最后的效果是左侧的块A和B组成了一个最终的块BlockE
    
39. 
    
40. Set B = ThisDrawing.ModelSpace.InsertBlock(ptInsert, "blockE", 1, 1, 1, 0)
    , I2 |0 f& r1 Z7 F8 |* V, A
41. 
    
42. ThisDrawing.Regen acActiveViewport
    ( P/ D+ {9 ^2 I6 V: |0 y4 j
43. 
    
44. End Sub
    

复制代码

tataki

! `" U! R- e5 ?3 j
$ T$ H- Q9 T' r( ^: a谢谢斑竹
原来是要先创建blockE块，最后在模型空间中插入即可。我还局限在创建一个块然后和上一个块合并，依次进行呢。
另外我有一个疑惑，为什么块中嵌套块不能像块中添加实体，比如一个圆或者直线一样进行呢？
9 S# W. a( B. T; N  r& i, I在书上见过这样的例子，给已经定义的块添加直线：

1. Dim BL As AcadBlock
   : J; [+ G( m- {5 L
2. 
   0 ]! c6 e# H6 R( @) E7 C3 G- [
3. Dim ptInsert(2) As Double
   ! T, @9 X8 o" S, I
4. ptInsert(0) = 0
   
5. ptInsert(1) = 0
   
6. ptInsert(2) = 0
   ( m: g( o# n* B  `  P. `  Q& s$ b
7. 
   
8. Dim pt1(2) As Double '直线起点pt1
   3 |# `& v$ z- |0 m/ `
9. pt1(0)=100:pt1(1)=100:pt1(2)=100
   
10. 
    
11. Dim pt2(2) As Double '直线终点pt2
    / {: n  t- J! u0 x. o, f$ e4 o- F
12. pt2(0)=500:pt2(1)=500:pt2(2)=500
    
13. 
    - A6 Z) M+ K! ~5 A/ t
14. Set BL = ThisDrawing.Blocks.Add(ptInsertBase, "blockE" ) '先定义
    8 w7 f  e* ~/ j, ^# C. @4 u
15. ThisDrawing.Blocks.Item("blockE" ).AddLine Pt1,Pt2

复制代码

'直接在块中添加直线了，这个里面  " ) .  这段代码怎么出现表情了啊？？？
* ]* Y1 s) D) o/ p' h: `后面的就不写了。。。。

我就是有点纳闷块里有直接添加实体的方法，addline ,addcircle等等，就是没有添加块的方法，另外，我看到一个AddMInsertBlock方法，最开始还以为是添加块，结果发现不是，于是就不知道该怎么整了。恰好我看的那些VBA书中也没有提及怎么嵌套块...看了斑竹的思路才知道我的想法大方向都错了。哎，经验不足，见到的例子太少了

woaishuijia

强调一下:块是一个定义,文档中任何一个可见的"块"都是块参照,即该块定义的实例,所谓"嵌套块"是指一个块定义中包含有其它块的参照.
4 n- _% ~4 R' S! k5 ?( n. @6 d8 E- P. U无论在模型空间(ModelSpace对象),图纸空间(PaperSpace对象)还是块定义(Block对象)中添加块参照都是使用"InsertBlock"方法.
PS:帖子代码中出现表情是因为代码中挨在一起的的双引号和右括号与论坛的表情代码吻合,被理解为表情了.以后发帖时在双引号和右括号之间添加一个半角空格就OK了.呵呵

tataki

4# woaishuijia
# R% ~% r4 |, A) a1 \" ]( [3 k4 w- m"嵌套块"是指一个块定义中包含有其它块的参照
原来是这样的啊，需要在“块定义”中添加“块参照”，就像在模型空间里添加块参照一样。就是说这样的嵌套块只是个定义好了块，下一步就是在模型空间里把这个块的 块参照给insertBlock出来。
弄明白了问题的本质，呵呵，谢谢斑竹。

woaishuijia

就像在模型空间里添加块参照一样。就是说这样的嵌套块只是个定义好了块，下一步就是在模型空间里把这个块的 块参照给insertBlock出来。

  C" y) T- y( V9 f3 z0 T! K( H心有灵犀,甚好甚慰.

tataki

6# woaishuijia
呵呵，还有很多要向斑竹学习！
% \4 Q( E( @, i) Z# ]; c' g今天我有遇见了一个问题：我把blockC里面增加了两个圆，然后把BlockE插入后整体旋转，现在我想找出blockE中的 blockC里两个圆的圆心坐标，结果失败了...
我是这么想的，用两重循环，第一层遍历blockE，找到名字是 blockC的块后就进入第二层循环，然后遍历blockC中的各个图元：圆，直线，文字等等，找到圆就提取圆心坐标。可是就在第二层遍历的时候就出错了，不知道为什么...斑竹帮忙看看怎么解决，新的图纸和代码上传了。

woaishuijia

/ `2 D1 K7 J% ]7 o0 G& h: J* k
6 @3 k3 C- j* G+ N7 F1 t& f) X9 d: B你的目的是

找到名字是 blockC的块后就进入第二层循环，然后遍历blockC中的各个图元

& T4 N5 }2 c1 }9 Z& `& F) F* Q但你代码中

1. Dim temA As AcadBlockReference

复制代码

temA是blockC的块参照,不是blockC

1. Private Sub cmdInsert_Click()
   6 }( s: c2 M: \' u- i
2. 
   8 Z$ w9 ~, J. i% V( F* {
3. Dim ptInsert(2) As Double '原点
   4 \9 L8 n; S- V+ Z. M* g8 K4 z
4. ptInsert(0) = 0
   4 b+ j0 D% q. |/ X* c
5. ptInsert(1) = 0
   
6. ptInsert(2) = 0
   * k% A# I4 |5 ~' c0 P/ J4 U
7. 
   
8. Dim BR As AcadBlock '定义块
   
9. Set BR = ThisDrawing.Blocks.Add(ptInsert, "blockE")
   
10. 
    . n' `6 F$ T# G4 p2 c" J
11. '清除块E中原有的图元,否则每运行一次程序,blockE中都会添加一些块参照,越来越大了
    
12. Dim E As AcadEntity
    9 Y* M, a, q4 L* t  Q) A
13. For Each E In BR
    
14. E.Delete
    4 j$ D" p% C7 G/ [) w% j
15. Next
    # \( o; y. ~& J" t
16. 
    ! O1 }* f! t- l' i: k+ O
17. '----------插入块A 仅一个---------------------------------
    
18. Dim B As AcadBlockReference '声明一个块参照变量
    7 G0 q0 p- ?' o9 J6 q2 }# f
19. Dim P As Variant '声明一个变体变量用于接收三维点坐标
    
20. Set B = BR.InsertBlock(ptInsert, blkAName.Text, 1, 1, 1, 0)
    ( U) c8 s. R5 ^. q5 b' K
21. P = B.InsertionPoint '提取上一步插入的块参照的插入点坐标,返回值是三元素双精度数组
    
22. 
    
23. 
    
24. '----------插入块B---------------------------------
    2 B8 W$ i6 j9 i
25. 
    
26. Dim pNew(2) As Double
    
27. pNew(0) = P(0) - 500
    ( l- T8 Y4 N" G3 ^/ m' n
28. pNew(1) = P(1) + 1405.08
    , P8 h  A; c6 g3 p8 m9 V" f7 h- o$ A) e
29. pNew(2) = P(2)
    
30. Set B = BR.InsertBlock(pNew, blkBName.Text, 1, 1, 1, 0)
    
31. P = B.InsertionPoint '提取上一步插入的块参照的插入点坐标,返回值是三元素双精度数组
    
32. 
    7 k8 L% ^$ C. }+ ^7 O
33. 
    
34. Dim I As Integer
    
35. For I = 2 To Val(blkBNum.Text) Step 1
    7 s- o) E7 |. v
36. Dim pBNew(2) As Double
    . S" Z' E8 R7 o9 P* W6 y2 a
37. pBNew(0) = P(0)
    7 b1 \; {. O& g
38. pBNew(1) = P(1) + 2000
    ( \) ~& R4 w" q8 j5 p: Y
39. pBNew(2) = P(2)
    
40. 
    , N9 Z( v) o( J5 O+ Q( i/ D
41. Set B = BR.InsertBlock(pBNew, blkBName.Text, 1, 1, 1, 0)
    
42. P = B.InsertionPoint '提取上一步插入的块参照的插入点坐标,返回值是三元素双精度数组
    ! F5 `% [" d' H  [
43. Next
    % M5 ]4 T2 u% H' \$ t7 ^  T
44. 
    ! p* O+ G5 h# {, A7 F
45. 
    ! L. R; B) ~' g" [. y
46. '----------插入块C 仅一个---------------------------------
    
47. Dim pCNew(2) As Double
    
48. pCNew(0) = P(0)
    
49. pCNew(1) = P(1) + 2000
    ; _( T; P; {# ~+ h
50. pCNew(2) = P(2)
    ; x4 K( K# a$ W. s
51. Set B = BR.InsertBlock(pCNew, blkCName.Text, 1, 1, 1, 0)
    $ Z: ^3 C- c) h1 }
52. Set B = ThisDrawing.ModelSpace.InsertBlock(ptInsert, "blockE", 1, 1, 1, 0)
    
53. 
    
54. 
    4 e, _2 _- x. ~! K
55. '----------旋转块E---------------------------------
    7 _5 D1 t: S: F+ n- W9 p
56. B.Rotate ptInsert, 0.2
    % ~! f5 x9 f$ U3 _6 c4 n
57. 
    : u9 X$ X  b* e0 V
58. '----------查找块E中的块C的两个圆的圆心坐标---------------------------------
    
59. 
    ; r) y* R  B5 E/ g7 P
60. Dim temA As AcadBlockReference
    
61. Dim temB As AcadEntity
    
62. Dim ptCir1(2) As Double '第一个圆圆心坐标
    4 [6 Y' @4 O) W( |% H
63. Dim ptCir2(2) As Double '第二个圆圆心坐标
    & P: y2 b1 l- g( l
64. Dim C As Variant, J As Integer
    + Q& Z' B" ?# {5 p4 r
65. 
    # z3 r5 ^4 j! s6 ~: Q
66. For Each temA In BR '这个遍历就行
    
67. If temA.Name = blkCName.Text Then
    5 [! P( \! \) x
68. P = temA.InsertionPoint '提取块C参照在块E中的插入点坐标
    6 v- h- G" h& Q3 v; L$ C* R3 g  I- m
69. J = 1
    ' l) \9 K7 J% @% q
70. ' For Each temB In temA '在这里就开始出错了，因为这个temA是BlockReference,是块C的参照
    
71. For Each temB In ThisDrawing.Blocks(temA.Name) '这个才是真正的块C,呵呵
    
72. '开始找圆，找到圆就提取坐标
    ! L, {! N- \/ |- T6 L+ W/ c: T
73. If temB.ObjectName = "AcDbCircle" Then
    $ V2 [2 J1 L* n9 ~6 l0 v
74. C = temB.Center '提取圆心坐标
    . _# n; Z! K7 c/ @6 w$ Q
75. C(0) = ptInsert(0) + P(0) + C(0) '计算该圆心在模型空间的坐标--块E参照未旋转时
    
76. C(1) = ptInsert(1) + P(1) + C(1)
    , ]3 ?' \, s: D' F' S& G
77. C(2) = ptInsert(2) + P(2) + C(2)
    
78. If J = 1 Then
    1 x; |0 w/ m! K- A: {' Y! O
79. ptCir1(0) = C(0) * Cos(0.2) - C(1) * Sin(0.2)
    ' G* c& w' ~) r0 R2 m2 Y
80. ptCir1(1) = C(0) * Sin(0.2) + C(1) * Cos(0.2)
    2 t2 `9 b$ U* R; X7 t* q
81. ptCir1(2) = C(2)
    
82. J = 2
    
83. Else
    $ ^9 q) T5 a7 P5 o3 J& z6 N& l
84. ptCir2(0) = C(0) * Cos(0.2) - C(1) * Sin(0.2)
    
85. ptCir2(1) = C(0) * Sin(0.2) + C(1) * Cos(0.2)
    # Y; X7 P: C9 T% g
86. ptCir2(2) = C(2)
    
87. End If
    
88. End If
    # \( J) ]+ z7 f% \7 F( z
89. Next
    
90. End If
    + z; Y% C. r' l0 [! G
91. Next
    * I7 [% z5 M' M
92. 
    
93. 
    
94. ThisDrawing.Regen acActiveViewport
    * q1 m* ]% ^( {* t
95. 
    
96. End Sub

复制代码

( j! r9 p7 j4 s% U5 V计算圆心在块E参照旋转后在模型空间的坐标,除了上面用三角函数计算的方法外,还可以借助UCS变换或使用辅助线(点)的方法,下面是UCS变换
0 z( g$ f" k, o( Q% I1 q

1. Private Sub cmdInsert_Click()
   ! k1 Q, `. W$ c$ s; J6 E
2. Dim ptInsert(2) As Double '原点
   
3. ptInsert(0) = 0
   ) s- \' n: Y+ `' N% D& `
4. ptInsert(1) = 0
   
5. ptInsert(2) = 0
   
6. Dim BR As AcadBlock '定义块
   1 V* _: f$ M. n, t# `
7. Set BR = ThisDrawing.Blocks.Add(ptInsert, "blockE")
   
8. '清除块E中原有的图元,否则每运行一次程序,blockE中都会添加一些块参照,越来越大了
   
9. Dim E As AcadEntity
   
10. For Each E In BR
    & o* b: s9 X- I. ]* e5 a
11.     E.Delete
    
12. Next
    
13. 
    
14. '----------插入块A 仅一个---------------------------------
    % @% f3 V; g) |
15. Dim B As AcadBlockReference '声明一个块参照变量
    # D; n( {# K2 L( E( x
16. Dim P As Variant '声明一个变体变量用于接收三维点坐标
    
17. Set B = BR.InsertBlock(ptInsert, blkAName.Text, 1, 1, 1, 0)
    
18. P = B.InsertionPoint '提取上一步插入的块参照的插入点坐标,返回值是三元素双精度数组
    ' h; r5 t3 y( T1 H7 i. I
19. 
    8 p+ b5 {2 V2 g1 m, Z
20. '----------插入块B---------------------------------
    
21. Dim pNew(2) As Double
    - G0 S5 R9 E8 K  E* s! ]  n
22. pNew(0) = P(0) - 500
    
23. pNew(1) = P(1) + 1405.08
    3 p* f/ r# F  V9 h$ N8 F
24. pNew(2) = P(2)
    
25. Set B = BR.InsertBlock(pNew, blkBName.Text, 1, 1, 1, 0)
    : E% [7 |$ U3 x2 ~! g
26. P = B.InsertionPoint '提取上一步插入的块参照的插入点坐标,返回值是三元素双精度数组
    
27. Dim I As Integer
    
28. For I = 2 To Val(blkBNum.Text) Step 1
    & B  P& t" G* X/ o; e0 L; @
29.     Dim pBNew(2) As Double
    
30.     pBNew(0) = P(0)
    5 o+ g: ?' o' c5 ^
31.     pBNew(1) = P(1) + 2000
    
32.     pBNew(2) = P(2)
    
33.    
    0 d/ K6 _; U. u8 P" X
34.     Set B = BR.InsertBlock(pBNew, blkBName.Text, 1, 1, 1, 0)
    , h) w8 z1 k- n# @; `0 ?: Q9 n
35.     P = B.InsertionPoint '提取上一步插入的块参照的插入点坐标,返回值是三元素双精度数组
    1 _' s: w! V' {7 G+ ^+ L4 ?
36. Next
    
37. 
    # y; m* A, q! }8 P' Z' Z1 [
38. '----------插入块C 仅一个---------------------------------
    
39. Dim pCNew(2) As Double
    . I7 R. W1 u; K. S8 |* b5 V; U
40. pCNew(0) = P(0)
    " v, X) K1 v) U- f
41. pCNew(1) = P(1) + 2000
    ) F  o& X, y/ M/ x) V
42. pCNew(2) = P(2)
    
43. Set B = BR.InsertBlock(pCNew, blkCName.Text, 1, 1, 1, 0)
    
44. Set B = ThisDrawing.ModelSpace.InsertBlock(ptInsert, "blockE", 1, 1, 1, 0)
    " j* L! f( i' x! s! s
45. 
    & P1 O0 d# D9 t+ f! A! b; u) U
46. '----------旋转块E---------------------------------
    2 ?. g8 c" {5 B' ?6 |
47. B.Rotate ptInsert, 0.2
    / Y9 n$ T2 J) _$ E' L& ], K3 N
48. '创建两个UCS,用于下一步转换圆心在模型空间的坐标
    1 J, u- e! ?* P$ i$ I/ x
49. '其中,MyUcs是绕原点右旋0.2弧度,对应块E左旋的0.2弧度
    " \1 l0 [" w0 y9 x, Z) v
50. Dim MyUcs As AcadUCS, MyWcs As AcadUCS
    7 q/ `/ S0 f! F+ C$ P' W
51. Dim XP As Variant, YP As Variant
    
52. With ThisDrawing
    3 K% l7 t/ T9 k5 c2 f
53.     With .Utility
    
54.         XP = .PolarPoint(ptInsert, -0.2, 1)
    ! d; b& e3 Z2 F( N
55.         YP = .PolarPoint(ptInsert, -0.2 + .AngleToReal(90, acDegrees), 1)
    % D0 d( P; u6 P6 P8 I. O" a; b
56.     End With
    
57.     Set MyUcs = .UserCoordinateSystems.Add(ptInsert, XP, YP, "MyUcs")
    6 i4 y, Y2 l. w" T
58.     XP(0) = 1: XP(1) = 0
    
59.     YP(0) = 0: YP(1) = 1
    
60.     Set MyWcs = .UserCoordinateSystems.Add(ptInsert, XP, YP, "MyWcs")
    ) v; O$ m0 v* V/ a3 F2 }3 b2 H
61. End With
    5 u" v0 `- i8 ~
62. 
    - d" q% X; a4 Q7 [9 t
63. '----------查找块E中的块C的两个圆的圆心坐标---------------------------------
    
64. Dim temA As AcadBlockReference
    
65. Dim temB As AcadEntity
    - }! J, {' J4 d+ r
66. Dim ptCir1(2) As Double '第一个圆圆心坐标
    
67. Dim ptCir2(2) As Double  '第二个圆圆心坐标
    * F; O% F/ G5 H, g' b* V6 J
68. Dim C As Variant, J As Integer
    ) {6 W3 D$ e2 d1 `5 ?0 e: i
69. For Each temA In BR '这个遍历就行
    
70. If temA.Name = blkCName.Text Then
    ; x4 q3 A: p; d) @
71.    P = temA.InsertionPoint '提取块C参照在块E中的插入点坐标
    
72.    J = 1
    
73. '   For Each temB In temA   '在这里就开始出错了，因为这个temA是BlockReference,是块C的参照
    3 m3 \# A0 }) `5 Q( E
74.    For Each temB In ThisDrawing.Blocks(temA.Name) '这个才是真正的块C,呵呵
    & X4 l% D  h0 `8 Z
75.    '开始找圆，找到圆就提取坐标
    
76.     If temB.ObjectName = "AcDbCircle" Then
    4 ]+ k4 Q4 l' i9 a& V* ?
77.         C = temB.Center '提取圆心坐标
    1 P/ C" u" i' f2 w! M9 }' p% v
78.         C(0) = ptInsert(0) + P(0) + C(0) '计算该圆心在模型空间的坐标--块E参照未旋转时
    
79.         C(1) = ptInsert(1) + P(1) + C(1)
    
80.         C(2) = ptInsert(2) + P(2) + C(2)
    
81.         ThisDrawing.ActiveUCS = MyUcs '把当前坐标系改为MyUcs
    ' b! }! ^) g; X$ x
82.         C = ThisDrawing.Utility.TranslateCoordinates(C, acWorld, acUCS, False) '得到该圆心在UCS中的坐标--块E参照旋转0.2弧度后该圆心在模型空间的真正位置
      J' ~! J* x! {+ d
83.         ThisDrawing.ActiveUCS = MyWcs '把当前坐标系改回WCS
    
84.         If J = 1 Then
    
85.             ptCir1(0) = C(0)
    
86.             ptCir1(1) = C(1)
    : I- K( T) U- |
87.             ptCir1(2) = C(2)
    + c7 H+ J0 E  P9 z. J6 S. D
88.             J = 2
    
89.         Else
      ?. Z" i: J% x
90.             ptCir2(0) = C(0)
    0 v' B$ G. r$ z& D, n6 T2 G) z+ [
91.             ptCir2(1) = C(1)
    ( C" D& p* ~9 O; H" V' u4 Y
92.             ptCir2(2) = C(2)
    
93.         End If
    
94.     End If
    
95.    Next
    8 @& _8 Q6 H5 P- L3 P( ]) A- O
96. End If
      Q& l8 F7 i, A7 r0 n* _; i& Q
97. Next
    
98. 
    9 ]: P) K) u6 H7 X. {* w7 }
99. 
    
100. ThisDrawing.Regen acActiveViewport
     / ]* M, ]4 q. _0 l+ d
101. End Sub

复制代码

下面是使用辅助点
. ^& D. E2 L7 Z3 d' t! ?( k. m' U2 S

1. Private Sub cmdInsert_Click()
   # T" M1 ~8 i; \6 f; m: R
2. Dim ptInsert(2) As Double '原点
   
3. ptInsert(0) = 0
   
4. ptInsert(1) = 0
   
5. ptInsert(2) = 0
   1 B- d! h: `, u$ R3 H) N
6. Dim BR As AcadBlock '定义块
     G3 I) D& @5 C* [9 f, l
7. Set BR = ThisDrawing.Blocks.Add(ptInsert, "blockE")
   
8. '清除块E中原有的图元,否则每运行一次程序,blockE中都会添加一些块参照,越来越大了
   
9. Dim E As AcadEntity
   
10. For Each E In BR
    
11.     E.Delete
    
12. Next
    
13. '----------插入块A 仅一个---------------------------------
    5 R! p. U/ ]0 h, i- h. k+ U
14. Dim B As AcadBlockReference '声明一个块参照变量
    
15. Dim P As Variant '声明一个变体变量用于接收三维点坐标
    
16. Set B = BR.InsertBlock(ptInsert, blkAName.Text, 1, 1, 1, 0)
      j2 h& A' U: f' R! r8 [: _
17. P = B.InsertionPoint '提取上一步插入的块参照的插入点坐标,返回值是三元素双精度数组
    
18. 
    
19. '----------插入块B---------------------------------
    0 l2 P0 `1 U4 u& }. [
20. Dim pNew(2) As Double
    
21. pNew(0) = P(0) - 500
    
22. pNew(1) = P(1) + 1405.08
    1 f) v% M; W1 p, s# Q6 p4 Z
23. pNew(2) = P(2)
    0 n$ i4 u5 f7 }  X0 j
24. Set B = BR.InsertBlock(pNew, blkBName.Text, 1, 1, 1, 0)
    
25. P = B.InsertionPoint '提取上一步插入的块参照的插入点坐标,返回值是三元素双精度数组
    
26. 
    
27. Dim I As Integer
    
28. For I = 2 To Val(blkBNum.Text) Step 1
      P* ^" R- X# K  a9 `4 j
29.     Dim pBNew(2) As Double
    
30.     pBNew(0) = P(0)
      f, `" _4 w' f8 f$ L9 Q, k9 X/ p
31.     pBNew(1) = P(1) + 2000
    ' f) b2 Z! {9 d. \/ G. v
32.     pBNew(2) = P(2)
    
33.    
    
34.     Set B = BR.InsertBlock(pBNew, blkBName.Text, 1, 1, 1, 0)
    - i5 ^  l$ v& l6 O8 o% W
35.     P = B.InsertionPoint '提取上一步插入的块参照的插入点坐标,返回值是三元素双精度数组
    
36. Next
    8 |- t/ \( F0 h4 _3 e* W" @
37. 
    " \+ A# p2 A+ |) ]0 f( v
38. '----------插入块C 仅一个---------------------------------
    
39. Dim pCNew(2) As Double
    , c$ v. |' G9 }
40. pCNew(0) = P(0)
    6 G# x+ h1 L# L& W1 q( ^
41. pCNew(1) = P(1) + 2000
    
42. pCNew(2) = P(2)
      x- L" r: G! I
43. Set B = BR.InsertBlock(pCNew, blkCName.Text, 1, 1, 1, 0)
    
44. Set B = ThisDrawing.ModelSpace.InsertBlock(ptInsert, "blockE", 1, 1, 1, 0)
    3 G" r  _; n0 n9 ]9 V
45. 
    
46. '----------旋转块E---------------------------------
    
47. B.Rotate ptInsert, 0.2
      }. K. p* F" j" w5 p: \" h
48. '----------查找块E中的块C的两个圆的圆心坐标---------------------------------
    : h3 [! I: `: d  N
49. Dim temA As AcadBlockReference
    
50. Dim temB As AcadEntity
    
51. Dim ptCir1(2) As Double '第一个圆圆心坐标
    
52. Dim ptCir2(2) As Double  '第二个圆圆心坐标
      [# g4 b: P$ ~+ x5 M
53. Dim C As Variant, J As Integer
    
54. Dim ObjP As AcadPoint '点对象,用于下一步计算圆心坐标
    
55. For Each temA In BR '这个遍历就行
    9 N$ C  z, i" f/ N. z# ^7 w
56. If temA.Name = blkCName.Text Then
    
57.    P = temA.InsertionPoint '提取块C参照在块E中的插入点坐标
      u2 G+ w% `7 f: F& s
58.    J = 1
    
59. '   For Each temB In temA   '在这里就开始出错了，因为这个temA是BlockReference,是块C的参照
    
60.    For Each temB In ThisDrawing.Blocks(temA.Name) '这个才是真正的块C,呵呵
    
61.    '开始找圆，找到圆就提取坐标
    
62.     If temB.ObjectName = "AcDbCircle" Then
    7 W& i0 j: M2 y" e6 g& e
63.         C = temB.Center '提取圆心坐标
    
64.         C(0) = ptInsert(0) + P(0) + C(0) '计算该圆心在模型空间的坐标--块E参照未旋转时
    
65.         C(1) = ptInsert(1) + P(1) + C(1)
    ' D. y- g( ^' r$ ^/ w$ a  s
66.         C(2) = ptInsert(2) + P(2) + C(2)
    0 g- r; v3 o. l% n: O* G
67.         Set ObjP = ThisDrawing.ModelSpace.AddPoint(C) '在块E参照未旋转时的该圆圆心画一个辅助点
    
68.         ObjP.Rotate ptInsert, 0.2 '和块E一样,让该点以原点为基点旋转0.2弧度
    
69.         C = ObjP.Coordinates '提取点坐标,即该圆心在模型空间真正的位置
    & i; v$ l6 O# S( v; i9 G
70.         ObjP.Delete '删除用过的辅助点
    
71.         If J = 1 Then
    + D) i1 q4 L3 N: v$ o" O
72.             ptCir1(0) = C(0)
    & d$ o( g9 z. A3 z% F
73.             ptCir1(1) = C(1)
    
74.             ptCir1(2) = C(2)
    
75.             J = 2
    / w2 ?1 ]% F) O/ S3 D8 D( E9 Z
76.         Else
    
77.             ptCir2(0) = C(0)
    
78.             ptCir2(1) = C(1)
    
79.             ptCir2(2) = C(2)
      ]( g  D- e$ F3 V0 t" n5 V- t- T; n
80.         End If
    
81.     End If
    
82.    Next
    7 i% g% |+ f; a2 _% E# X0 b/ c
83. End If
    2 H- r* L0 Q) N& Z9 P
84. Next
    
85. 
    2 i& o7 y/ Z$ c/ \
86. ThisDrawing.Regen acActiveViewport
    0 A: {5 G( i: ]# S
87. End Sub

复制代码

tataki

- r6 p. p* s* L3 N6 u 8# woaishuijia
昨晚看到斑竹的回复，今天早上正准备给回复呢，没想到你一大早就重新编辑了帖子，还把圆心坐标的算法都用了三种方法给求解，让我这个7点还在睡觉的无地自容....
; A. Q/ {+ P  P4 E2 Q5 U: i你以前说过“所谓"嵌套块"是指一个块定义中包含有其它块的参照.3 G* n9 B1 ?% L) K( U4 \+ Q”，所以我temA定义的是AcadBlockReference，呵呵，这个我觉得没问题。
当然我也想过定义 temA为 AcadEntity 或者 Object，不过遇到了错误，这里一并询问（稍后我问，呵呵，先说block）

斑竹的意思是不是说不论给“块”添加图元或者要遍历，都是以“块”为对象的，而不是块参照。
我第一层遍历 For Each temA In BR 没有错，因为BR就是我定义的“块”，属于blocks集合里面，
而到了第二层 ，我原来写的是 For Each temB In temA  ‘temA定义的是“块参照”，当然也就错了...应该从blocks这个集合里面找到原始的"块" blockC 来遍历，所以你用了.Blocks(temA.Name)这个写法找到了“块”，嘿嘿 ，understand！

另外，斑竹写的这一段让我发现自己考虑不周到，呵呵，确实是没运行一次，blockE里面的东西越来越多...
" b) C: ~0 x9 y: _- k'清除块E中原有的图元,否则每运行一次程序,blockE中都会添加一些块参照,越来越大了
Dim E As AcadEntity
2 K8 ^2 `2 |* tFor Each E In BR
E.Delete
Next
- x2 \3 \& k9 g8 H( m


第二个就是圆心坐标，我昨晚这么写了一下:
Dim temA As AcadBlockReference
Dim temB As AcadEntity
% e; t: X: Z$ S+ t) `0 fDim ptCir(1) As Variant  '圆心坐标
5 W, ~& m/ H1 A& ~% l4 k
For Each temA In BR '这个遍历就行
9 o6 z* H( T0 [/ L: l If temA.Name = blkCName.Text Then
! r4 Z+ j8 x7 @ i = 0
' N. `5 _* \! b   For Each temB In ThisDrawing.Blocks(temA.Name)
    '开始找圆，找到圆就提取坐标
    If temB.ObjectName = "AcDbCircle" Then
) ?% a6 \( E+ i/ K2 e2 b0 {  N7 _       ptCir(i) = temB.Center: i = i + 1
2 q& D# M' O8 s) E: e    End If
. J* v8 w7 g, @' F0 S9 u% P: ^8 F  Next
End If
Next

这样找到的圆心坐标并不是我要求的，我调试了一下发现，这样求的坐标实际上是“块” blockC里两个圆的圆心坐标，而这两个坐标应该是从blockC 的“坐标系”开始算的吧，我的blockC刚好是矩形，所以计算坐标原点恰好是矩形左下角点，我推测，如果blockC不规则，那么坐标原点应该是对blockC使用getboundary后确定的那个边框的左下角点，呵呵，猜测的，还没验证。
所以斑竹用了三种方法算需要的坐标，当然，用三角函数这个确实最合理，呵呵。我能看懂。
另外使用UCS，这个方法好~上周发过贴恰好问过lisp中trans的用法，这次在vba中见到你那篇帖子里提到的对应的TranslateCoordinates的用法了，我得学习消化下
辅助点这个方法，说实话，我都不敢用，我怕的就是往图纸上添加一个点容易，删除一个点麻烦了，呵呵，水平不够，要努力！

说完了这个，我再问问定义temA的问题，我是这么想的：
因为blockE里面只有块参照，所以temA自然而然的定义成了AcadBlockReference，对应的使用temA.Name就行
后来我想过为什么不定义temA为AcadEntity（我也试过了定义AcadObject）呢，因为这样的用法很常见啊，但是发现错了，因为就没有temA.Name属性了，只有temA.ObjectName属性，但是后者返回的是“AcdbBlockReference”，并不是块的名字...我再想是不是因为“块”比较特殊，有特定的名字，所以只能定义temA为AcadBlockReference后才能找到块的名字，其他的都不行。
进一步讲，定义temA为AcadBlockReference，我觉得局限性挺大的，因为我这里的blockE确实只含有“块参照”，没有其他图元，比如直线，文字等，如果我给blockE里面再添加一点直线或者文字（块里面添加文字应该很常用），这样我遍历BlockE的时候，就会出错，因为文字里面没有temA.Name属性...所以要想完整的遍历包含块参照和各种图元的块且不出错该怎么做好呢？

woaishuijia

- L4 E+ w9 u' }9# tataki

斑竹的意思是不是说不论给“块”添加图元或者要遍历，都是以“块”为对象的，而不是块参照。

. l( z# C) u* q, W2 M* B正确.
多说几句:能够"遍历"的前提是对象是一个集合,而集合是有"Item"方法的.比如Documents,ModelSpace,PaperSpace,SelectionSets,SelectionSet,Groups,Group,Blocks,Block,TextStyles,Layers,LineTypes等等,都是集合,都可以遍历.但BlockReference不行,它不是集合,而是一个块定义的实例.文档中同一个块的每个参照包含的子对象都是一样的(除其中的属性值外),它包含的图元种类数量位置都完全相同,因为这取决于其定义,所以想提取任何一个块参照内部子对象的特性,只能到其定义中去找.除了块参照对象的属性值是用BlockReference的GetAttributes方法,获取其属性参照对象数组.而属性定义对象本身的添加和编辑也是要在Block对象中进行

我调试了一下发现，这样求的坐标实际上是“块” blockC里两个圆的圆心坐标，而这两个坐标应该是从blockC 的“坐标系”开始算的吧

3 D4 P% Y( |% ~6 u: i! I% p. K5 k正确

我的blockC刚好是矩形，所以计算坐标原点恰好是矩形左下角点，我推测，如果blockC不规则，那么坐标原点应该是对blockC使用getboundary后确定的那个边框的左下角点，呵呵，猜测的，还没验证。

+ d. c# K: i1 t9 {0 d# o错了.
0 V2 v& a' U& S我们在使用Blocks集合对象的Add方法新建Block对象时有两个参数,第二个是块名称字符串,你懂的;而第一个InsertionPoint,就是块基点.我们在图形界面选择一个块参照对象时,块参照会有一个蓝色亮显的夹持点,这就是块基点.正像你前面说是那样,块定义是有自己的坐标系的.我们往块定义中添加图元是使用块定义的坐标系,同样,创建块定义时给定的块基点也是使用这个坐标系.通常我们在创建块时把块基点放在块定义的坐标系的原点,就是InsertionPoint参数使用(0,0,0).这样可以减少坐标换算的麻烦.
在我们向模型空间或图纸空间或其它块定义中添加块参照时,块参照是以块基点为准放到插入点(就是InsertBlock方法的InsertionPoint参数)上的.
就是说,当我们把块定义的块基点设为(0,0,0)时,块参照的子对象的位置坐标就等于其在块中的坐标与块参照的插入点坐标之和.
- y; `- O# b' \1 u9 j0 f/ P& ?当块定义的块基点不是(0,0,0)时,块参照的子对象的位置坐标等于其在块中的坐标与块基点坐标之差再与块参照的插入点坐标之和.
GetBoundingBox方法可以得到的矩形框的左下角点,在本例中与块C参照的块基点坐标重合,只是巧合而已.如果块C的块基点不在左下角,或块C参照被旋转了一个角度,就不重合了.

要想完整的遍历包含块参照和各种图元的块且不出错该怎么做好呢？

6 y* h  |! j2 \% I6 @: F增加一个条件语句就可以了

1. Dim temA As AcadEntity
   
2. Dim temB As AcadEntity
   & j7 l) W( ^8 w0 L- y1 t7 |! @1 O
3. Dim ptCir(1) As Variant  '圆心坐标
   
4. For Each temA In BR '这个遍历针对块中的Entity
   
5.     If temA.ObjectName = "AcDbBlockReference" Then'先检查temA是否块参照
   
6.         If temA.Name = blkCName.Text Then'确定是块参照后再检查其名称
   6 h- F% K# t3 \3 @0 ^' k
7.             i = 0
   9 g3 @( `+ _; q) [
8.             For Each temB In ThisDrawing.Blocks(temA.Name)
   ; c3 Z, Y" F+ T8 B$ U
9.                 '开始找圆，找到圆就提取坐标
     L! w! G: ]0 c6 \. r" o
10.                 If temB.ObjectName = "AcDbCircle" Then
    + A3 ?# k9 R8 p( Q" X* j. t
11.                    ptCir(i) = temB.Center: i = i + 1
    . T) Y1 f" _! _' d  B( @
12.                 End If
    
13.             Next
    " r& T  D1 C/ _0 p9 p4 N8 I
14.         End If
    
15.     End If
    
16. Next

复制代码

tataki

“通常我们在创建块时把块基点放在块定义的坐标系的原点,就是InsertionPoint参数使用(0,0,0).这样可以减少坐标换算的麻烦.”
你这一句一下让我想到了一件事：
我的blockE是我在代码中指定的基点 0,0,0
但是其他几个块A B C D是我用GUI方式定义在图纸里面的，当时我觉得方便就把C块基点设置在了左下角（cad提示我选择基点）
! f: O0 E9 G. E. H/ L$ T8 v对于GUI方式设置的基点，cad会默认把块坐标系的原点设置在这个基点上！而且基点的坐标就是0,0,0，感觉很诡异，这个在cad2011里面很明显，打开块编辑器后，明显的看到块坐标系的原点就是默认设置到我选择的基点上，图里左边是模型空间的坐标显示，右边就是块编辑的坐标显示！！！！这个我一直没注意！而我当初给blockE设置基点的时候只是图了方便设置到原点上，看来真是碰巧！也就是说，如果通过GUI方式，默认的就是基点和原点重合且是0,0,0，这样确实方便了以后的编辑！而用代码方式就是要指定基点了。
- Z8 S. p, d# \2 d+ _) u我这样理解的对吗？
) M4 r$ V: C* X, x% p' C- y
呵呵，还有后面那个完整的遍历包含块参照和各种图元的块且不出错的代码真好，先用objectName找出是块参照的，然后再查询块参照的name进行对比，满足后再进入块的子项

woaishuijia

11# tataki 完全正确

cctv9527

“就像在模型空间里添加块参照一样。就是说这样的嵌套块只是个定义好了块，下一步就是在模型空间里把这个块的 块参照给insertBlock出来”
这话还是有点不明白
子函数1 我定义块A  里面放个梯形
0 o" k- R) [4 B3 @* S2 F子函数2 再定义块B 里面放个矩形 再插入块A
图形空间中我会反复调用A B
画图能画 VBA B插入A 不明白  
新手 望指导下

weisad

插入块好像挺难的