删除小于指定间距的圆
;;亮显相交对象(defun C:w1 (/ I LST SS SS1 X Y)
(defun Is-Ename (arg) (equal (type arg) 'ename))
(defun pdpx (en1 en2 / KJ)
(setq kj (mapcar 'vlax-ename->vla-object (list en1 en2)))
(vlax-invoke (car kj) 'intersectwith (cadr kj) 0)
)
;;120.1 [功能] 选择集->图元列表
(defun MJ:SS->LIST (SS)
(vl-remove-if-not 'Is-Ename (mapcar 'cadr (ssnamex SS)))
)
(setq ss1 (ssadd))
(setq ss (ssget))
(setq lst (MJ:SS->LIST ss))
(mapcar '(lambda (x)
(mapcar '(lambda (y)
(if (equal x y)
nil
(if (pdpx x y)
(progn (ssadd x ss1) (ssadd y ss1))
)
)
)
lst
)
)
lst
)
;;(repeat (setq i (sslength ss1))(redraw (ssname ss1 (setq i (1- 1))) 3))
;;(setvar "selectionpreview" 0) ;06以上
(sssetfirst nil SS1)
;;(ayEntSSHighLight SS1)
;;(command "erase" ss1 "")
)
;;删除小于指定间距的圆
(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))
)
)
)
)
)
)
)
) 怎么没用到运算域的算法？想学习哈。 可不可帮下面代码改成不用指定间距,直接删除圆!
;;删除圆
(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))
)
)
)
)
)
)
)
) 老师，如何改成显亮指定间距的圆呢？不需要删除，人为检查删除就好了，。最好圆和线之间满足指定间距也显亮
页:
[1]