Modified Catia BOM macro
Modified Catia BOM macro
(OP)
Hello, I downloaded a bom macro and attempted to modify to to our needs- unfortunately I am stuck on one final thing...
this is what I am getting when I select the 4 parts and run macro-

the macro appears to be counting the instance name (I think?) i would like it to tally only the part name.

this is what I would like to have happen when I select the 4 parts-

I really am a novice when it comes to coding, so any advise you can provide would be extremely helpful.
Finally, here is the code I am using...
Language="VBSCRIPT"
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,1999)
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 >=1999 Then
MsgBox "Number of selected parts for BOM exceeds 1999. 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
tab(1,k)=prod.item(i).PartNumber
'tab(2,k)=sel.item(j).reference.name
'tab(3,k)=prod.item(i).DescriptionRef
tab(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 tab(1,i)>tab(1,j)then
tab(1,1999)=tab(1,j)
'tab(2,1999)=tab(2,j)
tab(3,1999)=tab(3,j)
tab(4,1999)=tab(4,j)
tab(1,j)=tab(1,i)
'tab(2,j)=tab(2,i)
tab(3,j)=tab(3,i)
tab(4,j)=tab(4,i)
tab(1,i)=tab(1,1999)
'tab(2,i)=tab(2,1999)
tab(3,i)=tab(3,1999)
tab(4,i)=tab(4,1999)
end if
next
next
' ******************************* count ***********************************************
for i=1 to k-1
for j=i+1 to k
if tab(1,i)=tab(1,j) and j<=k then
tab(1,j)=tab(1,k)
'tab(2,j)=tab(2,k)
tab(3,j)=tab(3,k)
tab(4,j)=tab(4,k)
tab(4,i)=tab(4,i)+1
k=k-1
end if
next
next
end if
' ******************************* 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 = tab(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 = tab(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
Thank you again for your support
Kyle
this is what I am getting when I select the 4 parts and run macro-

the macro appears to be counting the instance name (I think?) i would like it to tally only the part name.

this is what I would like to have happen when I select the 4 parts-

I really am a novice when it comes to coding, so any advise you can provide would be extremely helpful.
Finally, here is the code I am using...
Language="VBSCRIPT"
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,1999)
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 >=1999 Then
MsgBox "Number of selected parts for BOM exceeds 1999. 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
tab(1,k)=prod.item(i).PartNumber
'tab(2,k)=sel.item(j).reference.name
'tab(3,k)=prod.item(i).DescriptionRef
tab(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 tab(1,i)>tab(1,j)then
tab(1,1999)=tab(1,j)
'tab(2,1999)=tab(2,j)
tab(3,1999)=tab(3,j)
tab(4,1999)=tab(4,j)
tab(1,j)=tab(1,i)
'tab(2,j)=tab(2,i)
tab(3,j)=tab(3,i)
tab(4,j)=tab(4,i)
tab(1,i)=tab(1,1999)
'tab(2,i)=tab(2,1999)
tab(3,i)=tab(3,1999)
tab(4,i)=tab(4,1999)
end if
next
next
' ******************************* count ***********************************************
for i=1 to k-1
for j=i+1 to k
if tab(1,i)=tab(1,j) and j<=k then
tab(1,j)=tab(1,k)
'tab(2,j)=tab(2,k)
tab(3,j)=tab(3,k)
tab(4,j)=tab(4,k)
tab(4,i)=tab(4,i)+1
k=k-1
end if
next
next
end if
' ******************************* 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 = tab(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 = tab(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
Thank you again for your support
Kyle





RE: Modified Catia BOM macro
just curious... where did you get it from?
indocti discant et ament meminisse periti
RE: Modified Catia BOM macro
RE: Modified Catia BOM macro
the instance name is ESS-90-25-K28-280.x
the PartNumber is ESS-90-25-K28-200
I have the feeling the counting is done on the PartNumber.
Now the code sees your PartNumber as 3+1 not 4... seems one is different from the other.
Could you check all PartNumber if there is any space after?
indocti discant et ament meminisse periti
RE: Modified Catia BOM macro
(I didn't come across any spaces or stray numbering)
However, some curious occurrences happened...
I ran the macro selecting the outer two... success
ran the inner two... success
an inner and an outer... success (then the other side... success)
when run a combination of any 3... this happens
finally, all 4...my initial result
RE: Modified Catia BOM macro
RE: Modified Catia BOM macro
indocti discant et ament meminisse periti
RE: Modified Catia BOM macro
is this is as per requirement???
if yes... then use below code... i am also attaching CATVbs file....
Language="VBSCRIPT"
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,1999)
dim tab2(4,1999)
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 >=1999 Then
MsgBox "Number of selected parts for BOM exceeds 1999. 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
tab(1,k)=prod.item(i).PartNumber
'tab(2,k)=sel.item(j).reference.name
'tab(3,k)=prod.item(i).DescriptionRef
tab(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 tab(1,i)>tab(1,j)then
tab(1,1999)=tab(1,j)
'tab(2,1999)=tab(2,j)
tab(3,1999)=tab(3,j)
tab(4,1999)=tab(4,j)
tab(1,j)=tab(1,i)
'tab(2,j)=tab(2,i)
tab(3,j)=tab(3,i)
tab(4,j)=tab(4,i)
tab(1,i)=tab(1,1999)
'tab(2,i)=tab(2,1999)
tab(3,i)=tab(3,1999)
tab(4,i)=tab(4,1999)
end if
next
next
' ******************************* count ***********************************************
dim total, linecount, totalcount
total=1
linecount=1
totalcount=1
for i=1 to k
if tab(1,i)=tab(1,i+1) then
linecount=linecount+1
end if
if tab(1,i)<>tab(1,i+1) then
tab2(1,totalcount)=tab(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
RE: Modified Catia BOM macro
THIS WORKS EXACTLY HOW I NEED IT TO!
THANK YOU! :)
it appears the count needed to be set to one... then I am not sure of the specifics.
if you don't mind- I'd like to know what factors you considered in the original code to draw your conclusion for this new code. I apologize if there is an obvious answer, but I am a novice and would like to be able to learn from this experience.
thank you again
Kyle
RE: Modified Catia BOM macro
So I run the code up to the count, then executed the script line by line and looked at the values in the tab() array. I did that with a selection of 2 identical items, and again with a selection of 10...
That's how I found that the count section was not good.
if you look at the original script
CODE --> vba
' ******************************* count *********************************************** for i=1 to k-1 for j=i+1 to k if tab(1,i)=tab(1,j) and j<=k then tab(1,j)=tab(1,k) tab(3,j)=tab(3,k) tab(4,j)=tab(4,k) tab(4,i)=tab(4,i)+1 k=k-1 end if next nextFirst, when you do a for - next loop
CODE --> vba
CODE --> vba
B = 10 For i = 1 To B B = B - 1 Next MsgBox iwill show
all selected element are listed in tab(1,x) the count is listed in tab(4,x)
if one element (nth) is the same as the next (n+1th) then replace the next (n+1th) with the kth one in the list and add 1 to the current (nth) count and change the limit to the last one to (last-1)
that might seems ok but it is not:
let say we have 4 same elements selected:
tab(1,1) = part1 tab(4,1) =1
tab(1,2) = part1 tab(4,2) =1
tab(1,3) = part1 tab(4,3) =1
tab(1,4) = part1 tab(4,4) =1
let's follow the script
i=1 j=2 k=4 with i going up to 3 (k-1)
if tab(1,1) = tab(1,2) then tab (1,2) = the value of tab(1,4) = part1 and tab(4,1) is increased to 2 and k=3
so we have
i=1 j=2 k=3
tab(1,1) = part1 tab(4,1) =2
tab(1,2) = part1 tab(4,2) =1
tab(1,3) = part1 tab(4,3) =1
tab(1,4) = part1 tab(4,4) =1
next j
i=1 j=3 k=3
if tab(1,1) = tab(1,3) then tab (1,3) = the value of tab(1,3) (not much change here) = part1 and tab(4,1) is increased to 3 and k = 2
we now have
i=1 j=3 k = 2
tab(1,1) = part1 tab(4,1) =3
tab(1,2) = part1 tab(4,2) =1
tab(1,3) = part1 tab(4,3) =1
tab(1,4) = part1 tab(4,4) =1
next j
i=1 j=4 k = 2
as j>k then next j but j reach K limit of 4 so next i
next i
i=2 k = 2
j =3 to 2 so nothing goes here next i
next i
i=3 k = 2
j =4 to 2 so nothing goes here next i
next i
i=4 above the first limit of 3
we have :
k=2
tab(1,1) = part1 tab(4,1) =3
tab(1,2) = part1 tab(4,2) =1
tab(1,3) = part1 tab(4,2) =1
tab(1,4) = part1 tab(4,2) =1
excel will show tab(1,x) with count of tab(4,x) for all x up to k
tab(1,1)=part1 tab(4,1)=3
tab(2,1)=part1 tab(4,2)=1
I let you do the simulation with 10 instances of the same part...
I would have used a Dictionary with the part as key and the count as item
CODE --> VBA
I would have also change a bit the excel output script...and many other things...
indocti discant et ament meminisse periti
RE: Modified Catia BOM macro
itsmyjob have already explained everything (y) :)
RE: Modified Catia BOM macro