Autocad blok description to Excel [Archive]

fixo

07-16-2011, 12:22 PM

Hello

First of all sorry for my English, its not my native language. I will try to describe my problem as much as I can.

Im new to Autocad and Visual Basic. I've already successfully wrote some Excel script's, and now its time for Autocad.

Can anyone help me to read block description fields ? Ive already successfully wrote an script counting every block in the drawing.

Please help.

Best regards.

Welcome on board
Try this code, it will create Excel file in the drawing folder named "...\Attributes.xls"

Option Explicit
''--> Make sure under Tools--> Options --> General tab you have to select "Break on Unhandled Errors"
''--> Add reference to Excel Object Library
Public Sub WriteAttributes()
Dim oSset As AcadSelectionSet
Dim oEnt As AcadEntity
Dim oBlkRef As AcadBlockReference
Dim oAtt As AcadAttributeReference
Dim varAtt As Variant
Dim i As Long
Dim ftype(1) As Integer
Dim fdata(1) As Variant
ftype(0) = 0: fdata(0) = "INSERT"
ftype(1) = 66: fdata(1) = 1
Dim dxftype As Variant
Dim dxfdata As Variant
dxftype = ftype
dxfdata = fdata
'---------------------
Dim xlApp As Object
Dim xlBook As Workbook
Dim xlSheet As Worksheet
Dim lngRow As Long, lngCol As Long
'---------------------
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err <> 0 Then
Err.Clear
Set xlApp = CreateObject("Excel.Application")
If Err <> 0 Then
MsgBox "Impossible to initialize an Excel.", vbExclamation
End
End If
End If
'---------------------
On Error Resume Next
Set oSset = ThisDrawing.SelectionSets.Item("$Attribs$")
If Err Then
Err.Clear
Set oSset = ThisDrawing.SelectionSets.Add("$Attribs$")
End If
On Error GoTo Err_Control
oSset.SelectOnScreen dxftype, dxfdata
'---------------------
xlApp.Visible = True
Set xlBook = xlApp.Workbooks.Add
xlBook.Sheets.Add.Name = 1
Set xlSheet = xlBook.Sheets(1)
lngRow = 1
xlSheet.Cells(lngRow, 1).Value = "Block Name"
'For i = 2 To 11
'xlSheet.Cells(lngRow, i).Value = "Attribue " & CStr(i - 1)
'Next
xlSheet.Rows(1).Font.Bold = True
xlSheet.Rows(1).Font.ColorIndex = 5
'---------------------
lngRow = 2
For Each oEnt In oSset
Set oBlkRef = oEnt
If oBlkRef.IsDynamicBlock Then
xlSheet.Cells(lngRow, 1).Value = oBlkRef.EffectiveName
Else
xlSheet.Cells(lngRow, 1).Value = oBlkRef.Name
End If
varAtt = oBlkRef.GetAttributes
lngCol = 2
For i = 0 To UBound(varAtt)
Set oAtt = varAtt(i)
xlSheet.Cells(lngRow, lngCol).Value = oAtt.TagString
xlSheet.Cells(lngRow + 1, lngCol).Value = oAtt.TextString
lngCol = lngCol + 1
Next i
lngRow = lngRow + 2
Next oEnt
'--------------------
Dim oRange As Range
Set oRange = xlSheet.UsedRange
For i = 2 To oRange.Columns.Count
xlSheet.Cells(1, i).Value = "Attribue " & CStr(i - 1)
Next
'--------------------
xlSheet.Columns.HorizontalAlignment = xlHAlignLeft
xlSheet.Columns.AutoFit
xlBook.SaveAs ThisDrawing.Path & "\Attributes.xls"
xlBook.Close
'--------------------
xlApp.Application.Quit
Set xlApp = Nothing
Set xlBook = Nothing
Set xlSheet = Nothing
'--------------------
MsgBox "Done"
'--------------------
Err_Control:
End Sub