Modified Catia BOM macro

[vijayjaipal]

Hello,

I downloaded a catia BOM macro and attempted to modify to our needs- unfortunately I am stuck on one final thing...
From the Single product assembly, am able to extract all the parts in the BOM .
When i have multiple products assembly and parts selected inside assembly doesn't appear in the BOM
Could you anyone help me on this

I really am a novice when it comes to coding, so any advise you can provide would be extremely helpful.

below is the code am using


Sub CATMain()
' ******************************* test if product is open *****************************
If CATIA.Documents.Count = 0 Then
MsgBox "There is no CATIA Documents open. Open a Product file and run this script again.", , msgboxtext
Exit Sub
End If
If InStr(CATIA.ActiveDocument.Name, ".CATProduct") < 1 Then
MsgBox "Active CATIA Document is not a Product. Open a Product file and run this script again.", , msgboxtext
Exit Sub
End If
' ******************************* variables *******************************************
Set cad = CATIA.ActiveDocument
Set sel = cad.Selection
Set prod = cad.Product.Products



'Dim tab(4,9000)
Dim tab2(4, 9000)
k = 0
' ******************************* test if some parts is selected **********************
If sel.Count = 0 Then
MsgBox "Select parts from tree.", , msgboxtext
Exit Sub
End If
If sel.Count >= 9000 Then
MsgBox "Number of selected parts for BOM exceeds 9000. Program error.", , msgboxtext
Exit Sub
End If
' ******************************* load ************************************************
For i = 1 To prod.Count
For j = 1 To sel.Count
If prod.Item(i).Name = sel.Item(j).Reference.Name Then
k = k + 1
tab2(1, k) = prod.Item(i).PartNumber
'tab(2,k)=sel.item(j).reference.name
'tab(3,k)=prod.item(i).DescriptionRef
tab2(4, k) = 1
End If
Next
Next
' ******************************* sort ************************************************
If k > 1 Then
For i = 1 To k - 1
For j = i + 1 To k
If tab2(1, i) > tab2(1, j) Then
tab2(1, 9000) = tab2(1, j)
'tab(2,9000)=tab(2,j)
tab2(3, 9000) = tab2(3, j)
tab2(4, 9000) = tab2(4, j)
tab2(1, j) = tab2(1, i)
'tab(2,j)=tab(2,i)
tab2(3, j) = tab2(3, i)
tab2(4, j) = tab2(4, i)
tab2(1, i) = tab2(1, 9000)
'tab(2,i)=tab(2,9000)
tab2(3, i) = tab2(3, 9000)
tab2(4, i) = tab2(4, 9000)
End If
Next
Next
' ******************************* count ***********************************************
Dim total, linecount, totalcount
total = 1
linecount = 1
totalcount = 1



For i = 1 To k
If tab2(1, i) = tab2(1, i + 1) Then
linecount = linecount + 1
End If
If tab2(1, i) <> tab2(1, i + 1) Then
tab2(1, totalcount) = tab2(1, i)
tab2(4, totalcount) = linecount
totalcount = totalcount + 1
linecount = 1
End If
tab2(4, totalcount) = linecount
Next

End If

k = totalcount - 1

' ******************************* output to excel *************************************
'for i=1 to k
'msgbox i & " " & tab(1,i) & " " & tab(2,i) & " " & tab(3,i) & " " & tab(4,i)
'next
Dim xlApp
Err.Clear
On Error Resume Next
' set xlApp = GetObject(,"Excel")
Set xlApp = GetObject(, "EXCEL.Application")
If Err.Number <> 0 Then
Err.Clear
' Set xlApp = CreateObject("Excel")
Set xlApp = CreateObject("EXCEL.Application")
End If
xlApp.Visible = True
xlApp.Workbooks.Add
If Err.Number <> 0 Then
MsgBox "Can't open excel.", , msgboxtext
workbook.Close
xlApp.Quit
End If
row = 1
col = 1
xlApp.Cells(row, col + 1).Value = "CATProduct:"
xlApp.Cells(row, col + 1).Font.Bold = True
xlApp.Cells(row + 1, col + 1).Value = cad.Name
row = 4
xlApp.Cells(row, col + 1).Value = "Part Number"
xlApp.Cells(row, col + 2).Value = " "
xlApp.Cells(row, col + 3).Value = "Description"
xlApp.Cells(row, col + 4).Value = "QNT."
xlApp.Columns.Columns(2).Columnwidth = 30
xlApp.Columns.Columns(3).Columnwidth = 30
xlApp.Columns.Columns(4).Columnwidth = 50
For i = 1 To 4
xlApp.Cells(row, col + i).Interior.ColorIndex = 40
xlApp.Cells(row, col + i).Font.Bold = True
xlApp.Cells(row, col + i).HorizontalAlignment = 3
xlApp.Cells(row, col + i).borders.LineStyle = 1
xlApp.Cells(row, col + i).borders.Weight = -4138
Next
' row=row+1
For i = 1 To k
xlApp.Cells(row + i, col + 1).Value = tab2(1, i)
'xlApp.Cells(row+i,col+2).Value = tab(2,i)
'xlApp.Cells(row+i,col+3).Value = trim(tab(3,i))
xlApp.Cells(row + i, col + 4).Value = tab2(4, i)
For j = 1 To 4
xlApp.Cells(row + i, col + j).Interior.ColorIndex = 19
xlApp.Cells(row + i, col + j).Font.Bold = False
xlApp.Cells(row + i, col + j).borders.LineStyle = 1
Next
Next
xlApp.Cells(row + i, col).Select
' xlApp.Cells(1, 1).HorizontalAlignment = 2
End Sub