Is there a way to update attribute after changing?

[dbrblg]

I have been working on some code which will update the an attribute in a border on my drawings and have the following code:

Private Sub UpdateBlockAttributes_2()

    Dim objEntity As AcadEntity
    Dim objBlockRef As AcadBlockReference
    Dim AttriList() 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("..[path to drawing]..")
    
    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, "Border", vbTextCompare) = 0)) Then
                If objBlockRef.HasAttributes Then
                    AttriList = objBlockRef.GetAttributes
                    For i = LBound(AttriList) To UBound(AttriList)
                        
                        Select Case AttriList(i).TagString
                            Case "SHEET"
                                Debug.Print "Sheet found"
                                AttriList(i).TextString = "sheet"
                        End Select
                        
                    Next
                End If
            End If
        End If
    Next
    
    Call aDBX.SaveAs(aDBX.Name)
    
End Sub

Now, the code works in that the sheet attribute is updated but what it doesn't do is sync the position of the text and I am left with this:

which means I have to use ATTSYNC (manually from the drawing) in order to get this:

which is what it should look like.

So, I need a way to automate this so that after updating the text, the position is reset / sync'd...

Is there a way to do this?  I had thought of calling ATTSYNC fromt SendCommand but this is not available in ObjectDBX.  Is there another way?

Thanks

[vince.krueger]

Have you tried

AcadApplication.ActiveDocument.SendCommand ("ATTSYNC" & vbCr)

I believe all commands (that do not require user interaction) work with this

[Ed__Jobe]

Before you change the TextString, you could store the att's insertion point. Then after you change the text, reset the insertion point. You might also want to change the justification to MiddleCenter.

[Ed__Jobe]

---

@vince.krueger wrote:

Have you tried

AcadApplication.ActiveDocument.SendCommand ("ATTSYNC" & vbCr)

I believe all commands (that do not require user interaction) work with this

---

If he is using ObjectDbx, then the axDbDocument is not going to be the ActiveDocument.

[dbrblg]

Hi @Ed__Jobe,

Looked in to your suggestion of the insertion point and changed the code to this:

Private Sub UpdateBlockAttributes_2()

    Dim objEntity As AcadEntity
    Dim objBlockRef As AcadBlockReference
    Dim AttriList() 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("..[path to drawing]..")
    
    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, "Border", vbTextCompare) = 0)) Then
                If objBlockRef.HasAttributes Then
                    AttriList = objBlockRef.GetAttributes
                    For i = LBound(AttriList) To UBound(AttriList)
                        
                        Select Case AttriList(i).TagString
                            Case "SHEET"
                                Dim ip(0 To 2) As Double
                                ip(0) = AttriList(i).InsertionPoint(0)
                                ip(1) = AttriList(i).InsertionPoint(1)
                                ip(2) = AttriList(i).InsertionPoint(2)
                                Debug.Print "Sheet found"
                                AttriList(i).TextString = "sheet"
                                AttriList(i).InsertionPoint = ip
                                AttriList(i).Update
                        End Select
                        
                    Next
                End If
            End If
        End If
    Next
    
    Call aDBX.SaveAs(aDBX.Name)
    
End Sub

The insertion point before and after setting the textstring appeared to be the same so had no effect.  For good measure I tried update function too but this had no effect either.

Hi@vince.krueger , I think Ed is right.  There doesn't appear to be an ActiveDocument on which to run commands.

[dbrblg]

I've been playing around with this for a bit now and it looks like it is another one of those things which isn't going to be fixed easily...

If anyone wants to take a look, I've included the working test files as attachments.

[vince.krueger]

hmm, I thought ActiveDocument was still available with DBX but I never tested it

[Ed__Jobe]

The ActiveDocument applies to AcadApplication.Documents collection. With ObjectDbx, it is a separate process without a user interface. You can only open one document at a time, so there is no Documents collection.

[vince.krueger]

I would change your template so that you do not need to move the items around, but if you need to...

I do not generally use DBX, I keep it simple with commands like ... 

c:wd_motattrval

c:wd_getattrval

c:ace_getattr_data

entity commands

So for an example, to move and center an attribute, I use this (fluff and error handling removed)

Public Function AutoCADe_Attribute_Move_CJ(sSelectionSet As String, sAttribute As String, rX As Double, rY As Double, rZ As Double) As Integer
    If (AutoCADe_Attribute_Change(sSelectionSet, sAttribute, 10, "(list " & rX & " " & rY & " " & rZ & ")") <> 0) Then Exit Function
    If (AutoCADe_Attribute_Change(sSelectionSet, sAttribute, 70, "8") <> 0) Then Exit Function
    If (AutoCADe_Attribute_Change(sSelectionSet, sAttribute, 72, "1") <> 0) Then Exit Function
    If (AutoCADe_Attribute_Change(sSelectionSet, sAttribute, 11, "(list " & rX & " " & rY & " " & rZ & ")") <> 0) Then Exit Function

End Function

Public Function AutoCADe_Attribute_Change(sSelectionSet As String, sAttribute As String, sProperty As String, sValue As String) As Integer
Dim sCMD01 As String
Dim sCMD02 As String
Dim sCMD03 As String
Dim sCMD04 As String

    sCMD01 = "(setq rtrn (c:ace_getattr_data " & sSelectionSet & " """ & sAttribute & """)) "
    sCMD02 = "(setq ed (entget (caddr rtrn))) "
    sCMD03 = "(entmod (subst (cons " & sProperty & " " & sValue & ") (assoc " & sProperty & " ed) ed)) "
    sCMD04 = "(entupd (caddr rtrn))"

    appAutoCADe.ActiveDocument.SendCommand ("(if " & sCMD01 & "(progn " & sCMD02 & sCMD03 & sCMD04 & "))" & vbCr)
End Function

[Ed__Jobe]

I mimiced the ATTSYNC command and used the AttributeDefinition properties to update the reference. See below. I also found that dBlocks was unused and commented it out.

Private Sub UpdateBlockAttributes_2()

    Dim objEntity As AcadEntity
    Dim objBlockRef As AcadBlockReference
    Dim oBlkDef As AcadBlock
    Dim AttDef As AcadAttribute
    Dim AttriList() As AcadAttributeReference
    'Dim dBlocks As New Dictionary
    Dim i As Integer
    Dim j 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\elj\downloads\template.dwg")
    
    For Each objEntity In aDBX.PaperSpace
        If (TypeOf objEntity Is AcadBlockReference) Then
            Set objBlockRef = objEntity
            If ((StrComp(objBlockRef.Name, "Border", vbTextCompare) = 0)) Then
                If objBlockRef.HasAttributes Then
                    AttriList = objBlockRef.GetAttributes
                    For i = LBound(AttriList) To UBound(AttriList)
                        Set oBlkDef = aDBX.Blocks(objBlockRef.Name)
                        For j = 0 To oBlkDef.Count - 1
                            Set objEntity = oBlkDef.Item(j)
                            If TypeOf objEntity Is AcadAttribute Then
                                Set AttDef = objEntity
                                'add logic to set to desired attdef or a collection
                            End If
                        Next j
                            
                        
                        Select Case AttriList(i).TagString
                            Case "SHEET"
                                Dim ip(0 To 2) As Double
                                ip(0) = AttriList(i).InsertionPoint(0)
                                ip(1) = AttriList(i).InsertionPoint(1)
                                ip(2) = AttriList(i).InsertionPoint(2)
                                Debug.Print "Sheet found"
                                AttriList(i).TextString = "sheet"
                                AttriList(i).InsertionPoint = AttDef.InsertionPoint
                                AttriList(i).Alignment = AttDef.Alignment
                                AttriList(i).Update
                        End Select
                        
                    Next i
                End If
            End If
        End If
    Next
    
    Call aDBX.SaveAs(aDBX.Name)
    
End Sub

 I also found that

[dbrblg]

Hello @Ed__Jobe 

I've got this working for this template but as soon as I add more attributes in there, it fails. 

I've taken your code and added line breaks / removed commented variables to try and make it a little easier for me to read:

Private Sub UpdateBlockAttributes_2_EJobe()

    Dim objEntity As AcadEntity
    Dim objBlockRef As AcadBlockReference
    Dim oBlkDef As AcadBlock
    Dim AttDef As AcadAttribute
    Dim AttriList() As AcadAttributeReference
    Dim i As Integer
    Dim j As Integer
        
        Dim p As Integer
        p = 0
        
    Dim aDBX As AxDbDocument
    
    Set aDBX = AcadApplication.GetInterfaceObject("ObjectDBX.AxDbDocument." & Left$(ThisDrawing.GetVariable("AcadVer"), 2))
    Call aDBX.Open("C:\t\Template2.dwg")
    
    For Each objEntity In aDBX.PaperSpace
        If (TypeOf objEntity Is AcadBlockReference) Then
        
            Set objBlockRef = objEntity
            If ((StrComp(objBlockRef.Name, "Border", vbTextCompare) = 0)) Then
            
                If (objBlockRef.HasAttributes) Then
                
                    AttriList = objBlockRef.GetAttributes
                    For i = LBound(AttriList) To UBound(AttriList)
                    
                        Set oBlkDef = aDBX.Blocks(objBlockRef.Name)
                        For j = 0 To oBlkDef.Count - 1
                        
                            Set objEntity = oBlkDef.Item(j)
                            If (TypeOf objEntity Is AcadAttribute) Then
                                Set AttDef = objEntity
                                'add logic to set to desired attdef or a collection
                            End If
                            
                        Next j
                            
                        Select Case AttriList(i).TagString
                            Case "SHEET"
                                Debug.Print "Sheet found"
                                AttriList(i).TextString = "sheet"
                                AttriList(i).InsertionPoint = AttDef.InsertionPoint
                                AttriList(i).Alignment = AttDef.Alignment
                                AttriList(i).Update
                        End Select

                    Next i
                End If
            End If
        End If
    Next
    
    Call aDBX.SaveAs(aDBX.Name)
    
End Sub

What happens after this is run is this.  The sheet attribute is updated, but the project attribute isn't.  It looks like the sheet attribute has disappeared too but it is actually under the project attribute!!

What I THINK is happening is that the project attribute insertion point and alignment is written to the sheet attribute.  If I set a breakpoint here:

AttriList(i).InsertionPoint = AttDef.InsertionPoint

and examine the AttDef variable, it looks to be pointing to the project attribute so all attribute insertion points and alignments are the same?????????????  I've attached Template2 so you can see what I mean.

Do you think this is the case?

[grobnik]

Hi, @dbrblg 

I tried to use the graphic version of your code (so without using DBX) and it's working perfectly.

Of course I found the same issue as you mentioned in yours previous posts, using DBX.

So seems that the issue it's tied with DBX, I don't know why due to I used few time DBX, seems shall be more efficient due to you do not have to manage the graphical process.. but I don't know.

However if you do not have an heavy drawing or if you do not have a lot of drawing to be updated attribute, I'm suggesting to use graphical version, he below the code if this can help you more.

Private Sub UpdateBlockAttributes_2_EJobe()

    Dim objEntity As AcadEntity
    Dim objBlockRef As AcadBlockReference
    Dim oBlkDef As AcadBlock
    Dim AttDef As AcadAttribute
    Dim AttriList() As AcadAttributeReference
    Dim i As Integer
    Dim j As Integer
        
        Dim p As Integer
        p = 0
        
   ' Dim aDBX As AxDbDocument
    
   ' Set aDBX = AcadApplication.GetInterfaceObject("ObjectDBX.AxDbDocument." & Left$(ThisDrawing.GetVariable("AcadVer"), 2))
   ' Call aDBX.Open("F:\Download\dwg_attr\Template2.dwg")
    
    For Each objEntity In ThisDrawing.PaperSpace 'aDBX.PaperSpace
        If (TypeOf objEntity Is AcadBlockReference) Then
        
            Set objBlockRef = objEntity
            If ((StrComp(objBlockRef.Name, "Border", vbTextCompare) = 0)) Then
            
                If (objBlockRef.HasAttributes) Then
                
                    AttriList = objBlockRef.GetAttributes
                    For i = LBound(AttriList) To UBound(AttriList)
                    
                        Set oBlkDef = ThisDrawing.Blocks(objBlockRef.Name) 'aDBX.Blocks(objBlockRef.Name)
                        For j = 0 To oBlkDef.Count - 1
                        
                            Set objEntity = oBlkDef.Item(j)
                            If (TypeOf objEntity Is AcadAttribute) Then
                                Set AttDef = objEntity
                                'add logic to set to desired attdef or a collection
                            End If
                            
                        Next j
                            
                        Select Case AttriList(i).TagString
                            Case "SHEET"
                                Debug.Print "Sheet found"
                                AttriList(i).TextString = "NEW sheet"
                                AttriList(i).InsertionPoint = AttDef.InsertionPoint
                                AttriList(i).Alignment = AttDef.Alignment
                                AttriList(i).Update
                        End Select

                    Next i
                End If
            End If
        End If
    Next
    
    'Call aDBX.SaveAs(aDBX.Name)
    
End Sub

[Ed__Jobe]

The problem is with the following snippet:

If (TypeOf objEntity Is AcadAttribute) Then
   Set AttDef = objEntity
   'add logic to set to desired attdef or a collection
End If

The above only selects one attribute, because you only had one attribute in your file. That's why I added the comment. You need to adapt it to your template.

[grobnik]

Hi @Ed__Jobe @dbrblg 

Thank you for your answer Ed, but there is a for next loop, see last code posted

For j = 0 To oBlkDef.Count - 1
    Set objEntity = oBlkDef.Item(j)
    If (TypeOf objEntity Is AcadAttribute) Then
        Set AttDef = objEntity 'add logic to set to desired attdef or a collection
    End If
Next j

So the AttDef should change.

Probably I'm no in deep to this issue.

Thank you

[Ed__Jobe]

---

@grobnik wrote:

Hi @Ed__Jobe @dbrblg 

Thank you for your answer Ed, but there is a for next loop, see last code posted

For j = 0 To oBlkDef.Count - 1
    Set objEntity = oBlkDef.Item(j)
    If (TypeOf objEntity Is AcadAttribute) Then
        Set AttDef = objEntity 'add logic to set to desired attdef or a collection
    End If
Next j

So the AttDef should change.

Probably I'm no in deep to this issue.

Thank you

---

Hi @grobnik  Although I replied to your post, I was really replying to @dbrblg .

Yes there is a For..Next loop, I wrote it. When I wrote it, it was only designed to solve the justification issue, not a whole template with many attributes. I assumed that this is not the final code, but would be used as part of another sub. However, by the time execution reaches the next loop to set the sheet, AttDef will still be set to the last attribute definition found.

[dbrblg]

Hello @grobnik and @Ed__Jobe ,

Thanks guys for your responses.  I spent the weekend doing a lot of research on blocks and how Attsync works in order to try and do a suitable replication of it in DBX or at the very least what/how to modify Ed's code...

I've come up with something which I think works but I need to do some further testing and see whether I can make it universal and not specific to just what I am doing.

Might be a few days away but will be back with what I end up with if it is any use to man or beast...