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
Did you add/change the reference to the current version of AutoCad?