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

cyfdean

      近来由于工作原因：常用Type3 做切割编程，要用到内切，外割（前题是线段是要封闭）.
      虽然论坛有其类似的LSP代码（如:断线查错）,但是用过后还是不理想，也用过 赖心秀工具箱，可是要加载很多不常用的工具条，很不爽。最后就请GU_xl帮我写了一个，用过后，感觉与赖版的工具箱中的（检查线段是否断开）相比，还要好用。现在和大家分享一下原代码。

加载XLRX_API:
功能:悬挂线检查
(defun c:tt()
(setq d (getreal "\n容差值<0.0001>"))
(if (null d) (setq d 0.0001))
  (if (setq ss (ssget '((0 . "*line,arc,ellipse"))))
     (XLRX-Curve-CheckXuangua  ss 0.5 d)
  )
(princ)
)

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
加载XLRX_API:
功能:悬挂线检查
  
    语法: (XLRX-Curve-CheckXuangua ss [r = 0.5] [tol = 0.0001])

      参数:

        ss 曲线选择集

        r 可选参数，绘制圆的半径，默认 = 0.5

        tol 可选参数，容差值，默认 = 0.0001
      
     返回值: 无

－－－－－－－－－－－－－－－－－－－－
希望那位大侠有时间，为之添加点色彩：
1、检查线的颜色变为红色。
2、检查线的会聚点可否定为当前UCS ,而不是世界坐标点 0，0，0
3、若在容差的范围内，没有断开点，加上这句：“选取的线段没有发现断开!”

荒野孤行

maxli 发表于 2017-8-27 14:41
你那个附件的是你改过了的么？能不收币不。。。最近明经里面不能充。。穷死了

好。我改成免币的。

荒野孤行

;;;*****查悬挂线 程序开始*****
(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
)
;;;*****查悬挂线 程序结束*****

maxli

荒野孤行 发表于 2017-8-23 22:47
;;;*****查悬挂线 程序开始*****
(defun C:T1 (/ ptList ptNo)
  (princ "\n★功能：查找悬挂断开的线段 ...

你那个附件的是你改过了的么？能不收币不。。。最近明经里面不能充。。穷死了

Gu_xl

1. (defun c:tt ()
   
2.   (setq d (getreal "\n容差值<0.0001>"))
   
3.   (setq endent (entlast))
   
4.   (if (null d)
   
5.     (setq d 0.0001)
   
6.   )
   
7.   (if (setq ss (ssget '((0 . "*line,arc,ellipse"))))
   
8.     (progn
   
9.       (XLRX-Curve-CheckXuangua ss 0.5 d)
   
10.       (if (equal endent (entlast))
    
11.         (princ "\选取的线段没有发现断开!")
    
12.         (while (setq endent (entnext endent))
    
13.           (xlrx-set endent "PointAt" 0 (trans '(0 0 0) 1 0))
    
14.           (xlrx-set endent "color" 1)
    
15.         )
    
16.       )
    
17.     )
    
18.   )
    
19.   (princ)
    
20. )

(defun c:tt ()<br />   (setq d (getreal "\n容差值<0.0001>"))<br />   (setq endent (entlast))<br />   (if (null d)<br />     (setq d 0.0001)<br />   )<br />   (if (setq ss (ssget '((0 . "*line,arc,ellipse"))))<br />     (progn<br />       (XLRX-Curve-CheckXuangua ss 0.5 d)<br />       (if (equal endent (entlast))<br />         (princ "\选取的线段没有发现断开!")<br />         (while (setq endent (entnext endent))<br />           (xlrx-set endent "PointAt" 0 (trans '(0 0 0) 1 0))<br />           (xlrx-set endent "color" 1)<br />         )<br />       )<br />     )<br />   )<br />   (princ)<br /> )

荒野孤行

请看这里：http://bbs.mjtd.com/thread-108142-1-1.html

cyfdean

荒野孤行 发表于 2015-5-5 23:33
请看这里：http://bbs.mjtd.com/thread-108142-1-1.html

你那个我试用过了，不完美，请用GU_XL版这个。这比燕秀工具箱那个还好用。

荒野孤行

cyfdean 发表于 2015-5-6 09:01
你那个我试用过了，不完美，请用GU_XL版这个。这比燕秀工具箱那个还好用。

伪源码，用不了。

ivde

荒野孤行 发表于 2015-5-6 20:55
伪源码，用不了。

什么叫“伪源码”？！

cyfdean

荒野孤行 发表于 2015-5-6 20:55
伪源码，用不了。

看清开头了没有呀？
源码工作前提是先要加载GU_XL版主的对应CAD版本XLRX_API:函数库，这一步你做了吗！

荒野孤行

cyfdean 发表于 2015-5-8 09:30
看清开头了没有呀？
源码工作前提是先要加载GU_XL版主的对应CAD版本XLRX_API:函数库，这一步你做了吗！

太麻烦，自己写。

cyfdean

荒野孤行 发表于 2015-5-8 23:09
太麻烦，自己写。

GU_XL版主已帮我们写好了呀，复制代码——打开记事本——粘贴代码内容——另存为LSP文件即可