查找悬挂线及其断开位置
本帖最后由 荒野孤行 于 2017-9-1 18:22 编辑因在某些行业设计的图纸中，多段线要求封闭，但是有时填充时发现多段线不是闭合的，但是如果直接封闭，可能对相邻的线产生影响，故采用查找功能，效果图如下：
附上第一种程序写法的源码：
;;;*****查悬挂线程序开始*****
(defun c:t1 (/ ptlist)
(princ "\n★功能：查找断开的曲线。\n")
(setvar "pickadd" 1)
(setvar "osmode" 15359)
(setvar "PICKDRAG" 0)
(setvar "cmdecho" 0)
(command "undo" "be")
(princ "\n选取多段线：")
(setq ss (ssget '((0 . "LWPOLYLINE,POLYLINE"))))
(if (not ss)
(progn (princ "\n提示：未选取对象.") (exit))
)
(initget 7)
(setq ptbase (getpoint "\n指定标记引出线的位置点："))
(setvar "osmode" 0)
(setq i 0
num (sslength ss)
)
(command "color" "Bylayer")
(command "LAYER" "M" "层-未闭合线" "C" "250" "层-未闭合线" "")
(command "LAYER" "M" "层-标记" "C" "1" "层-标记" "")
(repeat num
(setq entnam (ssname ss i)
obj (vlax-ename->vla-object entnam)
)
(if (not (vlax-curve-isclosed obj))
(progn
(setq pt_start (vlax-curve-getstartpoint obj)
pt_end (vlax-curve-getendpoint obj)
ptlist (cons (list pt_start pt_end) ptlist)
)
(setq en (entget entnam))
(entmod (subst (cons 8 "层-未闭合线") (assoc 8 en) en))
)
)
(setq i (+ i 1))
)
(if (not ptlist)
(alert "提示：恭喜你，没有发现未闭合的对象！\n")
(progn
(foreach pt ptlist
(command "PLINE" (car pt) ptbase (cadr pt) "")
)
(alert
"提示：抱歉，发现了未闭合的对象！\n已将其置于“层-未闭合线”图层。断开位置见参照线指引。\n"
)
)
)
(command "undo" "e")
(setvar "osmode" 15359)
(princ)
)
;;;*****查悬挂线程序结束*****
(defun c:t1 (/); ptList ptNo)
(setvar "pickadd" 1)
(setvar "osmode" 15359)
(setvar "PICKDRAG" 0)
(setvar "cmdecho" 0)
(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)
(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))
)
)
)
(setq ptNo nil ptListf (reverse (cdr (reverse ptList))))
(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 (member pt ptListf))
(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)
) hai20110730 发表于 2018-7-15 17:27
(defun c:t1 (/); ptList ptNo)
(setvar "pickadd" 1)
(setvar "osmode" 15359)
能不能再优化一下
未发现断开时直接在命令栏里面显示没有发现悬挂线对象 结束命令 不需要再指定点和弹出消息框 GNJLISP 发表于 2017-8-29 18:05
谢谢，为了这一个功能装燕秀有了这个就不用再装个燕秀了想要的就是这样的效果，但怎么总有一个点查不到？
对 就为了合并线段和检查断点安装燕秀的 有了就不用安装了 不错的帖子 顶一下
学习学习...... SSSSSSSSSSSS 感谢分享！！！！！ 太复杂有没有单lsp文件直接加载的 优化了下，但是对于端点在另一线上的点，还是没法判定为非悬挂点。