Hi, I am tring to wirte an lisp routin that will purge all purgeable blocks except for two other blocks. The routin I have now will search all blocks in the drawing but cann't seem to found any purgeable blocks can somebody help?
please and thanks!
here is the code :
(defun purgeBlock()
(setq ss (ssget "x" (list (cons 0 "INSERT"))))
(SETQ con1 0)
(repeat (sslength ss)
(SETQ ss2 (ssname ss con1))
(setq ss1 (entget ss2))
(setq ss3 (cdr (assoc 8 ss1)))
(if (AND (/= ss3 "Operator_Logos_WS") (/= ss3 "Operator_Logos_PL"))
(command "-purge" "block" ss3 "n")
)
(setq con1 (+ con1 1))
(XRED)
(princ)
)
)
Hi,
May be this way is safer.
Load:
(defun gc:IsReferenced (bname / blk) (and (setq blk (tblobjname "BLOCK" bname)) (setq blkRec (cdr (assoc 330 (entget blk)))) (setq blkRefs (vl-remove nil (mapcar 'entget (gc:massoc 331 (entget blkRec))))) (vl-some 'vl-consp (mapcar '(lambda (x) (entget (cdr (assoc 330 x)))) blkRefs)) ) ) (defun gc:DeleteBlock (bname / blk) (vl-load-com) (vl-catch-all-apply (function (lambda () (setq blk (vla-item (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object) ) ) bname ) ) ) ) ) (if blk (progn (vlax-for o blk (if (= (vla-get-ObjectName o) "AcDbBlockReference") (vla-Delete o) ) ) (vla-delete blk) ) ) ) (defun PurgeAllBlocksExcept (pat / blk name blst loop) (while (setq blk (tblnext "BLOCK" (not blk))) (if (and (not (wcmatch (strcase (setq name (cdr (assoc 2 blk)))) (strcase pat))) (< (cdr (assoc 70 blk)) 4) ) (setq blst (cons name blst)) ) ) (setq loop T) (while (and loop blst) (setq loop nil) (foreach n blst (or (gc:IsReferenced n) (progn (gc:DeleteBlock n) (setq blst (vl-remove n blst)) (setq loop T) ) ) ) ) ) (defun gc:massoc (code alst) (if (setq alst (member (assoc code alst) alst)) (cons (cdar alst) (gc:massoc code (cdr alst))) ) )
and run:
(gc:PurgeAllBlocksExcept "Operator_Logos_WS,Operator_Logos_PL")
If it still does not work it's not necessary to try changing theargument of an expression with each variable (whatever its type). This will never be a way to debug a code.
My Insert-the-Special-Blocks-to-prevent-Purging-and-just-Purge-all-Blocks approach [so much shorter] can also be done as a function with an argument with a list of the special Block names, rather than as a command with a fixed set of names:
(defun PABE (blklist / entl cmde) ; = Purge All Blocks Except
(setq
entl (entlast); starting point for later in removing temporary Blocks
cmde (getvar 'cmdecho)
); setq
(setvar 'cmdecho 0)
(foreach blk blklist
(if (or (tblsearch "block" blk) (findfile (strcat blk ".dwg")))
; already in drawing or available in Support File Search Paths?
(progn
(command "_.insert" blk (getvar 'viewctr)); temporarily
(while (> (getvar 'cmdactive) 0) (command ""))
); progn
); if
); foreach
(repeat 3 (command "_.purge" "_block" "*" "_no")); or more than 3 if you prefer
(while (setq entl (entnext entl)) (entdel entl)); remove temporary ones
(setvar 'cmdecho cmde)
(princ)
); defun
Usage: (PABE '("SpecialBlock1" "SpecialBlock2" "SpecialBlock37"))
with as many Block names in the list as you like.
Can't find what you're looking for? Ask the community or share your knowledge.