How to delete all block attributes from a block using vba

[ilovejingle]

I think the question it self is pretty much descriptive.

What I want to do is loop through all the blocks, find all the block attributes for each block, and delete them permanently one by one.

I tried to write a piece of code, but it doesn't work, when I explode the block, I still got all the attributes coming out.

Sub ClearAtt()

    Dim objBlock As AcadBlockReference
    Dim objEntity As AcadEntity
    Dim objAttributes As AcadAttributeReference
    Dim AttList As Variant
    Dim I As Integer
    
    
    For Each objEntity In ThisDrawing.ModelSpace
        If objEntity.EntityName = "AcDbBlockReference" Then
            Set objBlock = objEntity
            If objBlock.HasAttributes Then
                AttList = objBlock.GetAttributes
                For I = LBound(AttList) To UBound(AttList)
                    Set objAttributes = AttList(I)
                    objAttributes.Erase
                    objBlock.Update
                Next
            End If
        
        End If
    Next
    
End Sub

[norman.yuan]

Actually, your question IS NOT as "pretty much descriptive" as you think once I saw the the question at first look: do you mean attributes in block definition (AcadAttribute) or attributes in block reference (AcadAttributeReference)?, or both?

If you mean attributes in AcadBlock, your code obviously does not delete them from a block definition. And even it did, it would not affect any block reference based on that block definition.

If you mean attributes in AcadBlockReference, then your code just does that correctly. However, you need to remember, it has no affect to the block definition (i.e., if you insert a new block, the attributes would be automatically created based on the block definition. Thus, you end up in drawing with block references from the same definition, but some have attributes, some do not - because your code deleted them).

It is misunderstanding that Explode a block reference would convert whatever see in the block reference back to individual entities. No, the exploding actually erase the block reference (because block reference is a single entity, just a reference to the block definition, and cannot be split into multiple entities), and grabs copies of all individual entities defined in block definition (including attribute definition) and drop them at the place where the block reference is. That is why you exploded the block reference with attribute being removed, and you still get attributes: these attributes are AcadAttribute, not AcadAttributeReference.

Now, if you actually want to change the block definition by removing all attribute (AcadAttribute, so that all block reference created after would not have attributes), and you also need to update existing block reference, then you need to delete AcadAttribute from block definition, and then you need to update all existing block references (as your code already does) or you can run command "attsync".

[ilovejingle]

Thank you for your explanation, really appreciate it, now I understand my problem more.

What I want to do is actually both. delete the attributes in block definition as well as in block reference. 

now I know how to delete the attributes in block reference, how to loop through all the block definition and delete all the attributes there?

Looking forward to your reply.

[ilovejingle]

Hi, after your post, I tried to find the way myself. here is the code that works.

Thank you for your help!

Option Explicit
Sub ClearAtt()

    Dim objBlockRef As AcadBlockReference
    Dim objBlock As AcadBlock
    Dim objEntity As AcadEntity
    Dim objAttributes As AcadAttributeReference
    Dim AttList As Variant
    Dim I As Integer
    
    'unlock all layers
    Dim objLayer As AcadLayer
    For Each objLayer In ThisDrawing.Layers
        objLayer.Lock = False
    Next


    'remove all attributes from block definition
    For Each objBlock In ThisDrawing.Blocks
        For Each objEntity In objBlock
            If objEntity.EntityName = "AcDbAttributeDefinition" Then
                objEntity.Delete
            End If
            
            'check nested block references in Block definition
            If objEntity.EntityName = "AcDbBlockReference" Then
                Set objBlockRef = objEntity
                On Error Resume Next
                clearBlockRef objEntity
            End If
        Next
    Next
    
    'remove all attributes from block references
    
    For Each objEntity In ThisDrawing.ModelSpace
        If objEntity.EntityName = "AcDbBlockReference" Then
            Set objBlockRef = objEntity
            clearBlockRef objBlockRef
        End If
        objBlockRef.Update
    Next
        
End Sub
    


Private Sub clearBlockRef(objBlockRef As AcadBlockReference)

    Dim objEntity As AcadEntity
    Dim I As Integer
    Dim AttList As Variant
    Dim nestedBlockRef As AcadBlockReference
    Dim objAttributes As Variant
    
    'remove all the block attributes in the block references
    If objBlockRef.HasAttributes Then
        AttList = objBlockRef.GetAttributes
        For I = LBound(AttList) To UBound(AttList)
            Set objAttributes = AttList(I)
            objAttributes.Erase
            objBlockRef.Update
        Next
    End If
End Sub