AutoCAD VBA functions not working in Excel VBA

[interthenet]

I am trying to build an Excel app that will rip though a spreadsheet that contains the location of a large number of AutoCAD (2006) drawings. Specifically, I want to export the attributes of the Title block of each drawing to csv files for migration to another platform.

I coded a solution using VBA within AutoCAD which opened a drawing, read the contents of the Attributes from the Title block, and exported them to a csv file. That procedure works fine, albeit I have replaced the output routine by a msgbox in this example:

Public Sub ExportAttributes()
Dim elem As Variant
Dim varAtts() As AcadAttributeReference
Dim i As Integer
Dim j As Integer
Dim k As Integer
Call Initialise_Trace
For Each elem In ThisDrawing.ModelSpace
If elem.EntityName = "AcDbBlockReference" Then
If LCase(Mid(elem.Name, 1, 5)) = "title" Then
varAtts = elem.GetAttributes

i = LBound(varAtts)
j = UBound(varAtts)
For k = i To j

msgbox varAtts(k).TagString & ", " & varAtts(k).TextString

Next k

End If
End If
Next
End Sub

I then took this procedure across into Excel and referenced both the AutoCAD 2006 Type Library and the AutoCAD/ObjectDBX Common 16.0 Type Library in order to open and process the drawings from within Excel. I have verified that this works and I am able to open each of the Autocad drawings in turn. Here is the corresponding code in the Excel procedure, with additional variables declared to aid debugging:

Sub Export_Attributes()
Dim Thisdrawing As AcadDocument
Dim AcadApp As AcadApplication
Dim AngBracDwg As String
Dim folder_string As String
Dim drawing_string As String
Dim file_string As String
Dim folder_worksheet As String
Dim elem As Variant
Dim varAtts() As AcadAttributeReference
Dim attribute_name As String
Dim attribute_value As String
Dim HeadingString As String
Dim AttributeString As String
Dim max_f As Single
Dim max_r As Single
Dim f As Single
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim r As Single
On Error Resume Next

If AcadApp Is Nothing Then
Set AcadApp = CreateObject("AutoCAD.Application")
Else
Set AcadApp = GetObject(, "AutoCAD.Application")
End If

AcadApp.Visible = True

Worksheets("Folders").Select
max_f = max_row("Folders", 2, 4) ' bespoke function

For f = 2 To max_f
folder_worksheet = Worksheets("Folders").Cells(f, 1)
folder_string = Worksheets("Folders").Cells(f, 4)

Worksheets(folder_worksheet).Select
max_r = max_row(folder_worksheet, 3, 1)

For r = 3 To max_r
drawing_string = Worksheets(folder_worksheet).Cells(r, 1)

file_string = folder_string & "\" & drawing_string
AcadApp.Documents.Open (file_string)
Set Thisdrawing = AcadApp.ActiveDocument

Call Initialise_Trace(drawing_string)

For Each elem In Thisdrawing.ModelSpace
If elem.EntityName = "AcDbBlockReference" Then
If LCase(Mid(elem.Name, 1, 5)) = "title" Then
varAtts = elem.GetAttributes

i = LBound(varAtts)
j = UBound(varAtts)

HeadingString = ""
AttributeString = ""

For k = 1 To j

attribute_name = varAtts(k).TagString ' this assignment does not work
attribute_value = varAtts(k).TextString ' this assignment does not work

MsgBox drawing_string & " " & attribute_name & "# " & attribute_value & "#"

If HeadingString = "" Then
HeadingString = attribute_name
Else
HeadingString = HeadingString & Chr(9) & attribute_name
End If

If AttributeString = "" Then
AttributeString = attribute_value
Else
AttributeString = AttributeString & Chr(9) & attribute_value
End If

Next k

End If
End If
Next elem

AcadApp.Documents.Close

Next r
Next f

Set AcadApp = Nothing

End Sub


What's happening, or to be more precise what's not happening, is that the assignments of varAtts(k).TagString and varAtts(k).TextString return no value. I have verified that in both the AutoCAD version of the procedure and the Excel version of the procedure, the upper bounds of the varAtts array contain the value 14, so I am happy that the varAtts array does indeed contain values; I just seem unable to access those values from within the Excel version of the code.

Any help and advice would be most appreciated.

 

[Gary McMaster]

I have a workbook that does exactly what you're describing. I'll be happy to send you a copy if you want to private message me with your email address. It will require some minor modifications to work with your drawing database.

I have found that referencing the AutoCAD object model from within Excel for attribute extraction is rather slow. The above mentioned workbook will process approx 25-30 drawings per minute (most of my drawings are only about 250kb). The bottleneck is the AutoCAD drawing editor and its graphics processing. If this is a one time thing and you can run it on an unused workstation, or overnight, it may be fast enough.

The fastest way to do this extraction is from within AutoCAD using the "AutoCAD/ObjectDBX Common 16.0 Type Library". As I'm sure you already know, ObjectDBX does not load the drawing into the editor and does not have to handle the intense graphics. That makes much faster than loading the drawing. ObjectDBX can access the drawing database and write the data directly into Excel (no .csv). Using ObjectDBX I am able to extract title block attributes directly into Excel at the rate of 400-450 drawings per minute.

Both versions use named ranges in Excel. Each column in Excel is named the same as the AutoCAD attribute "Tag_String". The code doesn't look for a specific block name, it will access all blocks with attributes. If there is a "tagstring" match it writes the attribute text to that named column in Excel.

My ObjectDBX version would be more difficult for you to adapt to your organization but you're welcome to a copy of that too if you want to give it a shot.

Gary