masterfal 发表于 2022-7-5 17:29:50

从块中删除擦除

我发现了这段代码,它定位块内的擦除并发送到后面。是否可以对其进行修改,以便删除它们而不是发送到后面?
 
(defun c:t1 ( / ss1 )(if (setq ss1 (ssget "X" '((0 .
"WIPEOUT"))))(command "_.draworder" ss1 "" "_Back")))

masterfal 发表于 2022-7-5 18:54:02

可以肯定的是,上面的代码昨天起作用了,但现在似乎不起作用
实际上,我认为下面的代码更好一些。来自李·麦克斯·德戈德·里斯普(谢谢李!)
它在块中定位擦除并发送到后面。如果它可以被修改删除,而不是发送到后面,那将是伟大的!
 
(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]
查看完整版本: 从块中删除擦除