查找悬挂线及其断开位置

荒野孤行 · 发表于 2013-10-30 19:20:43

本帖最后由荒野孤行于 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) 
  (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) 
) 
;;;*****查悬挂线  程序结束*****

hai20110730 · 发表于 2018-7-15 17:27:10

(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 · 发表于 2020-4-16 15:22:58

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

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

tiduck · 发表于 2020-4-16 15:24:27

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

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

依然小小鸟 · 发表于 2024-3-3 12:22:44

不错的帖子顶一下

18112600842 · 发表于 2024-3-2 14:47:22

学习学习......

Ennmaai · 发表于 2020-10-9 22:53:08

SSSSSSSSSSSS

yichuan · 发表于 2020-3-30 14:35:52

感谢分享！！！！！

QQ873240166 · 发表于 2020-3-29 18:54:23

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

hai20110730 · 发表于 2018-7-15 17:28:51

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

账号		自动登录	找回密码
密码			注册

[源码] 查找悬挂线及其断开位置

本帖子中包含更多资源

相关帖子