Hello!
I am sorry but I am definitely not an expert on VBA. Don't blame me on this.
However I think I have the perfect application for a macro and try to develop it...
I have an ACAD drawing with 1200 independant text items that represent tags. I need to update these textstrings based on different values present in an excel table.
What I have managed to do is to export both the textstrings and the handles for each in an excel table.
So my excel table is as follows:
Column A: textstring.handle
Column B: ACAD original tag
Column D: Value of tag to be updated in ACAD
So, my whole code is the following:
Sub EXPORTER()
Dim RowIndex As Integer: RowIndex = 1
Dim tAcadApp As AcadApplication
Dim tAcadDoc As AcadDocument
Dim tTextObj As AcadText
On Error Resume Next
Set tAcadApp = GetObject(, AcadProgID)
If tAcadApp Is Nothing Then
Call showMsg("Please start AutoCAD, open your drawing and make sure there is no command active", True)
Else
'well, Acad seems to be available for COM-Reqests, see if a document is current/active
If tAcadApp.ActiveDocument Is Nothing Then
Call showMsg("Please open your drawing and make sure it's the active document", True)
Else
'ok, a drawing is active
Set tAcadDoc = tAcadApp.ActiveDocument
Dim tSelSet As AcadSelectionSet
'filter definition for selection
Dim tDxfCodes(1) As Integer
Dim tDxfValues(1) As Variant
tDxfCodes(0) = 0: tDxfValues(0) = SelectionObjectTypeName 'that's to get only objects of type "TEXT"
tDxfCodes(1) = 410: tDxfValues(1) = SelectionSpace
'create the selection
Set tSelSet = tAcadDoc.SelectionSets.Item("myTempSelSet")
If tSelSet Is Nothing Then
'then this selectionset didn't exist yet, so create a new one
Set tSelSet = tAcadDoc.SelectionSets.Add("myTempSelSet")
End If
tSelSet.Clear
'now run the selection
Err.Clear
tSelSet.Select acSelectionSetAll, , , tDxfCodes, tDxfValues
If Err.Number <> 0 Then
Call showMsg("Some error appeared while trying to select objects" & vbNewLine & Err.Description & vbNewLine & "Function cancelled", True)
Else
If tSelSet.Count = 0 Then
Call showMsg("No objects of type TEXT found", False)
Else
'ok, we have objects, so let us now append them to the current workbook
'I assume here, that Excel and the Workbook is ready and empty (or can be overwritten
'this routine starts in the ActiveSheet ==> A:1
For Each tTextObj In tSelSet
If tTextObj.Handle = Excel.ActiveSheet.Cells(RowIndex, 1) Then
tTextObj.TextString = Excel.ActiveSheet.Cells(RowIndex, 4)
Next
End If
End Sub
I am sure that where I am wrong is that it does not loop through the whole range of value of colum A to find its handle and hence retrieve its required updated tag:
For Each tTextObj In tSelSet
If tTextObj.Handle = Excel.ActiveSheet.Cells(RowIndex, 1) Then
tTextObj.TextString = Excel.ActiveSheet.Cells(RowIndex, 2)
Next
End If
Please, if you can guide me on how to do this, I would be very very grateful... Thanks, Vince