Jump to content

Batch Extraction of Attributes to Excel


Jim Clayton

Recommended Posts

Going to try and explain this with as little confusion as possible.  I have a series of drawings. Sometimes 1-10, sometimes 1-100.  They all have BOM's.  BOM's consist of Item#, QTY, UOM, Description, Material, & Stock Code.  I want to extract the UOM, QTY, and Stock Code from all sheets in the series and send them to an excel sheet.  The preferred execution method would be to do this from the Excel side, but I'm open to a Lisp or other suggestions.  Anyone think they might be able to help?  The BOM attributes are laid out per attachment.  Would greatly appreciate any guidance on this.  Tks.
Below link is from a thread that is similar, but in the opposite direction of what I'm trying to do...I'm not trying to extract/change/import.  I only want to extract specific attributes and put onto a spreadsheet.  Tks.
https://www.cadtutor.net/forum/topic/63793-autocad-title-block-from-excel-vba/?tab=comments#comment-525675

BOM-Model.pdf

Link to comment
Share on other sites

Maybe something along these lines, but modified, that would allow me to select an entire range of drawings to extract data from?

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"
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 "Excel file was saved as: " & vbCr & ThisDrawing.Path & "\Attributes.xls"
'--------------------
Err_Control:

End Sub[code]
Link to comment
Share on other sites

I am working on something at the moment very slowly due to other commitments but sounds like what your after a more personalised version of dataextraction. Basically block name & attribute combos, but the number of attributes is a free variable it could be all or the 1st and 3rd etc. it does totals and sorts on the 1st two attributes so can have a "door" with paint colour and handle type as individual counts.

Can you post a sample dwg.

It may be easier to just create a CSV file then open in excel. There is lots of lisps about getting attributes of blocks and adding them up etc. Do a google. Pretty sure Lee-mac has a block count lisp.

 

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...