从块中删除擦除
我发现了这段代码,它定位块内的擦除并发送到后面。是否可以对其进行修改,以便删除它们而不是发送到后面?(defun c:t1 ( / ss1 )(if (setq ss1 (ssget "X" '((0 .
"WIPEOUT"))))(command "_.draworder" ss1 "" "_Back"))) 可以肯定的是,上面的代码昨天起作用了,但现在似乎不起作用
实际上,我认为下面的代码更好一些。来自李·麦克斯·德戈德·里斯普(谢谢李!)
它在块中定位擦除并发送到后面。如果它可以被修改删除,而不是发送到后面,那将是伟大的!
(defun c:BlockWipeouts2Bottom (/ blk item lst Sortents count)
(setq count 0)
(vlax-for blk (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object)))
(if (and (= (vla-get-IsLayout blk) :vlax-false)
(= (vla-get-IsXRef blk) :vlax-false)
(not (wcmatch (strcase (vla-get-Name blk)) "`**"))
)
(vlax-for item blk
(if (eq (vla-get-ObjectName item) "AcDbWipeout")
(setq lst (cons item lst) count (1+ count))
)
)
)
(if (and lst
(setq Sortents
(LM:SortentsTable
(vla-ObjectIDtoObject
(vla-get-ActiveDocument
(vlax-get-acad-object)
)
(vla-get-OwnerID (car lst))
)
)
)
)
(vla-MovetoBottom Sortents (LM:ObjectVariant lst))
)
(setq lst nil)
)
(vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object)) acAllViewports)
(princ "\n")
(princ count)
(princ " wipeouts moved to bottom inside blocks.")
(princ)
)
页:
[1]