请帮忙查找并夹点显示出相交的多边形[已解决]

tender138

请帮忙查找并夹点显示出相交的多边形（图中绿色的多边形），谢谢！

自贡黄明儒

遍历选择对象，求有无交点

2. 
   
3. <P>;;亮显交点对象
   
4. (defun C:w1 (/ LST SS SS1 X Y)
   
5.   (defun Is-Ename (arg) (equal (type arg) 'ename))
   
6.   (defun pdpx (en1 en2 / KJ)
   
7.     (setq kj (mapcar 'vlax-ename->vla-object (list en1 en2)))
   
8.     (vlax-invoke (car kj) 'intersectwith (cadr kj) 0)
   
9.   )
   
10.   ;;120.1 [功能] 选择集->图元列表
    
11.   (defun MJ:SS->LIST (SS)
    
12.     (vl-remove-if-not 'Is-Ename (mapcar 'cadr (ssnamex SS)))
    
13.   )
    
14.   (setq ss1 (ssadd))
    
15.   (setq ss (ssget))
    
16.   (setq lst (MJ:SS->LIST ss))
    
17.   (mapcar '(lambda (x)
    
18.       (mapcar '(lambda (y)
    
19.    (if (equal x y)
    
20.      nil
    
21.      (if (pdpx x y)
    
22.        (progn (ssadd x ss1) (ssadd y ss1))
    
23.      )
    
24.    )
    
25.         )
    
26.        lst
    
27.       )
    
28.     )
    
29.    lst
    
30.   )
    
31.   (sssetfirst nil SS1)
    
32.   ;;(command "erase" ss1 "")
    
33. )</P>
    
34. <P>;;删除小于指定间距的圆
    
35. (defun C:w2 (/ DIS LST SS X Y)
    
36.   (defun Is-Ename (arg) (equal (type arg) 'ename))
    
37.   (defun pdpx (en1 en2)
    
38.     (distance (cdr (assoc 10 (entget en1))) (cdr (assoc 10 (entget en2))))
    
39.   )
    
40.   ;;120.1 [功能] 选择集->图元列表
    
41.   (defun MJ:SS->LIST (SS)
    
42.     (vl-remove-if-not 'Is-Ename (mapcar 'cadr (ssnamex SS)))
    
43.   )</P>
    
44. <P>  (if (and (setq ss (ssget '((0 . "Circle"))))
    
45.     (setq dis (getdist "\n输入最小距离: "))
    
46.       )
    
47.     (progn
    
48.       (setq lst (MJ:SS->LIST ss))
    
49.       (foreach x lst
    
50. (foreach y lst
    
51.    (if (and (entget x) (entget y))
    
52.      (if (equal x y)
    
53.        nil
    
54.        (if (< (pdpx x y) dis)
    
55.   (progn (entdel x) (entdel Y))
    
56.        )
    
57.      )
    
58.    )
    
59. )
    
60.       )
    
61.     )
    
62.   )
    
63. )</P>

<br /> <P>;;亮显交点对象<br /> (defun C:w1 (/ LST SS SS1 X Y)<br />   (defun Is-Ename (arg) (equal (type arg) 'ename))<br />   (defun pdpx (en1 en2 / KJ)<br />     (setq kj (mapcar 'vlax-ename->vla-object (list en1 en2)))<br />     (vlax-invoke (car kj) 'intersectwith (cadr kj) 0)<br />   )<br />   ;;120.1 [功能] 选择集->图元列表<br />   (defun MJ:SS->LIST (SS)<br />     (vl-remove-if-not 'Is-Ename (mapcar 'cadr (ssnamex SS)))<br />   )<br />   (setq ss1 (ssadd))<br />   (setq ss (ssget))<br />   (setq lst (MJ:SS->LIST ss))<br />   (mapcar '(lambda (x)<br />       (mapcar '(lambda (y)<br />    (if (equal x y)<br />      nil<br />      (if (pdpx x y)<br />        (progn (ssadd x ss1) (ssadd y ss1))<br />      )<br />    )<br />         )<br />        lst<br />       )<br />     )<br />    lst<br />   )<br />   (sssetfirst nil SS1)<br />   ;;(command "erase" ss1 "")<br /> )</P><br /> <P>;;删除小于指定间距的圆<br /> (defun C:w2 (/ DIS LST SS X Y)<br />   (defun Is-Ename (arg) (equal (type arg) 'ename))<br />   (defun pdpx (en1 en2)<br />     (distance (cdr (assoc 10 (entget en1))) (cdr (assoc 10 (entget en2))))<br />   )<br />   ;;120.1 [功能] 选择集->图元列表<br />   (defun MJ:SS->LIST (SS)<br />     (vl-remove-if-not 'Is-Ename (mapcar 'cadr (ssnamex SS)))<br />   )</P><br /> <P>  (if (and (setq ss (ssget '((0 . "Circle"))))<br />     (setq dis (getdist "\n输入最小距离: "))<br />       )<br />     (progn<br />       (setq lst (MJ:SS->LIST ss))<br />       (foreach x lst<br /> (foreach y lst<br />    (if (and (entget x) (entget y))<br />      (if (equal x y)<br />        nil<br />        (if (< (pdpx x y) dis)<br />   (progn (entdel x) (entdel Y))<br />        )<br />      )<br />    )<br /> )<br />       )<br />     )<br />   )<br /> )</P>

tender138

谢谢！请问有无快速方法？因为每个对象都要遍历全部对象比较，很慢

tender138

非常感谢自贡黄明儒老师！我很多问题都是你帮忙我解决的，谢谢！！！

tender138

另外我想再请教一个问题：
为什么我用
      (command "_.ucs" 3 P1 P2 "")
      (command "._redraw")
的时候屏幕要显示全图？请问有什么系统变量控制的么?