Stripping block attributes

[Tyke]

I have a VBA routine which strips all of the attributes from all of the blocks in a drawing, see following code:

    Dim oEnt As AcadEntity
    Dim i As Integer
    
    ' get all blocks in drawing
    Set colBlocks = ThisDrawing.Blocks
    
    ' iterate each block and remove all of the attribute definitions
    For Each objBlock In colBlocks
        For Each oEnt In objBlock
            If oEnt.ObjectName = "AcDbAttributeDefinition" Then
                oEnt.Delete
            End If
        Next oEnt

        ThisDrawing.SendCommand "_ATTSYNC" & vbCr & "NAME" & vbCr & objBlock.Name & vbCr

    Next objBlock
    
    ' iterate each block reference and remove its attribute references
    For Each oEnt In ThisDrawing.ModelSpace
        If TypeOf oEnt Is AcadBlockReference Then
            Set objBlockRef = oEnt
            If objBlockRef.HasAttributes Then
                varAttribs = objBlockRef.GetAttributes
                For i = LBound(varAttribs) To UBound(varAttribs)
                    varAttribs(i).Delete
                Next i
            End If
        End If
        
    Next oEnt
    
    ThisDrawing.Regen acAllViewports
    ThisDrawing.PurgeAll

This part works fine, but when I run a further routine in which I select a single block on screen, I test to see if the block has any attributes and depending on the result I display the appropriate form. At this point none of the blocks have any attribute references or definitions and I have confirmed this by checking the properties panel after selecting a block and by using the block editor. I have used the following code to check for any attributes:

        ' check if block already has some attributes
        ' and then show the appropriate form
        If objBlockRef.HasAttributes = True Then
            frmAppend.Show
            Me.Hide
        Else
            frmAddAtts.Show
            frmAddAtts.cbxFirstAttName.SetFocus
            Me.Hide
        End If

After executing the line in red it always evaluates to True even though there are no attributes.

Even if I quit the macro, do something else and then restart the macro, it still always evaluates to True.

What am I doing wrong?

If I save the drawing nothing changes, but if I close and reopen the drawing the test for arributes evaluates as False, as it should.

[dbroada]

I can't answer this (even if I wasn't at home) but could this have something to do with ATTSYNC? You can manually delete all the attributes in a block but its not until you ATTSYNC the block that the attributes disappear from the existing blocks. As I say, no idea but may be worth exploring until somebody more clued up than me arrives.

----------------------------------

and of course I have now looked a bit closer and see you already ATTSYNC. Maybe you do it at the wrong time

[Tyke]

I can't answer this (even if I wasn't at home) but could this have something to do with ATTSYNC? You can manually delete all the attributes in a block but its not until you ATTSYNC the block that the attributes disappear from the existing blocks. As I say, no idea but may be worth exploring until somebody more clued up than me arrives.

Thanks Dave, I already tried that, programatically and directly in AutoCAD, but it didn't achieve anything

[btraemoore]

are you trying strip the attributes and then repopulate them with a user form? Im a little confused as to the goal your trying to achieve.

[btraemoore]

try this and see if you can get it to do what you want.

i like to use selection sets, so attached to the bottom is a sub that deletes all selection sets before running the code. (good for debugging)

When I was debugging I did notice that it kept verifying that it DID have attributes, but when you request anything from the attribute it canceled out because there were none. my guess is that because of the type of block it is programmed to say " hey guy, I have attributes" when in all actuality it doesn't because we just deleted them all. I don't know how to fix that problem but by adding 5 lines of code, the problem can be dealt with. Good food for thought on the main problem though, we can learn something from it.

Sub NameOfYourChoice()

    SS_delete 1
    
    Dim gpCode(0) As Integer
    Dim dataValue(0) As Variant
    Dim SS_Example As AcadSelectionSet
    Dim i As Integer
   
    Set SS_Example = ThisDrawing.SelectionSets.Add("SS_Example")
        gpCode(0) = 0: dataValue(0) = "INSERT"
       
    SS_Example.Select acSelectionSetAll, , , gpCode, dataValue
   
    Dim Cur_Blk As AcadEntity
    Dim Blk_Atts() As AcadAttributeReference
    Dim Cur_Att As AcadAttributeReference
    Dim n As Integer

    For i = 0 To SS_Example.Count - 1
        Set Cur_Blk = SS_Example.Item(i)
        Blk_Atts = Cur_Blk.GetAttributes

        For n = 0 To UBound(Blk_Atts)
            Set Cur_Att = Blk_Atts(n)
            
            Cur_Att.Delete
        Next n
    Next i
    
    Dim Att As Variant
    Application.Update
    For Each Item In SS_Example
        If Item.HasAttributes Then
            Blk_Atts = Item.GetAttributes
            For Each Att In Blk_Atts
                If Att.TagString <> Empty Then
                    frmAppend.Show
                    frmAddAtts.Hide
                Else
                    frmAddAtts.Show
                    frmAddAtts.cbxFirstAttName.SetFocus
                    frmAddAtts.Hide
               End If
            Next
        End If
    Next
    Application.Update

End Sub
'-----------------------------------------------------------------

Sub SS_delete(x As Byte)
    If ThisDrawing.SelectionSets.Count > 0 Then
    Dim i As Integer
        On Error Resume Next
        For i = 0 To ThisDrawing.SelectionSets.Count - 1
            ThisDrawing.SelectionSets.Item(i).Delete
        Next i
        On Error GoTo 0
    End If
End Sub

[Tyke]

I'm wanting to completely strip the attributes and not repopulate them, and that I can do. When the attributes have been stripped there is an option to add new attribute(s) to a block, but the block is recognised as still having attributes, even though there aren't any there. This is just part of a larger program where amongst other things attributes can be added to blocks without any attributes and appended to blocks that already have attributes. One of the options in this program is to strip all of the attributes from all of the blocks and it was during testing that I found this problem.

[btraemoore]

okay cool, so you got the problem worked out?

i realized what you were doing when i was debugging, the code i posted should fix it.

[Tyke]

Sorry I didn't get back sooner but I was out of the office all day yesterday.

Thanks for the code Trae, but unfortunately it didn't fix the problem.

When debugging I saw that when a block doesn't have any attributes and when .HasAttributes is queried and it says the block does have some attributes, that the upper bound for the attributes returned is -1. I used this value (< 0 really) when looping the attributes and managed with a little bit of tweaking to get the correct form to show. I used my code to strip the attributes and then the following code for showing the appropriate form:

        ' check if block already has some attributes
        ' and then show the appropriate form
        
        Dim Blk_Atts() As AcadAttributeReference
        Dim Att           As Variant
        Dim Item         As Variant
               
        If objBlockRef.HasAttributes = True Then
            Blk_Atts = objBlockRef.GetAttributes
            Item = UBound(Blk_Atts)
            
            'If Att.TagString <> Empty Then
            If Item < 0 Then
                 frmAddAtts.Show
                 frmAddAtts.cbxFirstAttName.SetFocus
                 Me.Hide
            Else
                 frmAppend.Show
                 Me.Hide
            End If
               
        Else
            frmAddAtts.Show
            frmAddAtts.cbxFirstAttName.SetFocus
            Me.Hide
        End If

I realize its just a work around and doesn't really solve the problem but I would still like to be able to strip the attributes and get a correct response from the .HasAttributes query.

Thanks for your time and effort, it is appreciated. If I get to solve the problem I'll get back to you on it.