一个看似简单却很难的问题，请教各位大侠！

shahoy

问题是这样的
) ~2 j# J3 x: S, f6 V把图中凡是与红色圆有相交的对象删除，而保留没有与红色圆相交的其他对象
（也就是说，红色圆不能与其他对象重叠）
; d$ W* f, A# \- a% T8 e问题的难点是：如果红色圆量非常之多，而与红色圆相交的对象也非常之多，那有什么方法可以将那些与红色圆相交的对象一次性都选择起来删除掉？
* u) a& Q' F3 r. \  d) c
' @) @0 \3 N! o请教各位大侠！
附件里有JPG的图和dwg的图，请教了！

CAD删除相交对象.jpg

CAD删除相交对象.dwg (75.82 KB, 下载次数: 10)

2009-12-28 23:08 上传

点击文件名下载附件
CAD删除相交对象.dwg

woaishuijia

VBA代码,供参考
6 Z) m( ]( R% a3 u: x* t. [

1. 
   
2.     Dim SS选择集1 As AcadSelectionSet, SS选择集2 As AcadSelectionSet, Int过滤器类型() As Integer, Var过滤器值() As Variant
   ; p# i7 h  z6 P5 F+ n6 _' b& e9 \8 Z
3.     Dim Cir红色圆 As AcadCircle, Ent被检查是否与红色圆相交的图元对象 As AcadEntity
   & S+ Y- F, T  [5 i! X; h5 W) t
4.     Dim Ent与红色圆相交的对象数组() As AcadEntity, Bln与红色圆相交的对象数组不为空 As Boolean
   
5.     Dim Ent块参照的子对象数组 As Variant, Var交点坐标数组 As Variant, Bln被检查对象与红色圆相交 As Boolean
   ( I8 x, W9 K  s0 [! u% Z
6.     Dim Int循环变量 As Long
   
7.     With ThisDrawing
   " R. E  y8 b! S' n
8.         ReDim Int过滤器类型(3), Var过滤器值(3) '设置选择集过滤器为选择红色圆
   4 a3 Q9 t$ m: J
9.         Int过滤器类型(0) = -4
   
10.         Var过滤器值(0) = "<and"
    
11.         Int过滤器类型(1) = 0
    
12.         Var过滤器值(1) = "circle"
    
13.         Int过滤器类型(2) = 62
    ; l% Q+ X7 u. X
14.         Var过滤器值(2) = acRed
    
15.         Int过滤器类型(3) = -4
    1 _, R/ `4 O. E1 b1 o
16.         Var过滤器值(3) = "and>"
    & H% \- |8 `% W) F# N; {
17.         Set SS选择集1 = .SelectionSets.Add("选择集1") '创建第一个选择集
    
18.         SS选择集1.Select acSelectionSetAll, , , Int过滤器类型, Var过滤器值 '选择全部红色圆
    
19.         ReDim Int过滤器类型(5), Var过滤器值(5) '重新设置选择集过滤器为选择除红色圆以外的其它图元对象
    $ X5 `8 S) M6 Q; I' R5 a, Q1 ?
20.         Int过滤器类型(0) = -4
      O# }7 Q$ s* ^+ s  ]0 j. {$ h* @; S
21.         Var过滤器值(0) = "<not"
    $ y. }% U3 n6 N2 P
22.         Int过滤器类型(1) = -4
    : r, u3 ]! M: g# b) e9 L: K
23.         Var过滤器值(1) = "<and"
    
24.         Int过滤器类型(2) = 0
      I6 b; Y& x7 o. w0 ^1 J, G
25.         Var过滤器值(2) = "circle"
    8 d3 R4 V, T" a9 l
26.         Int过滤器类型(3) = 62
    
27.         Var过滤器值(3) = acRed
    
28.         Int过滤器类型(4) = -4
    % S8 i% @9 [# W% j+ f, e0 F' g6 G
29.         Var过滤器值(4) = "and>"
      o% B+ G* x, s" h) E  s( t
30.         Int过滤器类型(5) = -4
    
31.         Var过滤器值(5) = "not>"
    
32.         Set SS选择集2 = .SelectionSets.Add("选择集2") '创建第二个选择集
    7 s% L: C( W/ u
33.         SS选择集2.Select acSelectionSetAll, , , Int过滤器类型, Var过滤器值 '选择除红色圆以外的全部图元对象
    / Q$ p- _& l+ m
34.         For Each Ent被检查是否与红色圆相交的图元对象 In SS选择集2 '逐个检查第二个选择集中的对象与第一个选择集中每个红色圆是否相交
    
35.             For Each Cir红色圆 In SS选择集1
    0 m! e/ K4 V. ?' b
36.                 If Ent被检查是否与红色圆相交的图元对象.ObjectName = "AcDbBlockReference" Then '被检查的对象为块参照时必须检查其子对象
    + C/ h9 ^0 L5 r5 e. r
37.                     Ent块参照的子对象数组 = Ent被检查是否与红色圆相交的图元对象.Explode '用分解方法获取与块参照子对象对应的临时图元数组
    
38.                     If UBound(Ent块参照的子对象数组) > 0 Then '如果块参照存在子对象
    , p2 l( V. z  {: }1 p1 L9 q
39.                         Bln被检查对象与红色圆相交 = False
    / T' }; H, w3 j: v) y1 [
40.                         For Int循环变量 = 0 To UBound(Ent块参照的子对象数组) '逐个检查子对象
    
41.                             Var交点坐标数组 = Cir红色圆.IntersectWith(Ent块参照的子对象数组(Int循环变量), acExtendNone) '获取子对象与红色圆交点坐标数组
    
42.                             Ent块参照的子对象数组(Int循环变量).Delete '删除用过的临时图元对象
    5 E% E. [* K5 O$ ^% x$ |
43.                             If UBound(Var交点坐标数组) >= 0 Then Bln被检查对象与红色圆相交 = True '如果存在交点则记为该块参照与红色圆相交
    
44.                         Next
    
45.                     End If
    
46.                 Else '对象为直线/圆等普通图元,可以直接检查其是否与红色圆相交
    
47.                     Var交点坐标数组 = Cir红色圆.IntersectWith(Ent被检查是否与红色圆相交的图元对象, acExtendNone) '获取该对象与红色圆交点坐标数组
    
48.                     If UBound(Var交点坐标数组) >= 0 Then Bln被检查对象与红色圆相交 = True '如果存在交点则记为该对象与红色圆相交
    
49.                 End If
    
50.                 If Bln被检查对象与红色圆相交 Then '如果存在相交则把该对象存入数组
    2 H+ ?5 B2 m$ X
51.                     If Not Bln与红色圆相交的对象数组不为空 Then
    
52.                         Bln与红色圆相交的对象数组不为空 = True
    + f( L# D  _' Z( t2 }
53.                         ReDim Ent与红色圆相交的对象数组(0)
    
54.                         Set Ent与红色圆相交的对象数组(0) = Ent被检查是否与红色圆相交的图元对象
    9 u0 H, w$ N8 v/ _# u
55.                     Else
    
56.                         ReDim Preserve Ent与红色圆相交的对象数组(UBound(Ent与红色圆相交的对象数组) + 1)
    : g7 `+ ^3 M2 m8 `( U
57.                         Set Ent与红色圆相交的对象数组(UBound(Ent与红色圆相交的对象数组)) = Ent被检查是否与红色圆相交的图元对象
    7 D0 t7 y8 j1 H# c7 q2 [) C4 V
58.                     End If
    $ O3 e- G* I( H( ^- N2 `
59.                 End If
    " i$ d; e0 S5 w/ w3 l7 e
60.                 DoEvents
    ) N8 u5 N: g0 R/ z$ o' t. H
61.             Next
    
62.         Next
    ; z* w2 w! @8 |
63.         SS选择集1.Delete '删除用过的选择集
    : V8 T( R3 h  l1 v' h$ d5 b
64.         SS选择集2.Delete
    
65.         If Bln与红色圆相交的对象数组不为空 Then '删除与红色圆相交的对象
    
66.             For Int循环变量 = 0 To UBound(Ent与红色圆相交的对象数组)
    , S9 }" l, s% W! G
67.                 Ent与红色圆相交的对象数组(Int循环变量).Delete
    & v, }, v: B9 Q5 t
68.             Next
    1 t0 e8 C1 G' d" v" a5 m% y0 \4 f/ M
69.         End If
    # v& O7 ~" U) k5 q. ]/ R
70.     End With
    7 x% [) z$ V( y2 t  M' V

复制代码

shahoy

版主太强大了！！！
. r8 g- X1 ~# J( Z佩服啊，真是太厉害了！！！

www1974

该为图案填充不知道会不会更好些？？

shahoy

看了下版主的代码，在CAD里鼓捣鼓捣，还是没搞出来，真是掉汗啊
呵呵，版主是如何弄出来的呢，操作步骤能否共享之？！非常感谢啊！

woaishuijia

) A, V1 D9 a* W
# j, @, G1 Q6 j9 H  N* u5 C首先,你的CAD程序要保证安装了VBA(不能是最小安装).
把上面帖子中的代码复制到剪贴板.
* A& R+ c; t4 L8 a打开你的文件,命令行键入"vbaide".弹出VBAIDE界面.这一步骤也可以通过按快捷键"ALT+F11"或在CAD图形界面的菜单上打开"工具">"宏">"Visual Basic 编辑器"来实现.
在VBAIDE界面左侧的"工程资源管理器"上双击"Thisdrawing",右面会出现代码窗口
1 k6 [# ~6 S* o6 k4 Q在代码窗口键入"sub A",回车(其中A是宏的名称,建议使用其它有意义的文字或单词,注意它与"sub"之间有一个半角空格)
3 l  K1 R5 v/ Q& I) I输入的代码会自动变成

1. 
   3 E* R4 D0 a' ~; Z
2. Sub A()
   , m8 W' U/ m" M7 v/ ^6 ^  |3 m. _; o
3. 
   
4. End Sub
   

复制代码

4 R# L  a0 V/ [在两行之间的空行上粘贴从2楼帖子中复制的代码
关闭VBAIDE窗口,返回图形界面
在图形界面,命令行键入"vbarun",弹出宏对话框,点"运行".这一步骤也可以通过按快捷键"ALT+F8"或在菜单上打开"工具">"宏">"宏..."来实现,还可以在命令行键入"-vbarun",这样不会打开对话框,而是按命令行的提示在命令行中键入宏名称,即可运行宏.
耐心等待CAD完成检查相交及删除的工作,这需要一些时间(我的电脑是奔D915+1G,运行了几十秒),毕竟图形上有48个圆和2400个块参照,要逐个检查的.

关闭CAD程序时, 会有一个提示,问你是否保存宏.如果你以后还会用到的话就把它保存下来.以后再次使用时可以按下面步骤操作
在CAD图形界面,命令行键入"vbaload"或"appload",在弹出的对话框上选择要用到的宏加载,这一步骤也可以通过菜单上打开"工具">"宏">"加载工程"来实现,还可以在命令行键入"-vbaload",这样不会打开对话框,而是按命令行的提示在命令行中键入宏文件路径来加载工程.
( H5 m/ n! J4 N9 J" c; `, p6 p" U加载工程后就可以按上面的方法(vbarun)运行宏了

shahoy

非常感谢版主的解答！！！
  G9 z9 ?/ b7 t5 `9 i* l  n/ G" [很详细！很清晰！
: c- B5 b5 J! M: h4 O8 i9 \高手就是不一样啊！
% h. {' }3 Z1 }4 Z再次感谢，并向你学习！