- 积分
 - 939
 
- 明经币
 -  个
 
- 注册时间
 - 2017-12-30
 
- 在线时间
 -  小时
 
- 威望
 -  
 
- 金钱
 -  个
 
- 贡献
 -  
 
- 激情
 -  
 
 
 
 
 
 
 | 
 
 
发表于 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共删除长度") 
(princ  va2) 
(princ "以下图元") 
(princ mm) 
(princ"个") 
  (command "UNDO" "E") 
  (princ) 
) 
 |   
 
 
 
 |