Extracting data from a different kind of file

[tazz]

Hello,

I have this excel macro extracting data from a drawing (please see code below).

I played with this macro and I changed a couple of things but now I need your help to add/change some lines of this code to do this:

-insert data starting with col BA instead of A

-make excel to extract only specific blocks from acad (BL1, BL2…) to specific location(BL1 in col BA, BL2 in col BC…).

Thank you for your help.

Public acad As Object
Public mspace As Object
Public excel As Object
Public AcadRunning As Integer
Public excelSheet As Object
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")
    Set excelSheet = excel.ActiveWorkbook.ActiveSheet
    excelSheet.Range(Cells(1, 1), Cells(45, 8)).Clear
    excelSheet.Range(Cells(1, 1), Cells(1, 8)).Font.Bold = True
    excelSheet.Range(Cells(1, 1), Cells(1, 8)).Font.Color = 1152
        Set acad = Nothing
    On Error Resume Next
    Set acad = GetObject(, "AutoCAD.Application")
    If Err <> 0 Then
        Set acad = CreateObject("AutoCAD.Application")
        acad.Visible = True
        MsgBox "Please open a drawing file and then restart this macro."
        Exit Sub
    End If
    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
                                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
      ActiveWorkbook.ActiveSheet.Range("A1").Sort _
        key1:=ActiveWorkbook.ActiveSheet.Columns("A"), _
        Header:=xlGuess
    Else
        MsgBox "No attributes found in the current drawing."
    End If
    Set acad = Nothing
End Sub
Private Sub Auto_Close()
    Set excelSheet = Nothing
End Sub

[/CODE]

 

[SirJB7]

Hi, tazz!

Being Excel forums is hardly probable that people had handy Autocad .dwg files and even more with the technical specs regarding internal blocks (what would they be?) to test and adapt your code.

So consider uploading a sample workbook file (including manual examples of desired output if applicable) and a couple of drawing files with and without the block conditions to be tested, it'd be very useful for those who read this and might be able to help you. Thank you.

Regards!

 

[tazz]

Hello,
You are right, it is like a shoot in the dark without autocad. I was hoping that being excel vba it will be easy to manipulate some lines of code. For example I tried to change this lines :
ActiveWorkbook.ActiveSheet.Range("A1").Sort _
key1:=ActiveWorkbook.ActiveSheet.Columns("A")
to change the insertion column but It didn't work.
Thank you

 

[SirJB7]

Hi, tazz!

Maybe you can get helped with the VBA part of inserting columns but not much more. Let me see if I understand what you're trying to do:
a) That line sorts data by column A, no data is moved out of the range.
b) Do you want to insert which data (that of column A, of another column range, ...?) where (before or after which column?)?

And what about the sample files?

Regards!

 

[tazz]

Hi, Sirjb
This macro will bring some data from a dwg and it will insert it starting with col A. I want that the extracting process to start with col BA.
Also it will very useful if I can make excel to bring only "plate" or others.
Thank you for your help.