TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: gskelly on October 25, 2010, 09:24:39 AM

Title: Attempt at purging anonymous blocks
Post by: gskelly on October 25, 2010, 09:24:39 AM
Hello,

I am trying to automate some drawing cleanup and have created functions to remove the unreferenced anonymous blocks. Initially I thought I would be able to iterate through the BLOCK table and get block info then use ssget to determine if there was an insert of the block but I can't see an entity name for the block definition there. Then I stumbled on a reference to a BLOCK_RECORD. Anyway, this seems to work for me but I am wondering it I am doing something unsafe or otherwise silly.  :?

I am not using vlisp because I want to be able to run on Intellicad also.

Any feedback would be appreciated...

Greg

Code: [Select]
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 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)))
        )
    )
)
Title: Re: Attempt at purging anonymous blocks
Post by: David Bethel on October 25, 2010, 10:20:08 AM
A couple of things come to mind:

At the command line ( a2k )
Code: [Select]
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.


Something like this maybe:
Code: [Select]
(foreach b bl
  (command "_.PURGE" "_Block" b "_No"))


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
Title: Re: Attempt at purging anonymous blocks
Post by: gskelly on October 25, 2010, 11:08:44 AM
Thanks for the info David. I seem to recall looking at that code 70 definition and I thought bits for 4, 8, 16, 32 & 64 were only for XREF's. I'll dig into it again tonight.

Is the purge command better than the entdel in some aspect? More thorough? Safer?

Using the DBMOD variable is new to me... nice.

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
Title: Re: Attempt at purging anonymous blocks
Post by: kpblc on October 25, 2010, 11:20:56 AM
Usually unnamed blocks has been purged automatically during save file.
Title: Re: Attempt at purging anonymous blocks
Post by: gskelly on October 25, 2010, 12:00:23 PM
I believe you are correct for Autocad. In fact, Bricscad did this also for a while but it does not any longer (since v10.1.11) and the Intellicad (6.6) we have does not.

I use a couple of applications that can create and abandon these by the hundreds in no time flat!

Usually unnamed blocks has been purged automatically during save file.
Title: Re: Attempt at purging anonymous blocks
Post by: David Bethel on October 25, 2010, 12:03:10 PM
Usually unnamed blocks has been purged automatically during save file.

I was going to say that none of the versions I use do this R12 / R13 / R14 / A2K / ICad 2001

-David
Title: Re: Attempt at purging anonymous blocks
Post by: David Bethel on October 25, 2010, 12:05:54 PM
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

Title: Re: Attempt at purging anonymous blocks
Post by: kpblc on October 25, 2010, 12:28:57 PM
I'm not sure this code would works correct on BricsCAD:
Code: [Select]
(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
Title: Re: Attempt at purging anonymous blocks
Post by: gskelly on October 25, 2010, 02:26:30 PM
Great, thanks for sharing your cents with me.

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


Title: Re: Attempt at purging anonymous blocks
Post by: cadpoobah on March 22, 2022, 07:24:48 PM
Old thread but still relevant code!

Modified this to also purge *D blocks (from erased dynamic blocks).

(or (wcmatch (strcase (vla-get-name blk_def)) "`**D*")
     (wcmatch (strcase (vla-get-name blk_def)) "`**U*"))

Code: [Select]
(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
Title: Re: Attempt at purging anonymous blocks
Post by: kpblc on March 23, 2022, 12:41:16 AM
I'm not sure this code would works correct on BricsCAD:
I wrote wrong code and noone correct me :)
Code - Auto/Visual Lisp: [Select]
  1.  
  2. (defun purge-unnamed-blocks (/ adoc)
  3.   (vlax-for blk_def (vla-get-blocks adoc)
  4.     (if (and (equal (vla-get-isxref blk_def) :vlax-false)
  5.              (equal (vla-get-islayout blk_def) :vlax-false)
  6.              (wcmatch (strcase (vla-get-name blk_def)) "`*U*")
  7.              ) ;_ end of and
  8.       (vl-catch-all-apply
  9.         (function
  10.           (lambda ()
  11.             (vla-delete blk_def)
  12.             ) ;_ end of lambda
  13.           ) ;_ end of function
  14.         ) ;_ end of vl-catch-all-apply
  15.       ) ;_ end of if
  16.     ) ;_ end of vlax-for
  17.   (vla-endundomark adoc)
  18.   (princ)
  19.   ) ;_ end of defun
Actually unnamed blocks (like *U, *D etc) erases automatically during saving dwg.
P.S. Code to purge all unnamed blocks:
Code - Auto/Visual Lisp: [Select]
  1.  
  2. (defun purge-unnamed-blocks (/ adoc)
  3.   (vlax-for blk_def (vla-get-blocks adoc)
  4.     (if (and (equal (vla-get-isxref blk_def) :vlax-false)
  5.              (equal (vla-get-islayout blk_def) :vlax-false)
  6.              (wcmatch (strcase (vla-get-name blk_def)) "`*@*")
  7.              ) ;_ end of and
  8.       (vl-catch-all-apply
  9.         (function
  10.           (lambda ()
  11.             (vla-delete blk_def)
  12.             ) ;_ end of lambda
  13.           ) ;_ end of function
  14.         ) ;_ end of vl-catch-all-apply
  15.       ) ;_ end of if
  16.     ) ;_ end of vlax-for
  17.   (vla-endundomark adoc)
  18.   (princ)
  19.   ) ;_ end of defun