VBA怎样选择一个大圆或者矩形里的所有对象

taqqug

请教大家，我现在在写一个小程序时碰到要选择一个大圆里的所有小圆，还有一个大矩形里的小圆，请问好实现吗？我百思不得其解，请大家帮忙，谢谢了！
$ ^0 t6 b% `6 y" R' \功能描述：1.比如我想选一个大圆里所有小圆，当我点按钮“选择所有”，提示我先选择一个大圆，然后我点选大圆之后，所有的小圆被选中。
# v0 v9 v/ X$ w2 |* f1 y                   2.我想选择一个斜方向的矩形里的所有小圆，点按钮“选择所有”，提示先选择一个矩形，点矩形后，矩形里所有的小圆被选中。

woaishuijia

ACAD并不支持根据对象选择,只能用"圈围"方法近似地做.当边界为圆时,可以尽可能多地在圆周上取点,用一个近似圆的多边形做边界;对多段线(矩形就是闭合的二维多段线),可以使用多段线的顶点,但不允许自交,如果是开发准备发布的通用工具,就要对可能的自交做检查,以区别对待.而且当二维多段线有凸起(圆弧段)时,也要区别对待.下面的代码仅供参考.

1. 
   
2. Private Const N As Long = 100 '声明一个常数,指定从圆周上拾取"圈围"的点数
   
3. 
   . u1 T8 E# v& r3 N# l: V- T! d, Q6 a
4. Sub A()
   
5.     Dim S1 As AcadSelectionSet '声明第一个选择集,用于从屏幕上选取做为下一步选择集边界的对象
   / f: L: z+ s$ {7 F% V
6.     Dim S2 As AcadSelectionSet '声明第二个选择集,用于选取边界内部对象
   " B) e, b# x2 f  @( B$ _
7.     Dim FT(3) As Integer, FD(3) As Variant '声明选择集过滤器
   
8.     Dim OldPICKADD As Long '声明一个长整形变量,用于存放原"pickadd"系统变量
   & ~' w, g  z5 K5 r, e4 k( c9 Y
9.     Dim P() As Double '声明一个动态数组,用于存放"圈围"点集的三维坐标
   8 Y& A  V" n6 h0 F
10.     Dim I As Long '循环变量
    6 U% C, h5 e1 Y& K" |' F1 V3 o( ], v
11.     Dim V As Variant '边界圆的圆心或矩形的顶点坐标
    % V. m7 Q  o8 u+ K: \9 G
12.    
    & d# h0 U( O! j5 I  F! g! d
13.     On Error Resume Next
    
14.    
    
15.     FT(0) = -4: FD(0) = "<or" '设置选择集过滤器为选择圆或二维多段线
    4 q; N2 \1 i1 F- N9 y; P
16.     FT(1) = 0: FD(1) = "Circle"
    . k% W5 E! E) |' M
17.     FT(2) = 0: FD(2) = "LWPolyLine"
    
18.     FT(3) = -4: FD(3) = "or>"
    1 l& m1 d) {0 a
19.     With ThisDrawing
    
20.         OldPICKADD = .GetVariable("pickadd" ) '记录原"pickadd"系统变量
    & H3 ^) G4 y. g+ e" Z
21.         .SetVariable "pickadd", 0 '把"pickadd"系统变量临时改为0(用 SHIFT 键添加到选择集),只为方便,不是必要的
    
22.         Set S1 = .SelectionSets.Add("S1" ) '新建选择集,用于从屏幕上选取边界对象
    
23.         S1.SelectOnScreen FT, FD '在屏幕上选取圆或二维多段线
      F; L( h. O  x1 ]) {$ o
24.         .SetVariable "pickadd", OldPICKADD '把"pickadd"系统变量改回原值
    / I& F" }# l; y6 b
25.         If S1.Count > 0 Then '如果在屏幕上有效选取了边界对象
    6 j4 o& M. m# b
26.             If S1.Item(S1.Count - 1).ObjectName = "AcDbCircle" Then '如果选取的最后一个对象是"圆"
    9 p9 U6 C: c2 S! @4 T4 T/ I, I4 p. d9 J9 q
27.                 ReDim P(N * 3 - 1) '按"圈围"点集数量重定义三维坐标数组
    6 [% v4 {* b5 u  `  L6 K
28.                 V = S1.Item(S1.Count - 1).Center '提取圆心坐标
    2 ^& p9 H, T) O3 ~5 r# H/ R
29.                 For I = 0 To N - 1 '在圆周上按点集数量均匀取点计算圈围点集坐标
    9 z3 y3 B# Y% C/ V2 @) O3 R
30.                     P(I * 3) = V(0) + S1.Item(S1.Count - 1).Radius * Cos(CDbl(I) / CDbl(N) * 2 * .Utility.AngleToReal(180, acDegrees))
    
31.                     P(I * 3 + 1) = V(1) + S1.Item(S1.Count - 1).Radius * Sin(CDbl(I) / CDbl(N) * 2 * .Utility.AngleToReal(180, acDegrees))
    
32.                 Next
    
33.             Else '如果选取的最后一个对象是二维多段线
    & O) ^. ~' }9 N! j- q& N0 w# h9 n9 j5 }, P
34.                 V = S1.Item(S1.Count - 1).Coordinates '提取二维多段线顶点坐标(二维)
    
35.                 ReDim P((UBound(V) \ 2) * 3 + 2) '按多段线顶点数量重定义圈围点集三维坐标数组
    0 P  R3 H, V5 f* f$ v" Z# p! K. M
36.                 For I = 0 To UBound(V) \ 2 '把多段线二维坐标写入三维坐标数组
    
37.                     P(I * 3) = V(I * 2)
    
38.                     P(I * 3 + 1) = V(I * 2 + 1)
    ) X) X4 ^& v9 F* {
39.                 Next
    
40.             End If
    5 h5 e. c3 o) ~9 i
41.             Set S2 = .SelectionSets.Add("S2" ) '新建选择集,用于选取边界内部对象
    / s4 u! ?( w9 ?7 `* D& B9 g( n3 E! l
42.             S2.SelectByPolygon acSelectionSetWindowPolygon, P '根据点集圈选
    
43.             '自行处理边界内部被选择的对象
    
44.             S2.Delete '删除用过的选择集
    9 k! ~: A8 S4 P
45.         End If
    
46.         S1.Delete '删除用过的选择集
    
47.     End With
      }( V) r: D7 Y' V% N7 Q. G$ l
48. End Sub
    $ z; `  J/ F) w1 j/ K6 h1 g

复制代码

taqqug

我当初的想法是先选择所有的小圆，再判断小圆的圆心坐标在不在大圆的范围内，还有删除与大圆想交的，这样效率不高，还是老师你的高明。谢谢了！