查找悬挂线及其断开位置

荒野孤行

因在某些行业设计的图纸中，多段线要求封闭，但是有时填充时发现多段线不是闭合的，但是如果直接封闭，可能对相邻的线产生影响，故采用查找功能，效果图如下：


附上第一种程序写法的源码：

1. ;;;*****查悬挂线  程序开始*****
   
2. (defun c:t1 (/ ptlist)
   
3.   (princ "\n★功能：查找断开的曲线。\n")
   
4.   (setvar "pickadd" 1)
   
5.   (setvar "osmode" 15359)
   
6.   (setvar "PICKDRAG" 0)
   
7.   (setvar "cmdecho" 0)
   
8.   (command "undo" "be")
   
9.   (princ "\n选取多段线：")
   
10.   (setq ss (ssget '((0 . "LWPOLYLINE,POLYLINE"))))
    
11.   (if (not ss)
    
12.     (progn (princ "\n提示：未选取对象.") (exit))
    
13.   )
    
14.   (initget 7)
    
15.   (setq ptbase (getpoint "\n指定标记引出线的位置点："))
    
16.   (setvar "osmode" 0)
    
17.   (setq        i   0
    
18.         num (sslength ss)
    
19.   )
    
20.   (command "color" "Bylayer")
    
21.   (command "LAYER" "M" "层-未闭合线" "C" "250" "层-未闭合线" "")
    
22.   (command "LAYER" "M" "层-标记" "C" "1" "层-标记" "")
    
23.   (repeat num
    
24.     (setq entnam (ssname ss i)
    
25.           obj         (vlax-ename->vla-object entnam)
    
26.     )
    
27.     (if        (not (vlax-curve-isclosed obj))
    
28.       (progn
    
29.         (setq pt_start (vlax-curve-getstartpoint obj)
    
30.               pt_end   (vlax-curve-getendpoint obj)
    
31.               ptlist   (cons (list pt_start pt_end) ptlist)
    
32.         )
    
33.         (setq en (entget entnam))
    
34.         (entmod (subst (cons 8 "层-未闭合线") (assoc 8 en) en))
    
35.       )
    
36.     )
    
37.     (setq i (+ i 1))
    
38.   )
    
39.   (if (not ptlist)
    
40.     (alert "提示：恭喜你，没有发现未闭合的对象！\n")
    
41.     (progn
    
42.       (foreach pt ptlist
    
43.         (command "PLINE" (car pt) ptbase (cadr pt) "")
    
44.       )
    
45.       (alert
    
46.         "提示：抱歉，发现了未闭合的对象！\n已将其置于“层-未闭合线”图层。断开位置见参照线指引。\n"
    
47.       )
    
48.     )
    
49.   )
    
50.   (command "undo" "e")
    
51.   (setvar "osmode" 15359)
    
52.   (princ)
    
53. )
    
54. ;;;*****查悬挂线  程序结束*****

;;;*****查悬挂线  程序开始*****<br /> (defun c:t1 (/ ptlist)<br />   (princ "\n★功能：查找断开的曲线。\n")<br />   (setvar "pickadd" 1)<br />   (setvar "osmode" 15359)<br />   (setvar "PICKDRAG" 0)<br />   (setvar "cmdecho" 0)<br />   (command "undo" "be")<br />   (princ "\n选取多段线：")<br />   (setq ss (ssget '((0 . "LWPOLYLINE,POLYLINE"))))<br />   (if (not ss)<br />     (progn (princ "\n提示：未选取对象.") (exit))<br />   )<br />   (initget 7)<br />   (setq ptbase (getpoint "\n指定标记引出线的位置点："))<br />   (setvar "osmode" 0)<br />   (setq        i   0<br />         num (sslength ss)<br />   )<br />   (command "color" "Bylayer")<br />   (command "LAYER" "M" "层-未闭合线" "C" "250" "层-未闭合线" "")<br />   (command "LAYER" "M" "层-标记" "C" "1" "层-标记" "")<br />   (repeat num<br />     (setq entnam (ssname ss i)<br />           obj         (vlax-ename->vla-object entnam)<br />     )<br />     (if        (not (vlax-curve-isclosed obj))<br />       (progn<br />         (setq pt_start (vlax-curve-getstartpoint obj)<br />               pt_end   (vlax-curve-getendpoint obj)<br />               ptlist   (cons (list pt_start pt_end) ptlist)<br />         )<br />         (setq en (entget entnam))<br />         (entmod (subst (cons 8 "层-未闭合线") (assoc 8 en) en))<br />       )<br />     )<br />     (setq i (+ i 1))<br />   )<br />   (if (not ptlist)<br />     (alert "提示：恭喜你，没有发现未闭合的对象！\n")<br />     (progn<br />       (foreach pt ptlist<br />         (command "PLINE" (car pt) ptbase (cadr pt) "")<br />       )<br />       (alert<br />         "提示：抱歉，发现了未闭合的对象！\n已将其置于“层-未闭合线”图层。断开位置见参照线指引。\n"<br />       )<br />     )<br />   )<br />   (command "undo" "e")<br />   (setvar "osmode" 15359)<br />   (princ)<br /> )<br /> ;;;*****查悬挂线  程序结束*****

hai20110730

(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)
)

tiduck

hai20110730 发表于 2018-7-15 17:27
(defun c:t1 (/); ptList ptNo)
  (setvar "pickadd" 1)
  (setvar "osmode" 15359)

能不能再优化一下
未发现断开时  直接在命令栏里面显示  没有发现悬挂线对象      结束命令   不需要再指定点  和弹出消息框

tiduck

GNJLISP 发表于 2017-8-29 18:05
谢谢，为了这一个功能装燕秀有了这个就不用再装个燕秀了想要的就是这样的效果，但怎么总有一个点查不到？

对   就为了  合并线段和检查断点安装燕秀的    有了就不用安装了

依然小小鸟

不错的帖子 顶一下

18112600842

学习学习......

Ennmaai

SSSSSSSSSSSS

yichuan

感谢分享！！！！！

QQ873240166

太复杂  有没有单lsp文件直接加载的

hai20110730

优化了下，但是对于端点在另一线上的点，还是没法判定为非悬挂点。