过滤出零长度的线段

荒野孤行

还在为图档中零长度的线而烦恼吗？这个程序可以帮您解除烦忧。请见演示图片：

;;;*****选出零长度的线 程序开始****
(defun c:t1 ()
  (setvar "cmdecho" 0)
  (princ "\n★功能：查找出零长度的短线并置于特定图层.\n")
  (vl-load-com)  (command "undo" "be")
  (initget 6)
  (if
    (not
      (setq maxlen (getreal "\n要查找的线段最大长度为：<0.0001>"))
    )
(setq maxlen 0.0001)
  )
  (setq ss (ssget '((0 . "ARC,*POLYLINE,LINE,CIRCLE,SPLINE"))))
  (setq        i 0
        j 0
  )
  (setq laystr (strcat "层-长度小于" (rtos maxlen) "的线"))
  (command "LAYER" "M" laystr "C" "1" laystr "")
  (repeat (sslength ss)
    (setq entnam (ssname ss i))
    (setq obj (vlax-ename->vla-object entnam))
    (if
      (< (vlax-curve-getdistatparam
           obj
           (vlax-curve-getendparam obj)
         )
         maxlen
      )
       (progn
         (vla-put-layer obj laystr)
         (setq j (+ j 1))
       )
    )
    (setq i (+ i 1))
  )
  (princ (strcat "\n★提示：共将满足条件的"
                 (itoa j)
                 "条线置于 "
                 laystr
                 " 图层.\n"
         )
  )
    (command "undo" "e")(princ)
)
;;;*****选出零长度的线 程序结束****

追寻

高人

ming_5687

感謝分享                        

sicky111

很实用的程序

dabingrain

看看内容，支持楼主

flfcegu168

明天用电脑下来看看，先赞一个

longer1000

感谢分享  

flfcegu168

看个究竟有多好

mitenickevin

很实用的程序，感谢分享

cj52000

谢谢，下来看看学习下