VBA
Discuss AutoCAD ActiveX and VBA (Visual Basic for Applications) questions here.
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

Excel VBA to extract attrubutes from AutoCAD 2014

2 REPLIES 2
Reply
Message 1 of 3
mosness
6653 Views, 2 Replies

Excel VBA to extract attrubutes from AutoCAD 2014

I have a program that I used years ago to extract attributes from AutoCAD into excel.   The VBA program is in excel.  It is Attribute extraction Utility for AutoCAD Release 14.   I want to use it again for 2014 but when I run it I get a compile error can't find project or library and it highlights the the following code "set doc = ACAD.ActiveDocument".   Can anyone help me fix this problem?    Below is the entire VBA sub routine.

 

' THIS EXTRACTS THE ATTRIBUTE VALUES FROM AUTOCAD TO EXCEL
Sub Extract()
Dim sheet As Object
Dim shapes As Object
Dim elem As Object
Dim Excel As Object
Dim Max As Integer
Dim Min As Integer
Dim NoOfIndices As Integer
Dim excelSheet As Object
Dim RowNum As Integer
Dim Array1 As Variant
Dim Count As Integer

Set Excel = GetObject(, "Excel.Application")
Worksheets("AcadAttr").Activate
Set excelSheet = Excel.ActiveWorkbook.Sheets("AcadAttr")
excelSheet.Range(Cells(8, 1), Cells(1000, 100)).Clear
excelSheet.Range(Cells(8, 1), Cells(1, 100)).Font.Bold = True
Set ACAD = Nothing
On Error Resume Next
Set ACAD = GetObject(, "AutoCAD.Application")
ACAD.Visible = True
Set doc = ACAD.ActiveDocument
Set mspace = doc.ModelSpace
RowNum = 8
Dim Header As Boolean
Header = False

Dim SelSet4 As Object
Dim pt1(0 To 2) As Double
Dim pt2(0 To 2) As Double
Set SelSet4 = doc.SelectionSets.Add("ss4")
pt1(0) = 87#
pt1(1) = 96#
pt1(2) = 0#
pt2(0) = 231#
pt2(1) = 160#
pt2(2) = 0#
SelSet4.Select acSelectionSetWindow, pt1, pt2

For Each elem In SelSet4
With elem
If StrComp(.EntityName, "AcDbBlockReference", 1) = 0 Then
If .HasAttributes Then
Array1 = .GetAttributes
For Count = LBound(Array1) To UBound(Array1)
If Header = False Then
If StrComp(Array1(Count).EntityName, "AcDbAttribute", 1) = 0 Then
excelSheet.Cells(RowNum, Count + 1).Value = Array1(Count).TagString
End If
End If
Next Count
RowNum = RowNum + 1
For Count = LBound(Array1) To UBound(Array1)
excelSheet.Cells(RowNum, Count + 1).Value = Array1(Count).TextString
Next Count
Header = True
End If
End If
End With
Next elem
NumberOfAttributes = RowNum - 1
If NumberOfAttributes > 0 Then
Worksheets("AcadAttr").Range("A8").Sort _
Key1:=Worksheets("AcadAttr").Columns("A"), _
Header:=xlGuess
Else
MsgBox "No attributes found in the current drawing"
End If
Set ACAD = Nothing
End Sub

2 REPLIES 2
Message 2 of 3
fxcastil
in reply to: mosness

http://forums.autodesk.com/t5/Visual-Basic-Customization/Getobject-method-with-AutoCAD-2013/td-p/364...

 

Did you add/change the reference to the current version of AutoCad?

 

 

 

 

Message 3 of 3
mosness
in reply to: fxcastil

I added AutoCAD 2014 type Library.

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report

”Boost