Autocad blok description to Excel

[advance]

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.

[fixo]

Quote:   Originally Posted by: advance 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 

VBA tags courtesy of www.thecodenet.com