Author Topic: AutoCAD to Excel  (Read 3334 times)

0 Members and 1 Guest are viewing this topic.

ML

  • Guest
AutoCAD to Excel
« on: October 29, 2004, 11:51:34 AM »
Hello,

I am sure for a lot of you, this is an old topic but still very new and interesting to me. I am wondering if I can create a custom spread sheet in Excel, then have my attributes from AutoCAD cleanly populate the spread sheet?


I have played around with this in the past but with little luck.

I would really appreciate it if someone could get me on the right track?

I have a fairly good understanding of VBA

Any help is really appreciated

Thank you

Mark

ronjonp

  • Needs a day job
  • Posts: 7009
AutoCAD to Excel
« Reply #1 on: October 29, 2004, 12:39:49 PM »
Express Tools - attout ?

Ron

Windows 10 x64 - AutoCAD /C3D 2020

Custom Build PC

ML

  • Guest
AutoCAD to Excel
« Reply #2 on: October 29, 2004, 01:37:12 PM »
No, that is too sloppy. This will require VBA and possible ODBC

TR

  • Guest
AutoCAD to Excel
« Reply #3 on: October 29, 2004, 08:47:48 PM »
Give a better description of what you want to do and I'll help you out.

Trev

  • Guest
AutoCAD to Excel
« Reply #4 on: November 03, 2004, 01:50:50 AM »
First we need to to list all block names within your drawing.
create a form with a listbox named Listbox1.


when the form is initialized you can call a function to list all block names in your drawing
Code: [Select]

Option Explicit
Dim blkname As String
Public objSS As AcadSelectionSet

Dim MyBlist() As String
Dim ObjBlockRef As AcadBlockReference
Dim MaxAtt As Integer

Sub UserForm_Initialize()
    UserForm1.Caption = "Block attributes to Excel"
    Call ListBlocks
End Sub


The following function will create an array (a VBA array) of all the block names in your current drawing, it will also place them into alphabetical order.
Code: [Select]

Function ListBlocks()
    Dim ObjBlk As AcadBlock
    Dim MyBlkList() As String
    Dim iCounter As Integer
    Dim i As Variant
       
On Error Resume Next
   
    iCounter = 0
    For Each ObjBlk In ThisDrawing.Blocks
        If Not (ObjBlk.IsXRef) Then
            If Left(ObjBlk.Name, 1) <> "*" Then
                ReDim Preserve MyBlkList(iCounter)
                MyBlkList(iCounter) = ObjBlk.Name
                iCounter = iCounter + 1
            End If
        End If
    Next
'   sort list order into alphabetical order
    SortArray MyBlkList

'   place the sorted array list into a ListBox
    For i = LBound(MyBlkList) To UBound(MyBlkList)
        UserForm1.ListBox1.List() = MyBlkList
    Next
End Function

'begin array sort, this will sort the array into alphabetical order
Public Sub SortArray(StringArray() As String)
    Dim loopOuter As Integer
    Dim loopInner As Integer
    Dim i As Integer
    For loopOuter = UBound(StringArray) To _
      LBound(StringArray) Step -1
        For loopInner = 0 To loopOuter - 1
            If UCase(StringArray(loopInner)) > _
              UCase(StringArray(loopInner + 1)) Then
                Swap StringArray(loopInner), _
                  StringArray(loopInner + 1)
            End If
        Next loopInner
    Next loopOuter
End Sub
Private Sub Swap(a As String, b As String)
    Dim c As String: c = a: a = b: b = c
End Sub
'End array sort



Now that you have a listbox containing all your blocks you can now select one to export any attributes to excel

create a command button on the form named CommandButton1
Code: [Select]

Sub CommandButton1_Click()
'send attribute data to excel
Dim i As Integer
Dim intType(0 To 1) As Integer
Dim varData(0 To 1) As Variant

On Error Resume Next

    If Not IsNull(objSS) Then
        ThisDrawing.SelectionSets.Item("Export_SelectionSet").Delete
    Else
    End If
    For i = 0 To UserForm1.ListBox1.ListCount
        If UserForm1.ListBox1.Selected(i) = True Then
            intType(0) = 0
            varData(0) = "INSERT"
            intType(1) = 2
            varData(1) = UserForm1.ListBox1.List(i)
            Set objSS = ThisDrawing.SelectionSets.Add("Export_SelectionSet")
            objSS.Select acSelectionSetAll, FilterType:=intType, FilterData:=varData
        End If

    Next i
        Call GetAtts
        Call Export2Excel

'    UnloadDVB This VBA program
'    ThisDrawing.SendCommand "_vbaunload" & vbCr & "DVBFILENAME.dvb" & vbCr
    End 'ends program closes form
End Sub



The below will get the attribut values for each block (as selected in the list) in the drawing.
Code: [Select]

Sub GetAtts()
Dim varPick As Variant
Dim objEnt As AcadEntity
Dim varAttribs As Variant
Dim strAttribs As String
Dim BlkCount As Integer
Dim lngI As Integer
Dim iCounter As Integer


On Error Resume Next

    iCounter = 0
    MaxAtt = 1
    BlkCount = objSS.Count
    For Each ObjBlockRef In objSS
        If ObjBlockRef.HasAttributes Then
            'get attributes
            varAttribs = ObjBlockRef.GetAttributes
            For lngI = LBound(varAttribs) To UBound(varAttribs)
                ReDim Preserve MyBlist(BlkCount, MaxAtt + 1)
                MyBlist(iCounter, 0) = ObjBlockRef.Name
                MyBlist(iCounter, lngI + 1) = varAttribs(lngI).TextString
                If UBound(varAttribs) > MaxAtt Then
                    MaxAtt = UBound(varAttribs)
                End If
            Next lngI
                iCounter = iCounter + 1
        End If
    Next
End Sub


'The following function sends each block attribute to excel placing it into a cell, a new row is created for each block encountered.
Code: [Select]

Function Export2Excel()
'export data to Excel
    Dim excel As Object 'Excel itself
    Dim excelsheet As Object 'the Excel sheet
    Dim exapp As Object 'the Excel file
    Dim RowNum As Integer
    Dim i As Variant
    Dim ia As Integer

On Error Resume Next 'prevent stopping if Excel is not open
    Set excel = GetObject(, "Excel.application") 'activate Excel if open
    If Err <> 0 Then
        Set excel = CreateObject("Excel.application") 'Open Excel if not open
    End If
    excel.Visible = True
    Set exapp = excel.Workbooks.Add '("C:\My Documents\Sample.xls") 'open the file

    ia = 0
    With excel
        Set excelsheet = excel.ActiveWorkbook.Sheets("sheet1") 'activate the sheet
        excelsheet.Cells(2, ia + 1).Value = "BlockName"
        With exapp
            RowNum = 3 'start in row 3 (data already exists in rows 1-8 in the formatted file)
            For i = LBound(MyBlist, 1) To UBound(MyBlist, 1) 'for the number of lines add the length to a cell
                Do While ia < MaxAtt + 2
                    If MyBlist(i, ia) = "" Then
                        ia = ia + 1
                    Else
                        ' send this info to excel spreedsheet
                        excelsheet.Cells(RowNum, ia + 1).Value = MyBlist(i, ia)
'                        Debug.Print MyBlist(i, ia)
                        ia = ia + 1
                    End If
                Loop
                RowNum = RowNum + 1 'increment the row number for the next entry
                ia = 0
            Next
        End With
    End With
    Erase MyBlist
End Function




Ok now that should do the trick.
It's a little crude, as I did not allow for a test to or a bypass if the block you selected does not contain any attributes. It will simply go through the program as if it does. So therefore it will open excel create a blank worksheet.
What you can add or modify is a test so it will not do that and maybe give you a message box saying block does not contain attributes so nothing to do.

The above programming only allows for a single block name. So it is useful for numbered items etc.
once this is done you can then either creat some more pragramming within excel to build a pretty table or you could even add that into the acad vba program, tht way it's all contained in the one program. It's a little trickier as you have do control excel from acad, but can be done without to much trouble.

I hope the above makes sense.
most of that programming is extracts from my Global Attribute editer as posted in the Swamp earlier.

ML

  • Guest
AutoCAD to Excel
« Reply #5 on: November 04, 2004, 07:11:47 PM »
Cool Trev

It looks great, I will need to try it when I get a chance

Thank you very much

Mark