请帮忙查找并夹点显示出相交的多边形[已解决]
本帖最后由 tender138 于 2013-12-2 17:14 编辑请帮忙查找并夹点显示出相交的多边形（图中绿色的多边形），谢谢！
本帖最后由 自贡黄明儒 于 2013-12-3 09:54 编辑
遍历选择对象，求有无交点
<P>;;亮显交点对象
(defun C:w1 (/ 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
)
(sssetfirst nil SS1)
;;(command "erase" ss1 "")
)</P>
<P>;;删除小于指定间距的圆
(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)))
)</P>
<P>(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))
)
)
)
)
)
)
)
)</P> 谢谢！请问有无快速方法？因为每个对象都要遍历全部对象比较，很慢
非常感谢自贡黄明儒老师！我很多问题都是你帮忙我解决的，谢谢！！！ 另外我想再请教一个问题：
为什么我用
(command "_.ucs" 3 P1 P2 "")
(command "._redraw")
的时候屏幕要显示全图？请问有什么系统变量控制的么?
页:
[1]