删除小于指定间距的圆

自贡黄明儒

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

;;亮显相交对象<br /> (defun C:w1 (/ I 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 />   ;;(repeat (setq i (sslength ss1))(redraw (ssname ss1 (setq i (1- 1))) 3))<br />   ;;(setvar "selectionpreview" 0)            ;06以上<br />   (sssetfirst nil SS1)<br />   ;;(ayEntSSHighLight SS1)<br />   ;;(command "erase" ss1 "")<br /> )<br /> <br /> ;;删除小于指定间距的圆<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 />   )<br /> <br />   (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 /> )

newbuser

怎么没用到运算域的算法？想学习哈。[em0]

chenbh2

可不可帮下面代码改成不用指定间距,直接删除圆!
;;删除圆
(defun C:w2 (/ DIS LST SS X Y)
  (defun Is-Ename (arg) (equal (type arg) 'ename))
  (defun pdpx (en1 en2)
    (distance (cdr (assoc 10 (entget en1))) (cdr (assoc 10 (entget en2))))
  )
  ;;120.1 [功能] 选择集->图元列表
  (defun MJ:SS->LIST (SS)
    (vl-remove-if-not 'Is-Ename (mapcar 'cadr (ssnamex SS)))
  )

  (if (and (setq ss (ssget '((0 . "Circle"))))
     (setq dis (getdist "\n输入最小距离: "))
      )
    (progn
      (setq lst (MJ:SS->LIST ss))
      (foreach x lst
  (foreach y lst
    (if (and (entget x) (entget y))
      (if  (equal x y)
        nil
        (if (< (pdpx x y) dis)
    (progn (entdel x) (entdel Y))
        )
      )
    )
  )
      )
    )
  )
)

wutao8282

老师，如何改成显亮指定间距的圆呢？不需要删除，人为检查删除就好了，。最好圆和线之间满足指定间距也显亮