Indented BOM in Drawing Macro

Hi,

 

Does anyone know how to turn a top-level BOM in solidworks drawing into an indented BOM using a macro?

I have a macro that currently captures the BOM but I would need it to capture the indented BOM for my application.

I understand that there are macros that can capture the BOM using the model but in those it also includes the items that are marked as 'excluded from the BOM' which can result in unnecessary items being purchased.

 

This is the current code that saves the drawing BOM in a csv:

Dim swApp As Object

Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Dim VIEWDIR As String
Dim WORKDIR As String
Dim Ptemp As String
Dim PN As String
Dim MAT As String

Dim i As Integer
Dim j As Integer
Dim k As Integer

Dim TPATH As Variant
Dim PSTN As Variant
Dim LNTH As Variant
Dim TNAME As Variant
Dim swTBL As Object
Dim BOMrows As Variant
Sub main()

VIEWDIR = "P:\FB\view\"
WORKDIR = "c:\work\"

Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Set SelMgr = Part.SelectionManager

Ptemp = Part.GetTitle
PN = Left(Ptemp, Len(Ptemp) - 7)

If PN Like "M" & "*" Then GoTo START_PROCESS 'MsgBox TNAME & PN

'MsgBox Part.CustomInfo("Description") 'Ptemp & PN
'swApp.CloseDoc PN & FTP

'Stop

'On Error GoTo thend


TPATH = Part.GetPathName
PSTN = InStrRev(TPATH, ".")
LNTH = Len(TPATH)
TNAME = Right(Mid(TPATH, 1, PSTN - 1), 8)

Set XL = CreateObject("Excel.Application")
Workbooks.Open (WORKDIR & "bom import.csv")

 


'Set Part = swApp.ActiveDoc
'Set SelMgr = Part.SelectionManager

boolstatus = Part.Extension.SelectByID2("", "ANNOTATIONTABLES", 0.7109330150767, 0.5334641077493, 0, False, 0, Nothing, 0)
Set swTBL = SelMgr.GetSelectedObject3(1)

BOMrows = swTBL.RowCount
Dim BOMArray(100, 3) As String
For i = 1 To BOMrows - 1
   BOMArray(i, 0) = TNAME
       'MsgBox BOMArray(I, 0)
   BOMArray(i, 1) = swTBL.Text(i, 2) 'QTY
       'MsgBox BOMArray(I, 1)
   BOMArray(i, 2) = swTBL.Text(i, 3)  'PN
       'MsgBox BOMArray(I, 2)
   BOMArray(i, 3) = swTBL.Text(i, 1) 'DESC
       'MsgBox BOMArray(I, 3)
Next i


'Sheets(bomtemp).Select
For j = 1 To 250
   If Range("A" & j + 1).Value = "" Then
       'k = j
       GoTo next1
   End If
Next j
next1:
GoTo SKIP_section ' skip finish code
If TPROP = "N" Then GoTo SKIP_section
'If Len(TPROP) Then
   TNAME = PN & "-" & Len(TPROP)
SKIP_section:

'''''''''''''''''first line''''''''''''''''''''''''''''''''''''''''
   Range("A" & j + 1).Value = "BOM"              'parent assy
   Range("B" & j + 1).Value = TNAME              'parent part number
   Range("C" & j + 1).Value = Part.CustomInfo("Description")  'Combo2.Text 'BOMArray(i - 1, 2) 'description
   Range("D" & j + 1).Value = "Manufacture"      'type
   Range("E" & j + 1).Value = "1"      'revision quatity
   Range("F" & j + 1).Value = "Build To Order" 'AutoCreatetype
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
i = 1

For k = j + 2 To j + BOMrows
   'If Range("A" & k).Value = "" Then GoTo next2
   i = i + 1
   Range("A" & k).Value = "Item"                        'flag
   Range("B" & k).Value = "Add " & BOMArray(i - 1, 1)   'part number
   Range("C" & k).Value = "Raw Good"                    'BOMArray(i - 1, 2)   'description
   Range("D" & k).Value = BOMArray(i - 1, 1)            'part number
   Range("E" & k).Value = BOMArray(i - 1, 3)            'qty
   Range("F" & k).Value = "ea"
   If BOMArray(i - 1, 1) Like "A" & "*" Then
       Range("N" & k).Value = "TRUE"
       Range("O" & k).Value = BOMArray(i - 1, 1)
   End If
   'End If
Next k
next2:
'''''''''''''''''last line''''''''''''''''''''''''''''''''''
   Range("A" & k).Value = "Item"             'flag
   Range("B" & k).Value = "Create " & TNAME   'parent part number
   Range("C" & k).Value = "Finished Good"    'description
   Range("D" & k).Value = TNAME              'typeRange
   Range("E" & k).Value = "1"                'qty
   Range("F" & k).Value = "ea"                'AutoCreatetype
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'boolstatus = Part.Extension.SelectByID2("Drawing View1", "DRAWINGVIEW", 0.1788631226205, 0.3817642413007, 0, False, 0, Nothing, 0)

 

'MsgBox TPROP
'Stop


Workbooks("bom import.csv").Close SaveChanges:=True
MsgBox Import & " your BOMimport is complete!", , "BOM Import"
GoTo skiperror
START_PROCESS:
thend:
MsgBox "Import Error"
skiperror:
swApp.CloseDoc PN & ".slddrw"
End Sub

Thanks,

Ehsan