Modified Catia BOM macro 1

[TheKyle9]

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

 

[itsmyjob]

I downloaded a bom macro ...

just curious... where did you get it from?

Eric N.
indocti discant et ament meminisse periti ​

 

[TheKyle9]

http://www.ema3.com/CATIA_V5_MACRO/V5_index.php?e3bom

 

[itsmyjob]

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

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?

Eric N.
indocti discant et ament meminisse periti ​

 

[TheKyle9]

That's okay that the instance number is different from the part number, the part number is all that matters, and each of the 4 parts seem to be consistently named.
(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

 

[TheKyle9]

The 3+1 you mentioned was exactly what the code was producing, the image I made showing a tally of 4 was an edit I made to the spreadsheet just to show what I would like the macro to produce. sorry for the confusion

 

[itsmyjob]

you should contact Radek from the website as I see some (C) on his macros and it would be nice if someone would let him know that his count does not work properly.

Eric N.
indocti discant et ament meminisse periti ​

 

[sachinTata]

check below image....
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

 

[TheKyle9]

sachinTata,

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

 

[itsmyjob]

when you script VBA code you can see values of variable during execution.

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

' ******************************* 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
next

First, when you do a for - next loop

for 1 = 1 to b 
next i

the limit B of the loop is not evaluated each time but only the first time

B = 10
For i = 1 To B
    B = B - 1
Next
MsgBox i

will show

all selected element are listed in tab(1,x) the count is listed in tab(4,x)

if one element (n[sup]th[/sup]) is the same as the next (n+1[sup]th[/sup]) then replace the next (n+1[sup]th[/sup]) with the k[sup]th[/sup] one in the list and add 1 to the current (n[sup]th[/sup]) 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

Dim mybom As New Scripting.Dictionary

For i = 1 To k

If Not mybom.Exists(tab(1, i)) Then mybom.Add tab(1, i), 0

mybom.Item(tab(1, i)) = mybom.Item(tab(1, i)) + 1

Next

End If

k = mybom.Count

I would have also change a bit the excel output script...and many other things...

Eric N.
indocti discant et ament meminisse periti ​

 

[sachinTata]

welcome TheKyle9

itsmyjob have already explained everything

 

[TheKyle9]

fantastic, thank you for your time guys