Updating Block Attributes

[dbrblg]

I'm trying to update a block attribute but I cannot get this code to work:

Private Sub UpdateBlockAttributes()

    Dim objEntity As AcadEntity
    Dim objBlockRef As AcadBlockReference
    Dim AttriList() As AcadAttributeReference
    Dim objAttributes As AcadAttributeReference
    Dim dBlocks As New Dictionary
    Dim i As Integer
    
    dBlocks.CompareMode = TextCompare
    
    Dim aDBX As AxDbDocument
    Set aDBX = AcadApplication.GetInterfaceObject("ObjectDBX.AxDbDocument." & Left$(ThisDrawing.GetVariable("AcadVer"), 2))
    Call aDBX.Open("C:\Users\u\Desktop\Template.dwg")
    
    For Each objEntity In aDBX.PaperSpace
        If (TypeOf objEntity Is AcadBlockReference) Then
            Set objBlockRef = objEntity
            If ((Not dBlocks.Exists(objBlockRef.Name)) And (StrComp(objBlockRef.Name, "BorderBlk", vbTextCompare) = 0)) Then
                If objBlockRef.HasAttributes Then
                    AttriList = objBlockRef.GetAttributes
                    For i = LBound(AttriList) To UBound(AttriList)

                        Select Case AttriList(i).TagString
                            Case "Issue"
                                Debug.Print "Issue found"
                                AttriList(i).TextString = "issue"
                            Case "Sheet"
                                Debug.Print "Sheet found"
                                AttriList(i).TextString = "sheet"
                        End Select
                        
                    Next
                End If
            End If
        End If
    Next
    
End Sub

after I open the drawing again the attributes have not been updated.

I believe the attributes are being found in the blocks and I'm just setting them to an arbitary value for testing purposes but it doesn't look like they're either being set successfully or saved.

Does anyone know where this might be going wrong?

Thanks

[grobnik]

Hi @dbrblg I'm suggesting to use debug and break the function on a precise block name where you have previously settled known attributes, and then proceed step by step with function up to getting attributes values, using watching windows for AttriList array value TAGSTRING and TEXTSTRING.

Let us know

[dbrblg]

hello @grobnik I have done this and can see that before I set the attribute using

AttriList(2).TextString = "" 'issue
AttriList(9).TextString = "" 'sheet

and after these are correctly updated

AttriList(2).TextString = "issue" 'issue
AttriList(9).TextString = "sheet" 'sheet

 so it does appear to be a case of it not being saved as these values are still updated by the time I am getting to End Sub.

[grobnik]

Hi @dbrblg try to do a regen of drawing before ending procedure (or immediately after attributes change, in this case it's required more time in the procedure execution).

As alternative you can give us a sample drawing containing such blocks and we will check inside.

[dbrblg]

Hi @grobnik not sure whether adding

ThisDrawing.Regen acAllViewports

is relevant for a AxDbDocument???  and I cannot see another way to regen???

I've attached template drawing as requested.

[grobnik · Accepted solution]

@dbrblg Hi,

I solve your issue (I guess).

When you are checking the attribute textstring it's case sensitive, you are searching for "issue" (lower case), but the textstring it's UPPERCASE so "ISSUE".

So I tried to modify little bit the code with

Select Case AttriList(i).TagString
            Case "ISSUE"
            Debug.Print "ISSUE found"
            AttriList(i).TextString = "ISSUE"

 And seems to work.

In any case, it's not necessary to scan all attribute array, if the block attribute will be always int the same position.

I mean, if you ask to modify the block attributes in the drawing attribute will appear in the same sequence you got with AttriList() array. So ISSUE attribute will be the third position AttriList(2) (Array start form zero), and SHEET attribute will be at ten position AttriList(9) (Array start form zero).

Try with the above modification with UPPERCASE TEXT and let us know.

[dbrblg]

Hello @grobnik 

I still cannot get it to work...

Initially I tried uppercase as you suggested:

                    For i = LBound(AttriList) To UBound(AttriList)

                        Select Case AttriList(i).TagString
                            Case "ISSUE"
                                Debug.Print "Issue found"
                                AttriList(i).TextString = "issue"
                            Case "SHEET"
                                Debug.Print "Sheet found"
                                AttriList(i).TextString = "sheet"
                        End Select

                    Next

and it didn't work for me so I thought I'd change to using the array positions just in case I've missed something with the case:

For Each objEntity In aDBX.PaperSpace
        If (TypeOf objEntity Is AcadBlockReference) Then
            Set objBlockRef = objEntity
            If ((Not dBlocks.Exists(objBlockRef.Name)) And (StrComp(objBlockRef.Name, "BorderBlk", vbTextCompare) = 0)) Then
                If objBlockRef.HasAttributes Then
                    AttriList = objBlockRef.GetAttributes

                    AttriList(2).TextString = "sheet"
                    AttriList(9).TextString = "issue"
                    
                End If
            End If
        End If
    Next

but even this didn't work either.

The case even sounded the most plausible explanation yet 😁, I just cannot believe I cannot get it working!!

[grobnik]

Hi,

It's very strange, here on my machine it's working fine.

try to set a break point to 

 AttriList(2).TextString = "sheet"

and watch int the debug windows the   AttriList array.

Dubug step by step and check if really the code will be executed.

I don't know how to help you more.

[dbrblg]

The plot thickens...

I've stripped the code down to the bare-ish minimum and then tried two different approaches.

Firstly, like this using ThisDrawing:

Sub test5() 'this works ThisDrawing
    
    Dim objent As AcadEntity
    Dim objBRef As AcadBlockReference
    Dim varAttribs() As AcadAttributeReference
    Dim strAttribs As String
    Dim i As Integer
    
    For Each objent In ThisDrawing.PaperSpace
    
        If objent.ObjectName = "AcDbBlockReference" Then
        
            Set objBRef = objent
            
            If (objBRef.Name = "BorderBlk") Then
            
                varAttribs = objBRef.GetAttributes
                
                Debug.Print "Block Name: " & objBRef.Name & vbCrLf
                
                For i = LBound(varAttribs) To UBound(varAttribs)

                    Select Case varAttribs(i).TagString
                        Case "ISSUE"
                            Debug.Print "Issue found at index " & i
                            varAttribs(i).TextString = "issue"
                            ThisDrawing.Regen acAllViewports
                        Case "SHEET"
                            Debug.Print "Sheet found at index " & i
                            varAttribs(i).TextString = "sheet"
                            ThisDrawing.Regen acAllViewports
                    End Select
                    
                Next
        
            End If
        End If
    Next
    
End Sub

and this works.  The attributes are case sensitive and they update as expected but the second approach usingObjectDBX:

Sub test6() 'this does not work ObjectDBX
    
    Dim objent As AcadEntity
    Dim objBRef As AcadBlockReference
    Dim varAttribs() As AcadAttributeReference
    Dim strAttribs As String
    Dim i As Integer
    
    Dim aDBX As AxDbDocument
    Set aDBX = AcadApplication.GetInterfaceObject("ObjectDBX.AxDbDocument." & Left$(ThisDrawing.GetVariable("AcadVer"), 2))
    Call aDBX.Open("Z:\Template.dwg")
    
    For Each objent In aDBX.PaperSpace
    
        If objent.ObjectName = "AcDbBlockReference" Then
        
            Set objBRef = objent
            
            If (objBRef.Name = "BorderBlk") Then
            
                varAttribs = objBRef.GetAttributes
                
                Debug.Print "Block Name: " & objBRef.Name & vbCrLf
                
                For i = LBound(varAttribs) To UBound(varAttribs)

                    Select Case varAttribs(i).TagString
                        Case "ISSUE"
                            Debug.Print "Issue found at index " & i
                            varAttribs(i).TextString = "issue"
                            ThisDrawing.Regen acAllViewports
                        Case "SHEET"
                            Debug.Print "Sheet found at index " & i
                            varAttribs(i).TextString = "sheet"
                            ThisDrawing.Regen acAllViewports
                    End Select
                    
                Next
        
            End If
        End If
    Next
    
End Sub

does not work.

The code is exactly the same where the attributes are changed, the only difference is whether ThisDrawing or ObjectDBX is used.

So, I can see it is something to do with ObjectDBX!!

In answer to your previous post regarding stepping through, I tried this and the attributes to change

AttriList(2).TextString = "sheet"

to Sheet - I can see this occur in the debug window.  So it looks like the changes are made but not saved perhaps???

[norman.yuan · Accepted solution]

As @grobnik pointed out, when you match attribute's tag you may have Upper/Lower case issue, so you would be better do something like:

For i = LBound(AttriList) To UBound(AttriList)

    Select Case UCase(AttriList(i).TagString)
        Case "ISSUE"
          Debug.Print "Issue found"
          AttriList(i).TextString = "issue"
       Case "SHEET"
         Debug.Print "Sheet found"
         AttriList(i).TextString = "sheet"
    End Select
Next

even though you are lucky enough that the "case" is not the real issue you are having.

The real issue is that you open an AxDbDocument in AutoCAD's memory, not in AutoCAD's editor, and you make changes to it (updating block's attributes), and simply throw the AxDbDocument away (when the variable "aDBX" goes out of scope) without saving the changes. You need to call AxDbDocument.Save/SaveAs() after the updating is done.

[dbrblg]

Hello @grobnik  I think I have the answer.

If I add

aDBX.SaveAs aDBX.Name

to the end, it works.

Thanks very much for your persistence through this 😀

[dbrblg]

Hello @norman.yuan I've just stumbled upon this although I did have some trouble with ObjectDBX Save so opted for SaveAs instead.

Thanks very much for this 😀

[Ed__Jobe]

Sorry for coming in late, but its a known issue with ObjectDbx, that the Save method does not work. You have to use SaveAs and supply the current document file path. Also, remove the lines that regen, it does no good with odbx since there is no editor gui.

[lena.talkhina]

Hello @dbrblg  !

Great to see you here on Visual Basic Customization Forum.

Did you find a solution?
If yes, please click on the "Accept as Solution" button as then also other community users can easily find and benefit from the information.
If not please don't hesitate to give an update here in your topic so all members know what ́s the progression on your question is and what might be helpful to achieve what you ́re looking for. 🙂