Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

FIND LIST OF BLOCK NAMES THAT CAN BE PURGE

21 REPLIES 21
Reply
Message 1 of 22
amyyoyo1
1401 Views, 21 Replies

FIND LIST OF BLOCK NAMES THAT CAN BE PURGE

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)
  )
  )

 

21 REPLIES 21
Message 21 of 22
_gile
in reply to: amyyoyo1

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.



Gilles Chanteau
Programmation AutoCAD LISP/.NET
GileCAD
GitHub

Message 22 of 22
Kent1Cooper
in reply to: Kent1Cooper

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.

Kent Cooper, AIA

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report

”Boost