aaa862 发表于 2012-7-20 19:25:45

谁有批量删除短小线的插件

谁有批量删除短小线的插件，即用户输入长度，框选范围，即该长度范围内的线全被删除。

2496653555 发表于 2021-4-21 10:40:45


;批量删除短小线的插件
(defun c:e3 (/ s n index ent leng)
(setvar "cmdecho" 0)(command "UNDO" "G")
(if (not va) (progn (setq va 0.3)) (setq va2 va))
(setq va2 (getreal (strcat "\n請輸入欲删除線长在<0.3>以下之圖元<" (rtos va) ">:")))
(if (not va2) (setq va2 va) (setq va va2))
(setq entde (ssadd))
(setq s (ssget '((0 . "line,arc,circle,POLYLINE,LWPOLYLINE,SPLINE"))))
(setq n (sslength s))                     
(setq index (- n 1))                     
(repeat n
    (vl-load-com)
    (setq ent (ssname s index))
    (setq curve-obj (vlax-ename->vla-object ent))
    (setq leng (vlax-curve-getDistAtParam
               curve-obj
               (vlax-curve-getEndParam curve-obj)
               )
    )
    (setq index (- index 1))
    (if (> leng va2)
      T
      (progn
      (setq entde (ssadd ent entde))
      )
   )
);(prompt (strcat "\r余 " (itoa (- SSL N)) " 个物件   "))
(command "_.ERASE" entde "")
(setq mm (sslength entde))
;(prompt (strcat "\共删除长度" (itoa (VA2)) "以下图元" (itoa (entde)) " 个 "))
(princ "\n共删除长度")
(princva2)
(princ "以下图元")
(princ mm)
(princ"个")
(command "UNDO" "E")
(princ)
)

1254888410 发表于 2021-1-19 23:10:25

(defun c:eed (/ s n index ent leng)
(setq entde (ssadd))
(setq s (ssget "X" '((0 . "line,arc,circle,POLYLINE,LWPOLYLINE,SPLINE"))))
(setq n (sslength s))                       
(setq index (- n 1))                       
(repeat n
    (vl-load-com)
    (setq ent (ssname s index))
    (setq curve-obj (vlax-ename->vla-object ent))
    (setq leng (vlax-curve-getDistAtParam
               curve-obj
               (vlax-curve-getEndParam curve-obj)
             )
    )
    (setq index (- index 1))
    (if (> leng 0.005)
      T
      (progn
        (setq entde (ssadd ent entde))
      )
   )
)
(command "_.ERASE" entde "")
(princ)
)

随梦而飞 发表于 2012-7-23 15:43:50

痛苦，可能别人发布的插件都是下载后再上传的

chpmould 发表于 2012-7-23 21:00:45

不知这要求用在哪方面

Andyhon 发表于 2012-7-24 09:53:10

Roughly...
(vl-load-com)
(defun C:3ShortObj ()
   (setq MinL (getDist "\n Length Limit to: ")
         ss (ssget '((0 . "*LINE,ARC")))
            i0
   )
   (while (setq ee (ssname ss i))
   (cond
      ((> (vlax-get-property(vlax-ename->vla-object ee) 'Length) MinL))
      (T (entdel ee))
   )
   (setq i (1+ i))
   )
)

随梦而飞 发表于 2012-7-25 20:41:50

Andyhon 发表于 2012-7-24 09:53 static/image/common/back.gif
Roughly...

楼主最好直接插件，代码我看不懂

Andyhon 发表于 2012-7-25 20:55:41

插件的原身不就是代码?
那么请描述您对插件的定义是

当然插件不一定是Lisp源码...

smartstar 发表于 2012-7-26 06:30:24

楼主肯定是新手中的新手。

shyshineboy 发表于 2012-10-31 10:26:55

用cad自带的qs命令选择后 e删除

流氓兔 发表于 2013-3-13 15:35:07

Andyhon 发表于 2012-7-24 09:53 static/image/common/back.gif
Roughly...

这个命令是什么呢，大哥可以发给我一个吗

Andyhon 发表于 2013-3-13 15:45:24

Ref:
http://bbs.mjtd.com/thread-79961-1-1.html
...会加载使用别人开发的程序...
页: [1] 2
查看完整版本: 谁有批量删除短小线的插件