采用标记不闭合处画圆
;;采用标记不闭合处画圆 By ls (2013年2月2日10时30分47秒)(defun c:tt (/ AT采用M:SearchSSByList AT采用Pl:GetClose C DIST ENAME ENDPT FILTER FIND I L R RETURN SS STARTPT)
(vl-load-com)
(setq filter (list (cons 0 "*line,ELLIPSE,ARC")));采用针对线 椭圆 圆弧
(setq ss (ssget filter));采用创建选择集
(setq return '());采用返回的点表
(setq dist 0.01);采用距离
(setq r 2);采用圆的半径 实型
(setq l "Err");采用创建的圆所在的图层 字符型
(setq c 3);采用圆的颜色(颜色号) 整型
;;采用指定距离搜索实体图元
(defun AT采用M:SearchSSByList (pt S采用Dist tylst / PT采用A PT采用CL PT采用LIST RVAL SS X)
(setq pt采用list '())
(setq rVal nil)
(setq pt采用cl (list 0 0.25 0.5 0.75 1 1.25 1.5 1.75))
(setq pt采用a (mapcar '(lambda (x) (* x pi)) pt采用cl))
(foreach n采用pt采用a pt采用a
(setq pt采用list (cons (polar pt n采用pt采用a S采用Dist) pt采用list))
)
(setqss (ssget "cp" pt采用list tylst))
(if (/= ss nil)
(setq rVal ss)
(setq rVal nil)
)
rVal
)
;;采用曲线是否闭合
(defun AT采用Pl:GetClose (ename / PLIST RETURN)
(setq return nil)
(if (vlax-curve-isClosed ename)
(setq return T)
(progn
(setq plist (list (vlax-curve-getStartPoint ename) (vlax-curve-getEndPoint ename)))
(if (equal (car plist) (last plist))
(setq return T)
(setq return nil)
)
)
)
return
)
(if ss
(progn
(setq i -1)
(command "zoom" "e")
(princ "\n正在处理,请稍等...")
(princ)
(while (setq ename (ssname ss (setq i (1+ i))))
(if (not (AT采用Pl:GetClose ename));采用忽略本身已闭合的
(progn
(setq startpt (vlax-curve-getStartPoint ename));采用起点
(setq endpt (vlax-curve-getEndPoint ename));采用终点
(foreach pt (list startpt endpt)
(setq find (AT采用M:SearchSSByList pt dist filter))
(if find
(progn
(setq find (ssdel ename find)) ;采用删除自身的
(if (= (sslength find) 0)
(setq return (cons pt return))
)
)
(setq return (cons pt return))
)
)
)
)
)
(command "zoom" "p")
)
)
(if return
(progn
(foreach pt return
(entmakex (list '(0 . "CIRCLE") '(100 . "AcDbEntity") '(100 . "ACDbCircle") (cons 10 pt) (cons 40 r) (cons 8 l) (cons 62 c) '(210 0. 0. 1.)))
)
(princ (strcat "\n共检测到 " (itoa (length return)) " 处.."))
)
)
(princ)
)
页:
[1]