批量删除小于一定长度的多段线和直线问题瓶颈
在此我写了个删除图形内小于一定长度的小程序，可不知哪里出的问题，我的界定方式明明是小于等于，而等于却不发挥作用。且LINE和LWPOLYLINE删除的情况也有差异，第一次运行删除成功，若将夹点移动拉长多段线（直线），再UNDO回来，程序却无法删除满足条件的线了。还请版主赐教啊。(defun c:minl(/ ltdl ss lst)
(setq dim (getvar 'dimzin))
(setvar 'dimzin 0)
(princ "\n 删除小于、等于一定长度的直线或者多段线")
(initget 4)
(setq ltdl (getreal "\n 请输入可容许的最小线段长度==>> "))
(setq ss (ssget '((0 . "LWPOLYLINE,LINE"))))
(setq lst (ss->lst ss))
(setq lst (mapcar 'vlax-ename->vla-object lst))
(deleteminlength lst ltdl)
)
;;删除小于容许vla实体值函数
(defun deleteminlength ( lst ltdl / )
(vl-remove-if 'not (mapcar
'(lambda (x)
(if (<= (vla-get-length x) ltdl)
;;; x
(vla-delete x)
)
)
lst
)
)
(setvar 'dimzin dim)
)
(defun ss->lst (SS / I EN LST_EN)
(setq LST_EN '()
I 0
)
(repeat (sslength SS)
(setq EN (ssname SS I)
LST_EN (cons EN LST_EN)
I (1+ I)
)
)
;;返回
(reverse LST_EN)
)
我怎么测试了下，是正常的 autocad 2011 测试---程序正常! 我也试了下，没什么问题啊，正常使用 500w008 发表于 2020-7-6 21:29
(defun c:xx ();repeat函数
(setq bs (ssget '((0 . "line")(8 . "beam"))))
(setq si -1)
(defun c:xx ();repeat函数
(setq bs (ssget '((0 . "line"))))
(setq si -1)
(setq ss_n (sslength bs))
(repeat ss_n
(progn
(setq s_ent (ssname bs (setq si (1+ si))))
(setq ss_att (entget s_ent))
(setq ss_s (cdr (assoc 10 ss_att)) ss_e (cdr (assoc 11 ss_att)))
(setq dd (distance ss_s ss_e))
(IF (< dd 1000) (command "erase" s_ent ""))
)
);repeat
(princ)
)
页:
[1]