直线删除修改

love1030312

论坛里边找的程序  但是不能满足我的要求  求版主 大神们出手修改下  
  程序现在只能删除直线  我想让它支持CAD所有的线段    选择对象后不管什么线只要小于我输入的数值 就删除掉

2. (vl-load-com)
   
3. (defun C:dell (/ ee i minl ss)
   
4.   (setq MinL (getdist "\n直线长:"))
   
5.   (while (setq ss (ssget ":s" '((0 . "LINE")))
   
6.                i 0
   
7.          )
   
8.     (while (setq ee (ssname ss i))
   
9.       (cond
   
10.         ((> (vlax-get-property (vlax-ename->vla-object ee) 'Length) MinL))
    
11.         (T
    
12.           (entdel ee)
    
13.         )
    
14.       )
    
15.       (setq i (1+ i))
    
16.     )
    
17.   )
    
18.   (princ)
    
19. )

(vl-load-com)<br /> (defun C:dell (/ ee i minl ss)<br />   (setq MinL (getdist "\n直线长:"))<br />   (while (setq ss (ssget ":s" '((0 . "LINE")))<br />                i 0<br />          )<br />     (while (setq ee (ssname ss i))<br />       (cond<br />         ((> (vlax-get-property (vlax-ename->vla-object ee) 'Length) MinL))<br />         (T<br />           (entdel ee)<br />         )<br />       )<br />       (setq i (1+ i))<br />     )<br />   )<br />   (princ)<br /> )

kwok

看看

2. (vl-load-com)
   
3. (defun C:tt (/ ee i minl ss dd)
   
4.   (setq MinL (getdist "\n输入线长:"))
   
5.   (while (setq ss (ssget ":S")
   
6.                i 0
   
7.          )
   
8.     (while (setq ee (ssname ss i))
   
9.         (setq dd (vlax-curve-getDistAtParam ee (vlax-curve-getEndParam ee)))
   
10.       (if (< dd MinL)
    
11.           (entdel ee)
    
12.       )
    
13.       (setq i (1+ i))
    
14.     )
    
15.   )
    
16.   (princ)
    
17. )

(vl-load-com)<br /> (defun C:tt (/ ee i minl ss dd)<br />   (setq MinL (getdist "\n输入线长:"))<br />   (while (setq ss (ssget ":S")<br />                i 0<br />          )<br />     (while (setq ee (ssname ss i))<br />         (setq dd (vlax-curve-getDistAtParam ee (vlax-curve-getEndParam ee)))<br />       (if (< dd MinL)<br />           (entdel ee)<br />       )<br />       (setq i (1+ i))<br />     )<br />   )<br />   (princ)<br /> )

aihuyujian

(ssget ":s" '((0 . "LINE,LWPOLYLINE""))) 试试 其他对象能获取长度的应该都可以自行添加

love1030312

aihuyujian 发表于 2014-12-17 15:28
(ssget ":s" '((0 . "LINE,LWPOLYLINE""))) 试试 其他对象能获取长度的应该都可以自行添加

大哥 要删除圆弧的线 该怎么加

love1030312

kwok 发表于 2014-12-17 15:08
看看

谢谢  正是我需要的  哈哈  感谢大神出手

qnaq2004

学习到了。