Remove attributes from blocks

Is it possible to remove all attributes from all blocks in a drawing leaving just the geometry of the block??
If so, how?!? I don't want to use REFEDIT, BATTMAN or ATTSYNC.

 

Have you tried cycling through the Blocks collection deleting the
attributes?

 

What exactly do you mean by deleting (just so we're on the same page)?
Are you talking about just erasing the text from the attribute or removing
the attribute definitions from the blocks?
I'd like to be able to REMOVE the attdefs from all blocks and end up with
blocks that contain only the geometry.

 

two steps
remove attdefs from blockdefs
for each block in blocks
for each obj in block
if typeof obj is attributedef then
obj.delete

then remove attrefs from blockrefs
foreach oent in thisdrawing.modelspace
if typeof oent is acadblockreference then
set oblkref = oent
if oblkref.hasattributes then
vatts = oblkref.getattributes
for i = 0 to ubound(vatts)
vatts(i).delete

something like that maybe?

 

I have an observation... you may want to iterate in reverse order or delete
vatts(0) each time... otherwise you may run into a "subscript out of range"
error. I haven't tested anything, just taking a guess looking at the
pseudo-code.

if oblkref.hasattributes then
vatts = oblkref.getattributes
for i = 0 to ubound(vatts) step -1 'changed
vatts(i).delete
'vatts(0).delete 'or use this method

James

 

Matt,
Wouldn't it be easier to just attdisp off?


Is it possible to remove all attributes from all blocks in a drawing leaving just the
geometry of the block??
If so, how?!? I don't want to use REFEDIT, BATTMAN or ATTSYNC.

 

Ah... I didn't dig deep enough. I didn't know about the DELETE.

And to show my gratitude, it's MY turn to contribute some code to the Group.
Enjoy! And be sure to watch for word wrap.

' =====Code Begins Here=====
Option Explicit


Public Sub RemoveAttDefs()
Dim i As Integer
Dim objEnt As AcadEntity
Dim objBlock As AcadBlockReference
Dim varAtts() As AcadAttributeReference
Dim Result

On Error Resume Next
For Each objEnt In ThisDrawing.ModelSpace
If TypeOf objEnt Is AcadBlockReference Then
Set objBlock = objEnt
If objEnt.HasAttributes Then
varAtts = objEnt.GetAttributes
For i = LBound(varAtts) To UBound(varAtts)
varAtts(i).Delete
Next i
End If
End If
Next

' Do a couple of purges to get rid of any extra information
ThisDrawing.PurgeAll
ThisDrawing.PurgeAll

Result = MsgBox("Attribute definitions have been removed!" & vbCr & "Would you like to save the drawing now?", vbInformation + vbYesNo, "Attribute Removal")
If Result = vbYes Then
ThisDrawing.Save
End If
End Sub
' =====Code Ends Here=====

Feel free to comment or use (at your own risk of course).




Matt W

There are 3 kinds of people:
Those who can count, and those who can't.

 

I have not tried this so it may not work. What happens if you just cycle
through the blocks deleting the attributes and then do a regen all?

 

Not when you want to send the file to the client or another engineer and you
don't want them to "steal" your secrets!

 

James,
Belated thank you for that astute observation.
That always stings me cause I always forget...thanks for the reminder.

Mark

 

Mark,
I wish my previous observation were astute, rather than just incorrect.
GetAttributes returns an array instead of a collection, so it doesn't
re-index when you delete one of them. But I too have been stung before by
re-indexing issues, which is why I I thought of it.
James

 

ok, I take it back!