Author Topic: asks specific data to excel autocad  (Read 2313 times)

0 Members and 1 Guest are viewing this topic.


  • Guest
asks specific data to excel autocad
« on: January 05, 2015, 07:51:47 AM »
Hello everyone , my name is Louis and post from italy
I searched on the web and especially in " TheSwamp " but I have not found my solution
in TheSwamp I have seen many examples of code but I can not get what I want
What do I want ?
I wish with excel macro queries the active drawing containing the blocks and returns me
" Block Name "
 " Handle"
" TAG1 "
" Term01 "
" TERM02 "
" TERM03 "
" XRF"
I would avoid that ask me to choose which file
in short, has to interact with the active drawing with autocad
to retrieve the data and successively , after editing by the user , return to autocad changes on the blocks present
is it possible?


  • Guest
Re: asks specific data to excel autocad
« Reply #1 on: January 05, 2015, 02:06:55 PM »


  • Seagull
  • Posts: 12955
  • I like my water diluted.
Re: asks specific data to excel autocad
« Reply #2 on: January 05, 2015, 03:48:33 PM »
This should get you started:

Although you could also go the non-coding route and use the DATAEXTRACTION command.
Autodesk Expert Elite
Revit Subject Matter Expert (SME)
Owner/FAA sUAS Pilot @


  • Guest
Re: asks specific data to excel autocad
« Reply #3 on: January 05, 2015, 05:51:19 PM »
thanks for the reply
Your reference is relative to vba autocad
but I am referring to excel

for example, in a discussion of this forum there is this code that is beautiful except that instead of retrieving only some references to one or all of the blocks on the active drawing puts many voices that do not understand
Code: [Select]
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
    Dim SHand As String
    Dim TStr As String
    Set Excel = GetObject(, "Excel.Application")
    Set excelSheet = Excel.ActiveWorkbook.Sheets("Attributes")
    excelSheet.Range(Cells(1, 1), Cells(5000, 100)).Clear
    excelSheet.Range(Cells(1, 1), Cells(1, 100)).Font.Bold = True
    Set acad = Nothing
    On Error Resume Next
    Set acad = GetObject(, "AutoCAD.Application")
    If Err <> 0 Then
        Set acad = CreateObject("AutoCAD.Application")
        MsgBox "Open the drawing file first and then rexecute!"
        Exit Sub
    End If
    acad.Visible = True
    Set doc = acad.ActiveDocument
    Set mspace = doc.ModelSpace
    RowNum = 1
    Dim Header As Boolean
    Header = False
    For Each elem In mspace
        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
                                TStr = Array1(Count).TagString
                                excelSheet.Cells(RowNum, Count + 1).Value = TStr
                            End If
                        End If
                    Next Count
                    RowNum = RowNum + 1
                    For Count = LBound(Array1) To UBound(Array1)
                        TStr = Array1(Count).TextString
                        excelSheet.Cells(RowNum, Count + 1).Value = TStr
                    Next Count
                    SHand = elem.Handle
                    excelSheet.Cells(RowNum, Count + 1).NumberFormat = "@"
                    excelSheet.Cells(RowNum, Count + 1).Value = SHand
                    Header = True
                End If
            End If
        End With
    Next elem
    NumberOfAttributes = RowNum - 1

    Set acad = Nothing
End Sub

I would that ever burst only excel in these items

Cells(3, 1).Value = "Nome Blocco"
 Cells(3, 2).Value = "Handle"
 Cells(3, 3).Value = "TAG1"
 Cells(3, 4).Value = "TERM01"
 Cells(3, 5).Value = "TERM02"
 Cells(3, 6).Value = "TERM03"
 Cells(3, 7).Value = "XREF"
 Cells(3, 8).Value = "FAMILY"