Checking if a Block can be Purged

Hi, this is my first post, having only just discovered this forum.

I use AutoCAD 2008 at work and AutoCAD 14 at home.

Can anyone tell me how to establish whether a block (in AutoCAD14) is available for purging using AutoLisp?

I use 'tblsearch' to check that the block exists in the drawing database, and I use 'ssget' to establish if the block is inserted directly into the drawing.

(if (and (tblsearch "BLOCK" bname)

(not (ssget "X" (cons '(0 . "INSERT") (list (cons 2 bname)))))

)

(command "PURGE" "B" bname)

)

Unfortunately the lisp routine error reporting fails if the block is inserted into the drawing as a nested (embedded) block because 'ssget' doesn't find it. The routine thinks the block can be purged, but in fact it can't be purged because it is nested.

Basically, I would like to know whether the block is inserted into the drawing either directly, or indirectly as a nested (embedded) block. Is there an entity code or similar that will tell me this so I don't issue a pointless purge command?

TIA,

--

Razoo

Hi Razoo,

Assuming you need compatibility with R14, this means that the use of Visual LISP is out.

So, using Vanilla AutoLISP,

You could cycle through the block definitions in the drawing using:

(defun GetObj  (bObj)
 (if (setq bObj (entnext bObj))
   (cons bObj (GetObj bObj))))

(GetObj (tblobjname "BLOCK" "Block_Name"))

And see if there are any references to the block in question within the other block definitions.

But, for all this trouble, surely the purge call just returns "No unreferenced blocks found." does it not?

Hope this helps,

Lee

Hi Lee,

Thanks for the quick response.

I had considered stepping through the blocks in the drawing but as you say, it is a lot of trouble.

The purge command does indeed return "No unreferenced blocks found", but I can't find a way of picking up this information to use within the lisp routine.

I can use tblsearch again to see whether the block is still there or not, and if it is, I can conclude it didn't purge :-)

I was hoping to issue an error message indicating why the block had failed to purge (e.g. because it is nested).

I guess if ssget doesn't find the block, and then it fails to purge, I can conclude it is inserted as a nested block. I was hoping there would be a simple entity code or similar that I could look for to indicate that a block is inserted as a nested block.

Razoo

I wrote part of this code a while back, and it should do what you require - although it does use Visual LISP, and so is not compatible with R14, but it will work on 2008.

Returns T if block can be purged:

[i][color=#990099];; Check Purge  --  by Lee McDonnell (Lee Mac) ~ 27.11.2009[/color][/i]

[i][color=#990099];; Returns T if Block can be Purged.[/color][/i]
[i][color=#990099];; Arguments:  bNme - Block Name [string][/color][/i]

[b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] CheckPurge [b][color=RED]([/color][/b]bNme[b][color=RED])[/color][/b]
 
 [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] BlkCount [b][color=RED]([/color][/b]Blk [b][color=BLUE]/[/color][/b] GetNest i j ss *blk[b][color=RED])[/color][/b]
 [i][color=#990099];; Block Counter by Lee McDonnell (Lee Mac) ~ 22.08.2009[/color][/i]
 [i][color=#990099];; Copyright © August 2009[/color][/i]
 [i][color=#990099];; Will Count all instances of a block, including nested.[/color][/i]
   
   [b][color=RED]([/color][/b][b][color=BLUE]vl-load-com[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] i [b][color=#009900]0[/color][/b] Blk [b][color=RED]([/color][/b][b][color=BLUE]strcase[/color][/b] Blk[b][color=RED])[/color][/b] j [b][color=#009900]-1[/color][/b]
         *blk [b][color=RED]([/color][/b][b][color=BLUE]vla-get-Blocks[/color][/b]
                [b][color=RED]([/color][/b][b][color=BLUE]vla-get-ActiveDocument[/color][/b]
                  [b][color=RED]([/color][/b][b][color=BLUE]vlax-get-acad-object[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

   [b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] GetNest [b][color=RED]([/color][/b]Obj Nme[b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]and[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]strcase[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-get-Name[/color][/b] Obj[b][color=RED])[/color][/b][b][color=RED])[/color][/b] Nme[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] i [b][color=RED]([/color][/b][b][color=BLUE]1+[/color][/b] i[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]vlax-for[/color][/b] Sub Obj
       [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [b][color=#ff00ff]"AcDbBlockReference"[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vla-get-ObjectName[/color][/b] Sub[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
         [b][color=RED]([/color][/b]GetNest [b][color=RED]([/color][/b][b][color=BLUE]vla-item[/color][/b] *blk [b][color=RED]([/color][/b][b][color=BLUE]vla-get-EffectiveName[/color][/b] Sub[b][color=RED])[/color][/b][b][color=RED])[/color][/b] Nme[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

   [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] ss [b][color=RED]([/color][/b][b][color=BLUE]ssget[/color][/b] [b][color=#ff00ff]"_X"[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=RED]([/color][/b][b][color=#009900]0[/color][/b] . [b][color=#ff00ff]"INSERT"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]while[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] ent [b][color=RED]([/color][/b][b][color=BLUE]ssname[/color][/b] ss [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] j [b][color=RED]([/color][/b][b][color=BLUE]1+[/color][/b] j[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
       [b][color=RED]([/color][/b]GetNest
         [b][color=RED]([/color][/b][b][color=BLUE]vla-item[/color][/b] *blk
           [b][color=RED]([/color][/b][b][color=BLUE]vla-get-EffectiveName[/color][/b]
             [b][color=RED]([/color][/b][b][color=BLUE]vlax-ename->vla-object[/color][/b] ent[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] Blk[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
   
   i[b][color=RED])[/color][/b]

 [b][color=RED]([/color][/b][b][color=BLUE]zerop[/color][/b] [b][color=RED]([/color][/b]BlkCount bNme[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]

 

I wrote part of this code a while back, and it should do what you require - although it does use Visual LISP, and so is not compatible with R14, but it will work on 2008.

 

Returns T if block can be purged:

Thanks Lee,

I'll try it on A2008 at work on Monday.

Razoo

You're welcome Razoo - but I will warn you that the code iterates through the whole block collection and furthermore recursively iterates through each object in each block - therefore its not a quick process for this kind of check.

I would be inclined to set NOMUTT to 1, and try the purge (hence no messages will appear), then check the block collection.

Lee

also, if checking is not necessary:

(if (tblsearch "BLOCK" bname)
   (vl-catch-all-apply
       '(lambda ()
            (command "PURGE" "B" bname)
        ) 
   ) 
)

Nice idea Wizman - but purge will not throw an error if it fails to purge, just a message.

You could also rewrite yours to:

(if (tblsearch "BLOCK" bname)
   (vl-catch-all-apply 'vl-cmdf (list "_.-purge" "_b" bname "_n")))

You can check the 64 bit of the group 70 flag BLOCK table definition. It should show if the block is referenced. -David

I got your point lee that purge only returns a message on error, I tried also vla-delete for purge or (member '(102 . "{BLKREFS") EntData) but not able to find link for nested blocks. I had a quick try on david's idea but maybe i did it wrong or is it only for xrefs david?.

You can check the 64 bit of the group 70 flag BLOCK table definition. It should show if the block is referenced. -David

I thought that only applied to XRefs, does it not?

Perhaps the easiest way to check:

(defun purge (bNme)  
 (and (tblsearch "BLOCK" bNme)
      (setvar "CMDECHO" 0)
      (vl-cmdf "_.-purge" "_b" bNme "_n")
      (setvar "CMDECHO" 1)
      (not (tblsearch "BLOCK" bNme))))

May be that will suffice lee, Could be purge may already have a built-in catch error that's why it's reporting only a message and it's not a pointless purge after all.

I thought that only applied to XRefs, does it not?

Look's like that's another 1 that has changed over the years. At one time it followed the standard group 70 flag codes. -David

From R13 Help File

70 Block-type bit-coded flags

1 = This is an anonymous block generated by hatching, associative dimensioning, other internal operations, or an application

2 = This block has attribute definitions

4 = This block is an external reference (xref)

8 = This block is an xref overlay

16 = This block is externally dependent

32 = This is a resolved external reference, or dependent of an external reference (ignored on input)

64 = This definition is referenced (ignored on input)

Copyright © 1995 Autodesk, Inc.

Here is one By JimmyB that I use:

;; Check to see if the block is used and purge it
;; Method Thanks to Jimmy Bergmark
(if 
(vl-catch-all-error-p
	(vl-catch-all-apply
		'vla-delete
		(list (vl-catch-all-apply
				'vla-item
				(list (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) X)
			)
		)
	)
)
nil 	; name cannot be purged or doesn't exist
)

Thanks Tim, Its working but for nested blocks its failing. A Child block cannot be purged eventhough the parent block has been purged already.

Hi, thanks for all the advice. It's not easy, is it?

I think I will revert to some basic logic using vanilla lisp to keep it compatible with AutoCAD14.

I'll use:

(if (and (tblsearch "BLOCK" bname)
     (not (ssget "X" (cons '(0 . "INSERT") (list (cons 2 bname)))))
 )

Which will check that the block exists and that it is not directly inserted into the drawing.

Then I'll check the assoc 70 codes to ensure the block is not an Xref, externally dependent, etc.

Then, if the block exists, is not directly inserted, and is not an Xref, etc., I'll issue the purge command.

(command "PURGE" "B" bname)

Then I'll use: (tblsearch "BLOCK" bname) again, and if the block is still there, I'll conclude that it is nested.

Does that sound reasonable?

Razoo

True it won't account for nested, but I think that may be your best bet.