;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Function: get_anon_blocks
;;; Description: Get a list of anonymous blocks. Anonymous is determined by
;;; value in assoc code 70. If bit for value 1 is set then the block is
;;; anonymous. The data returned is an assoc list: ((2 . "Name")(-1 . ename))
;;; where ename is the entity name for the block definition BLOCK_RECORD.
;;; ie:
;;; (
;;; ((2 . "*U566") (-1 . <Entity name: 046fb2e0>))
;;; ((2 . "*U565") (-1 . <Entity name: 046f8da0>))
;;; ((2 . "*U564") (-1 . <Entity name: 046f78e0>))
;;; )
;;;
;;; Last Modified: 2010-10-24
;;; History:
;;; 2010-10-24: GDS: initial version
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun get_anon_blocks ( / btrec bdata blist get_bdata)
;; Function to get block name and matching BLOCK_RECORD ename
; commandline test for BLOCK_RECORD:
; (entget (cdr (assoc 330 (entget (cdr (assoc -2 (tblnext "BLOCK" T)))))))
(defun get_bdata (x)
(list
(assoc 2 x)
(assoc -1
(entget
(cdr
(assoc 330
(entget
(cdr
(assoc -2 x))))))))
)
;; Get data for first block
(if (setq btrec (tblnext "BLOCK" t))
(setq bdata (get_bdata btrec))
)
(while btrec
(if (= (logand 1 (cdr (assoc 70 btrec))) 1)
(setq blist (cons bdata blist))
)
(if (setq btrec (tblnext "BLOCK"))
(setq bdata (get_bdata btrec))
)
)
blist
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Function: purge_blocks
;;; Description: Deletes blocks if there are no BLKREF entity names in as
;;; assoc 331 in the BLOCK_RECORD
;;;
;;; Input: block_list <== list containing BLOCK_RECORD entity names as
;;; (
;;; ...
;;; (... (-1 . ename) ... )
;;; ...
;;; )
;;; ie:
;;; (
;;; ((2 . "*U566") (-1 . <Entity name: 046fb2e0>))
;;; ((2 . "*U565") (-1 . <Entity name: 046f8da0>))
;;; ((2 . "*U564") (-1 . <Entity name: 046f78e0>))
;;; )
;;;
;;; Last Modified: 2010-10-25
;;; History:
;;; 2010-10-25: GDS: initial version
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun purge_blocks (block_list / b)
(foreach b block_list
;; if there are no BLKREF's then delete
(if (not (assoc 331 (entget (cdr (assoc -1 b)))))
(entdel (cdr (assoc -1 b)))
)
)
)
Command: _.purge
Enter type of unused objects to purge
[Blocks/Dimstyles/LAyers/LTypes/Plotstyles/SHapes/textSTyles/Mlinestyles/All]: _b
Enter name(s) to purge <*>: *U566
Verify each name to be purged? [Yes/No] <Y>: _n
Deleting block "*U566".
1 block deleted.
(foreach b bl
(command "_.PURGE" "_Block" b "_No"))
(defun c:pas ()
(command "_.ZOOM" "_C" "" "")
(while (> (getvar "DBMOD") 0)
(command "_.QSAVE"
"_.PURGE" "_All" "*" "_No"))
(command "_.AUDIT" "_Yes")
(command "_.QSAVE")
(prin1))
A couple of things come to mind:
- Anonymous block names are dynamic. Just because it is named "*U566" in this session, does not mean that will be it's name in the next session
- The 64 bit in the DXF code 70 flag in the BLOCK table definition is a flag for referenced BLOCKs
- I would collect the unreferenced BLOCK names in a list for a purge command
You may have to run this multiple times due to block nesting. I would issue a QSAVE between each inteneration in order to reset DBMOD to 0
For final and full purge I use this:Code: [Select](defun c:pas ()
(command "_.ZOOM" "_C" "" "")
(while (> (getvar "DBMOD") 0)
(command "_.QSAVE"
"_.PURGE" "_All" "*" "_No"))
(command "_.AUDIT" "_Yes")
(command "_.QSAVE")
(prin1))
-David
Usually unnamed blocks has been purged automatically during save file.
Usually unnamed blocks has been purged automatically during save file.
Is the purge command better than the entdel in some aspect? More thorough? Safer?
(vl-load-com)
(defun purge-unnamed-blocks (/ adoc)
(vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
(vlax-for blk_def (vla-get-blocks adoc)
(if (and (equal (vla-get-isxref blk_def) :vlax-false)
(equal (vla-get-islayout blk_def) :vlax-false)
(wcmatch (strcase (vla-get-name blk_def)) "`**U*")
) ;_ end of and
(vl-catch-all-apply
(function
(lambda ()
(vla-delete blk_def)
) ;_ end of lambda
) ;_ end of function
) ;_ end of vl-catch-all-apply
) ;_ end of if
) ;_ end of vlax-for
(vla-endundomark adoc)
(princ)
) ;_ end of defun
Is the purge command better than the entdel in some aspect? More thorough? Safer?
I would think it is more compatible across platforms and programs. My $0.02 -David
(vl-load-com)
(defun purge-unnamed-blocks (/ adoc)
(vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
(vlax-for blk_def (vla-get-blocks adoc)
(if (and (equal (vla-get-isxref blk_def) :vlax-false)
(equal (vla-get-islayout blk_def) :vlax-false)
(or (wcmatch (strcase (vla-get-name blk_def)) "`**D*")
(wcmatch (strcase (vla-get-name blk_def)) "`**U*"))
) ;_ end of and
(vl-catch-all-apply
(function
(lambda ()
(vla-delete blk_def)
) ;_ end of lambda
) ;_ end of function
) ;_ end of vl-catch-all-apply
) ;_ end of if
) ;_ end of vlax-for
(vla-endundomark adoc)
(princ)
) ;_ end of defun
I'm not sure this code would works correct on BricsCAD:I wrote wrong code and noone correct me :)