检查cad检查线压盖lisp_悬挂线检查——检查线段是否断开，并画圆标注

;;;*****查悬挂线 程序开始*****

(defun C:T1 (/ ptList ptNo)

(princ "\n★功能：查找悬挂断开的线段集\n")

(setvar "pickadd" 1)

(setvar "osmode" 15359)

(setvar "PICKDRAG" 0)

(setvar "cmdecho" 0)

;  (wdy_timeset1)

(command "undo" "be")

(princ "\n请选取直线、多段线、样条曲线、圆弧：")

(if (not (setq ss (ssget '((0 . "*LINE,ARC")))))

(progn (princ "\未选中对象。程序退出！") (exit))

)

(initget 1)

(setq ptBase (getpoint "\n指定标记引出线的位置点："))

(command "LAYER" "M" "层标记-悬挂线" "C" "1" "层标记-悬挂线" "")

(setvar "osmode" 0)

(vl-load-com)

(setq        i -1

ptList nil

ptNo nil

)

(repeat (sslength ss)

(setq entnam  (ssname ss (setq i (1+ i)))

obj          (vlax-ename->vla-object entnam)

ptStart (vlax-curve-GetStartPoint obj)

ptEnd          (vlax-curve-GetEndPoint obj)

)

(if        (not (vlax-curve-isclosed obj))

(progn

(setq ptList (cons ptStart ptList))

(setq ptList (cons ptEnd ptList))

)

)

)

(prin1 ptList)

(while (setq pt     (car ptList)

ptList (cdr ptList)

)

(if        (wdy_cxgx_duibi pt ptList)

(setq ptList (vl-remove pt ptList))

(setq ptNo (cons pt ptNo))

)

)

;| (while (setq pt     (car ptList)

ptList (cdr ptList)

)

(if        (member pt ptList)

(setq ptList (vl-remove pt ptList))

(setq ptNo (cons pt ptNo))

)

)|;                                        ;另一种写法，无精度判断，算法较差

(if (not ptNo)

(alert "提示：\n恭喜你！没有发现悬挂线对象。\n")

(progn

(foreach pt ptNo

(command "LINE" pt ptBase "")

)

(alert

"提示：\n发现了悬挂线对象！\n\n请根据“层标记-悬挂线”图层中的引出线位置点进行查看悬挂线位置点。\n"

)

)

)

(command "undo" "e")

(setvar "osmode" 15359)

(princ)

)

(defun wdy_cxgx_duibi (pt0 lst / TorF x)

(setq TorF nil)

(foreach x lst

(if        (equal pt0 x 0.001)

(setq TorF T)

)

)

TorF

)

;;;*****查悬挂线 程序结束*****