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

taqqug

请教大家，我现在在写一个小程序时碰到要选择一个大圆里的所有小圆，还有一个大矩形里的小圆，请问好实现吗？我百思不得其解，请大家帮忙，谢谢了！
功能描述：1.比如我想选一个大圆里所有小圆，当我点按钮“选择所有”，提示我先选择一个大圆，然后我点选大圆之后，所有的小圆被选中。
" W7 g3 {) ~3 B$ ^! t* F3 a, q5 Z5 o                   2.我想选择一个斜方向的矩形里的所有小圆，点按钮“选择所有”，提示先选择一个矩形，点矩形后，矩形里所有的小圆被选中。

woaishuijia

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

1. 
   
2. Private Const N As Long = 100 '声明一个常数,指定从圆周上拾取"圈围"的点数
   ! E9 A1 ^' `. P5 K7 u
3. 
   
4. Sub A()
   ! m+ q+ T* k: N
5.     Dim S1 As AcadSelectionSet '声明第一个选择集,用于从屏幕上选取做为下一步选择集边界的对象
   
6.     Dim S2 As AcadSelectionSet '声明第二个选择集,用于选取边界内部对象
   
7.     Dim FT(3) As Integer, FD(3) As Variant '声明选择集过滤器
   
8.     Dim OldPICKADD As Long '声明一个长整形变量,用于存放原"pickadd"系统变量
   
9.     Dim P() As Double '声明一个动态数组,用于存放"圈围"点集的三维坐标
   
10.     Dim I As Long '循环变量
    
11.     Dim V As Variant '边界圆的圆心或矩形的顶点坐标
    . G0 p( B& S; G. o: H0 T6 i+ k
12.    
    
13.     On Error Resume Next
    : Z, O0 O5 f2 A7 o" C$ L/ j8 m
14.    
    / }4 |6 b* ~9 ]' _  ]
15.     FT(0) = -4: FD(0) = "<or" '设置选择集过滤器为选择圆或二维多段线
    0 ~; @8 n2 x: F2 o, b4 `
16.     FT(1) = 0: FD(1) = "Circle"
    0 o" h8 i8 z4 M; f- `- {
17.     FT(2) = 0: FD(2) = "LWPolyLine"
    + D" H5 j. A; `
18.     FT(3) = -4: FD(3) = "or>"
    * {: u) {. W' J4 |
19.     With ThisDrawing
    
20.         OldPICKADD = .GetVariable("pickadd" ) '记录原"pickadd"系统变量
    - g8 e( u" Y2 k2 [, b5 g! }
21.         .SetVariable "pickadd", 0 '把"pickadd"系统变量临时改为0(用 SHIFT 键添加到选择集),只为方便,不是必要的
    5 B' Y  n! y* [1 V1 i
22.         Set S1 = .SelectionSets.Add("S1" ) '新建选择集,用于从屏幕上选取边界对象
    
23.         S1.SelectOnScreen FT, FD '在屏幕上选取圆或二维多段线
    0 q6 Z( @8 F( P( N
24.         .SetVariable "pickadd", OldPICKADD '把"pickadd"系统变量改回原值
    * a" N/ \: D  r7 b+ P- Y+ d) e
25.         If S1.Count > 0 Then '如果在屏幕上有效选取了边界对象
    
26.             If S1.Item(S1.Count - 1).ObjectName = "AcDbCircle" Then '如果选取的最后一个对象是"圆"
    
27.                 ReDim P(N * 3 - 1) '按"圈围"点集数量重定义三维坐标数组
    
28.                 V = S1.Item(S1.Count - 1).Center '提取圆心坐标
    ! e5 _1 r5 G+ I8 L
29.                 For I = 0 To N - 1 '在圆周上按点集数量均匀取点计算圈围点集坐标
    , v! K+ _% {2 o, W. f
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))
    % y9 ]1 G' r* c8 o  K1 F6 Q7 N
32.                 Next
    
33.             Else '如果选取的最后一个对象是二维多段线
    ( z5 B( I  h$ f5 v; W$ M# z) j
34.                 V = S1.Item(S1.Count - 1).Coordinates '提取二维多段线顶点坐标(二维)
    : u" i  o# W# f# \
35.                 ReDim P((UBound(V) \ 2) * 3 + 2) '按多段线顶点数量重定义圈围点集三维坐标数组
    * [1 f9 o" t! Z9 c
36.                 For I = 0 To UBound(V) \ 2 '把多段线二维坐标写入三维坐标数组
    . e: J3 ^% B4 j8 ?
37.                     P(I * 3) = V(I * 2)
    
38.                     P(I * 3 + 1) = V(I * 2 + 1)
    " R% a, G4 r' T, P
39.                 Next
    
40.             End If
    
41.             Set S2 = .SelectionSets.Add("S2" ) '新建选择集,用于选取边界内部对象
    + N. ~$ q/ j' q, K9 \- |
42.             S2.SelectByPolygon acSelectionSetWindowPolygon, P '根据点集圈选
    
43.             '自行处理边界内部被选择的对象
    5 ^: p; q1 c% h' [7 x
44.             S2.Delete '删除用过的选择集
    
45.         End If
    
46.         S1.Delete '删除用过的选择集
    . H; L4 e, m9 y
47.     End With
    
48. End Sub
    , T. |& J2 V) i9 s5 T

复制代码

taqqug

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