Vba & Attsync

I am currently writing a VBA routine to update our drawing blanks to incorporate the latest corporate identity. I have managed to get the basic border to update but I am left with needing to move the ATTRIBUTEs. When doing this individually I use the ATTSYNC command but this isn't an available VBA call. Is there a way to call it?

In LISP I would use the (command "ATTSYNC"... format but I have never had to do this in VBA.

answer found!

 
ThisDrawing.SendCommand "ATTSYNC" & vbCr & "n" & vbCr & "ics-rockwell-a1-a" & vbCr

had I not asked I'm sure I wouldn't have found it though.

Try using Attribute Object, with his methods and properties.

E.G.:

attribute.move point1, point2

where attribute is the attribute you want to move, move (obviously) y the metod move, point1 and point2 are points from where you want to move the attribute to...

Sorry by my english

thank you but in this case ATTSYNC is more appropriate.

I have a block with attributes defined in the current drawing. I also have a newer drawing block with the same named attributes but they are in a different position. I don't (need to) know the new position of the attributes as they are defined in the new block. The ATTSYNC command moves all the attributes to their new location without extra code.

Do you have to do activate something before you enter this line of code?

I have updated the strings of a existing BlockReference.

But after the text is changed, it has jumped a few inches. When I perform a ATTSYNC in Autocad, the text jumps back to the right position.

But when I add your line with my block Name at the end of my script. I doesn't put the text back to it's original location. 

So which is it terminology is important. Which did you use.

SCRIPT a sequence of auto cad commands same as typed on command line

LISP a programming language

VBA or as started Visual Basic a programming language

Sorry for the late respondse.

I'm using it in VBA.

This is the complete code:

I highlighted the line where I use the ATTSYNC in green. (for some reason it doesn't do anything)

Yellow is just comment (in dutch)

Sorry if the code is not what you are used to see (I"m not realy a programmer ;-))

Sub UpdateRevisionDates()
    Dim CurrentRevision As String
    Dim CurrentAttribuut As String
    Dim NewDate As String
    Dim RevisionEditor As String
    Dim EditorDepartment As String
    
    Dim varAttributes As Variant
    Dim i As Integer
    Dim Updated As Integer
    Dim objEntity As Object
    
    Dim MovePoint1(0 To 2) As Double
    Dim MovePoint2(0 To 2) As Double
    MovePoint1(0) = 0#: MovePoint1(1) = 0#: MovePoint1(2) = 0#
    MovePoint2(0) = 20: MovePoint2(1) = 0: MovePoint2(2) = 0
            
    'Op te geven gevens:
    NewDate = "09-01-24"    'Nieuwe revisiedatum
    RevisionEditor = "TJNN"  'Naam van degene die de revisie heeft gemaakt
    EditorDepartment = "Klas"    'Afdeling
    MyPath_List = "C:\Users\Thijs\Desktop\Test VBA autocad verbeterde versie\Revisie aanpassen\" 'Locatie tekeningenlijst
    MyPath_Drawings = "C:\Users\Thijs\Desktop\Test VBA autocad verbeterde versie\Revisie aanpassen\" 'Locatie tekeningen
    
Open (MyPath_List & "Drawing list.txt") For Input As #1
Do While Not (EOF(1))
    Input #1, MyFileName
    
    Set MyaDBX = AcadApplication.GetInterfaceObject("ObjectDBX.AxDbDocument." & Left$(ThisDrawing.GetVariable("ACADVER"), 2))
    Call MyaDBX.Open(MyPath_Drawings & MyFileName)
    
    
     For Each objEntity In MyaDBX.ModelSpace
     
     'Check if the object is a BlockReference and if so, is it called REVIHEAD?
        If TypeOf objEntity Is AcadBlockReference Then
            If objEntity.Name = "REVIHEAD" Then
        
                Updated = 0
                varAttributes = objEntity.GetAttributes
        
                For i = LBound(varAttributes) To (UBound(varAttributes) - 1)
    
                    'Check if the attribuut is called "REV". If so, the drawing contains a revisionhead with only one revision line.
                    If varAttributes(i).TagString = "REV" Then
                        varAttributes(i).TextString = GetNextRevision(varAttributes(i).TextString)
                        varAttributes(i + 1).TextString = NewDate
                        varAttributes(i + 2).TextString = RevisionEditor
                        varAttributes(i + 3).TextString = EditorDepartment
                        Updated = 1
                        Exit For
                    End If
        
    'Als het revisieblok uit meerdere revisies bestaat, is deze alsvolgt opgebouwd:
    'varAttributes(0)= RA
    'varAttributes(1)= DATE_A
    'varAttributes(2)= BY_A
    'varAttributes(3)= DEPT_A
    'varAttributes(4)= RB
    'varAttributes(5)= DATE_B
    'varAttributes(6)= BY_B
    'varAttributes(7)= DEPT_B
    'varAttributes(8)= RC
    'varAttributes(9)= DATE_C
    'varAttributes(10)= BY_C
    'varAttributes(11)= DEPT_C

'Als het veld "REV" niet bestaat, betekent dit dat het een revisieblok is met meerdere revisievelden
'Dus nu eerst uitzoeken of er een datumveld leeg is en zoja, dan die regel invullen.
    
                    If varAttributes(i).TagString = "RA" And varAttributes(i + 1).TextString = "" Then
                        varAttributes(i + 1).TextString = NewDate
                        varAttributes(i + 2).TextString = RevisionEditor
                        varAttributes(i + 3).TextString = EditorDepartment
                        Exit For
                    End If
            
                    If varAttributes(i).TagString = "RB" And varAttributes(i + 1).TextString = "" Then
                        varAttributes(i + 1).TextString = NewDate
                        varAttributes(i + 2).TextString = RevisionEditor
                        varAttributes(i + 3).TextString = EditorDepartment
                        Updated = 1
                        Exit For
                    End If
            
                    If varAttributes(i).TagString = "RC" And varAttributes(i + 1).TextString = "" Then
                        varAttributes(i + 1).TextString = NewDate
                        varAttributes(i + 2).TextString = RevisionEditor
                        varAttributes(i + 3).TextString = EditorDepartment
                        Updated = 1
                        Exit For
                    End If
                Next i
        'Als er geen lege revisieregel is moet worden uitgezocht welke regel de laagste revisie is.
        'Deze regel wordt dan overschreven met de nieuwe revisie.
        'De nieuwe revisieletter is de volgende letter in het alfabet, NA de huidige revisie letter.
                If Updated = 0 Then
                    If Asc(varAttributes(0).TextString) < (Asc(varAttributes(4).TextString) And Asc(varAttributes(8).TextString)) Then
                        If Asc(varAttributes(4).TextString) > Asc(varAttributes(8).TextString) Then
                            varAttributes(0).TextString = Chr(Asc(varAttributes(4).TextString) + 1)
                            varAttributes(1).TextString = NewDate
                            varAttributes(2).TextString = RevisionEditor
                            varAttributes(3).TextString = EditorDepartment
                            Updated = 1
                            Exit For
                        End If
                        varAttributes(0).TextString = Chr(Asc(varAttributes(8).TextString) + 1)
                        varAttributes(1).TextString = NewDate
                        varAttributes(2).TextString = RevisionEditor
                        varAttributes(3).TextString = EditorDepartment
                        Updated = 1
                        Exit For
                    End If
                
        
                    If Asc(varAttributes(4).TextString) < (Asc(varAttributes(0).TextString) And Asc(varAttributes(8).TextString)) Then
                        If Asc(varAttributes(0).TextString) > Asc(varAttributes(8).TextString) Then
                            varAttributes(4).TextString = Chr(Asc(varAttributes(0).TextString) + 1)
                            varAttributes(5).TextString = NewDate
                            varAttributes(6).TextString = RevisionEditor
                            varAttributes(7).TextString = EditorDepartment
                            Updated = 1
                            Exit For
                        End If
                        varAttributes(4).TextString = Chr(Asc(varAttributes(8).TextString) + 1)
                        varAttributes(5).TextString = NewDate
                        varAttributes(6).TextString = RevisionEditor
                        varAttributes(7).TextString = EditorDepartment
                        Updated = 1
                        Exit For
                     End If
                 
                    If Asc(varAttributes(8).TextString) < (Asc(varAttributes(0).TextString) And Asc(varAttributes(4).TextString)) Then
                        If Asc(varAttributes(0).TextString) > Asc(varAttributes(4).TextString) Then
                            varAttributes(8).TextString = Chr(Asc(varAttributes(0).TextString) + 1)
                            varAttributes(9).TextString = NewDate
                            varAttributes(10).TextString = RevisionEditor
                            varAttributes(11).TextString = EditorDepartment
                            Updated = 1
                            Exit For
                        End If
                        varAttributes(8).TextString = Chr(Asc(varAttributes(4).TextString) + 1)
                        varAttributes(9).TextString = NewDate
                        varAttributes(10).TextString = RevisionEditor
                        varAttributes(11).TextString = EditorDepartment
                        Updated = 1
                        Exit For
                    End If
                End If
            End If
        End If
        If Updated = 1 Then Exit For
    Next
   
ThisDrawing.SendCommand "ATTSYNC" & vbCr & "n" & vbCr & "REVIHEAD" & vbCr

MyNewFileName = Left(MyFileName, Len(MyFileName) - 4)
MyaDBX.SaveAs (MyPath_Drawings & MyNewFileName & "_R.dwg")
Loop
Close #1

End Sub

Function GetNextRevision(CurrentRevision As String) As String

    ' Add your code to get the next revision letter

If Not (CurrentRevision = "") Or (currentRevisoin = "-") Then

GetNextRevision = Chr(Asc(CurrentRevision) + 1)
Else

GetNextRevision = "A"

End If
End Function

I changed the code a little bit.

Now the drawings are actually being opened and edited.

Now the ATTsync does work.

Here's the new code: 

Sub UpdateRevisionDates()
    Dim CurrentRevision As String
    Dim CurrentAttribuut As String
    Dim NewDate As String
    Dim RevisionEditor As String
    Dim EditorDepartment As String
    Dim MyPath_Drawings As String
    
    Dim acadApp As Object
    Dim varAttributes As Variant
    Dim i As Integer
    Dim Updated As Integer
    Dim objEntity As Object
    
            
    'Op te geven gevens:
    NewDate = "09-01-24"    'Nieuwe revisiedatum
    RevisionEditor = "TJNN"  'Naam van degene die de revisie heeft gemaakt
    EditorDepartment = "Klas"    'Afdeling

    MyPath_Drawings = "C:\Users\Thijs\Desktop\Definitief goedgekeurde VBA codes\Revisie aanpassen\" 'Locatie tekeningen
    
    
    On Error Resume Next
    Set acadApp = GetObject(, "AutoCAD.Application")
    On Error GoTo 0
 
    If acadApp Is Nothing Then
        Set acadApp = CreateObject("AutoCAD.Application")
        acadApp.Visible = True
    End If
       
       
    'Get a list of DWG files in the specified directory
    filesInDirectory = GetDWGFilesInDirectory(MyPath_Drawings)
    
    'Process each DWG file in the directory
    For Each currentFile In filesInDirectory
    
    
    'open the DWG-file
    acadApp.Documents.Open (MyPath_Drawings & currentFile)
    
        'search in ACAD-drawing for RevisionBlock
        For Each objEntity In ThisDrawing.ModelSpace
     
            'Check if the object is a BlockReference and if so, is it called REVIHEAD?
            If TypeOf objEntity Is AcadBlockReference Then
                If objEntity.Name = "REVIHEAD" Then
        
                Updated = 0
                varAttributes = objEntity.GetAttributes
        
                For i = LBound(varAttributes) To (UBound(varAttributes) - 1)
    
                    'Check if the attribuut is called "REV". If so, the drawing contains a revisionhead with only one revision line.
                    If varAttributes(i).TagString = "REV" Then
                        varAttributes(i).TextString = GetNextRevision(varAttributes(i).TextString)
                        varAttributes(i + 1).TextString = NewDate
                        varAttributes(i + 2).TextString = RevisionEditor
                        varAttributes(i + 3).TextString = EditorDepartment
                        Updated = 1
                        Exit For
                    End If
        
    'Als het revisieblok uit meerdere revisies bestaat, is deze alsvolgt opgebouwd:
    'varAttributes(0)= RA
    'varAttributes(1)= DATE_A
    'varAttributes(2)= BY_A
    'varAttributes(3)= DEPT_A
    'varAttributes(4)= RB
    'varAttributes(5)= DATE_B
    'varAttributes(6)= BY_B
    'varAttributes(7)= DEPT_B
    'varAttributes(8)= RC
    'varAttributes(9)= DATE_C
    'varAttributes(10)= BY_C
    'varAttributes(11)= DEPT_C

'Als het veld "REV" niet bestaat, betekent dit dat het een revisieblok is met meerdere revisievelden
'Dus nu eerst uitzoeken of er een datumveld leeg is en zoja, dan die regel invullen.
    
                    If varAttributes(i).TagString = "RA" And varAttributes(i + 1).TextString = "" Then
                        varAttributes(i + 1).TextString = NewDate
                        varAttributes(i + 2).TextString = RevisionEditor
                        varAttributes(i + 3).TextString = EditorDepartment
                        Updated = 1
                        Exit For
                    End If
            
                    If varAttributes(i).TagString = "RB" And varAttributes(i + 1).TextString = "" Then
                        varAttributes(i + 1).TextString = NewDate
                        varAttributes(i + 2).TextString = RevisionEditor
                        varAttributes(i + 3).TextString = EditorDepartment
                        Updated = 1
                        Exit For
                    End If
            
                    If varAttributes(i).TagString = "RC" And varAttributes(i + 1).TextString = "" Then
                        varAttributes(i + 1).TextString = NewDate
                        varAttributes(i + 2).TextString = RevisionEditor
                        varAttributes(i + 3).TextString = EditorDepartment
                        Updated = 1
                        Exit For
                    End If
                Next i
        'Als er geen lege revisieregel is moet worden uitgezocht welke regel de laagste revisie is.
        'Deze regel wordt dan overschreven met de nieuwe revisie.
        'De nieuwe revisieletter is de volgende letter in het alfabet, NA de huidige revisie letter.
                If Updated = 0 Then
                    If Asc(varAttributes(0).TextString) < (Asc(varAttributes(4).TextString) And Asc(varAttributes(8).TextString)) Then
                        If Asc(varAttributes(4).TextString) > Asc(varAttributes(8).TextString) Then
                            varAttributes(0).TextString = Chr(Asc(varAttributes(4).TextString) + 1)
                            varAttributes(1).TextString = NewDate
                            varAttributes(2).TextString = RevisionEditor
                            varAttributes(3).TextString = EditorDepartment
                            Updated = 1
                            Exit For
                        End If
                        varAttributes(0).TextString = Chr(Asc(varAttributes(8).TextString) + 1)
                        varAttributes(1).TextString = NewDate
                        varAttributes(2).TextString = RevisionEditor
                        varAttributes(3).TextString = EditorDepartment
                        Updated = 1
                        Exit For
                    End If
                
        
                    If Asc(varAttributes(4).TextString) < (Asc(varAttributes(0).TextString) And Asc(varAttributes(8).TextString)) Then
                        If Asc(varAttributes(0).TextString) > Asc(varAttributes(8).TextString) Then
                            varAttributes(4).TextString = Chr(Asc(varAttributes(0).TextString) + 1)
                            varAttributes(5).TextString = NewDate
                            varAttributes(6).TextString = RevisionEditor
                            varAttributes(7).TextString = EditorDepartment
                            Updated = 1
                            Exit For
                        End If
                        varAttributes(4).TextString = Chr(Asc(varAttributes(8).TextString) + 1)
                        varAttributes(5).TextString = NewDate
                        varAttributes(6).TextString = RevisionEditor
                        varAttributes(7).TextString = EditorDepartment
                        Updated = 1
                        Exit For
                     End If
                 
                    If Asc(varAttributes(8).TextString) < (Asc(varAttributes(0).TextString) And Asc(varAttributes(4).TextString)) Then
                        If Asc(varAttributes(0).TextString) > Asc(varAttributes(4).TextString) Then
                            varAttributes(8).TextString = Chr(Asc(varAttributes(0).TextString) + 1)
                            varAttributes(9).TextString = NewDate
                            varAttributes(10).TextString = RevisionEditor
                            varAttributes(11).TextString = EditorDepartment
                            Updated = 1
                            Exit For
                        End If
                        varAttributes(8).TextString = Chr(Asc(varAttributes(4).TextString) + 1)
                        varAttributes(9).TextString = NewDate
                        varAttributes(10).TextString = RevisionEditor
                        varAttributes(11).TextString = EditorDepartment
                        Updated = 1
                        Exit For
                    End If
                End If
            End If
        End If
    
        If Updated = 1 Then Exit For
    Next

    ' Sync the attributes in the RevisionBlock to get the text in the right position.
    ThisDrawing.SendCommand "ATTSYNC" & vbCr & "n" & vbCr & "REVIHEAD" & vbCr

    'Rename the fileName
    MyNewFileName = Left(currentFile, Len(currentFile) - 4)
    ThisDrawing.SaveAs (MyPath_Drawings & MyNewFileName & "_R.dwg")

    'Close the file
    ThisDrawing.Close
Next currentFile

End Sub

Function GetNextRevision(CurrentRevision As String) As String

    ' Add your code to get the next revision letter

If Not (CurrentRevision = "") Or (currentRevisoin = "-") Then

GetNextRevision = Chr(Asc(CurrentRevision) + 1)
Else

GetNextRevision = "A"

End If
End Function