Continue to Site

Eng-Tips is the largest engineering community on the Internet

Intelligent Work Forums for Engineering Professionals

Register Log in
  • Congratulations waross on being selected by the Eng-Tips community for having the most helpful posts in the forums last week. Way to Go!

Modified Catia BOM macro 1

Status
Not open for further replies.
TheKyle9

TheKyle9

Mechanical
Oct 1, 2015
14
US
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-
output_hjvrin.jpg



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



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


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
 
Replies continue below

Recommended for you

Sort by date Sort by votes
TheKyle9 said:
I downloaded a bom macro ...
Click to expand...

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

Eric N.
indocti discant et ament meminisse periti ​
 
Upvote 0 Downvote
OP said:
the macro appears to be counting the instance name (I think?) i would like it to tally only the part name.
Click to expand...

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 ​
 
Upvote 0 Downvote
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
1_fwva3p.jpg




ran the inner two... success
2_oijyfl.jpg




an inner and an outer... success (then the other side... success)
5a_n9vdn0.jpg




when run a combination of any 3... this happens
3_ghjhnn.jpg



finally, all 4...my initial result
4_pazxnl.jpg
 
Upvote 0 Downvote
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
 
Upvote 0 Downvote
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 ​
 
Upvote 0 Downvote
check below image....
is this is as per requirement???

image_bgafwv.png



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
 
Upvote 0 Downvote
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
 
Upvote 0 Downvote
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

Code: 
' ******************************* 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
Code: 
for 1 = 1 to b 
next i
the limit B of the loop is not evaluated each time but only the first time

Code: 
B = 10
For i = 1 To B
    B = B - 1
Next
MsgBox i
will show

2016-01-08_16-23-24_sgnt9q.png



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

Code: 
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 ​
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

howdyitssam
  • Question
Catia V5 Macro - SmartTeam info to Excel
Replies
3
Views
239
Little Cthulhu
Little Cthulhu
Sandy_Man
  • Question
Catia V6 Macro - Edit Sheet Background Using VBA
Replies
1
Views
188
ferdo
ferdo
vangilme
  • Question
CATIA V5 Macro - changing orientation of axis system
Replies
4
Views
206
Boyinlove82
Boyinlove82
pieswt
  • Locked
  • Question
Runtime error CATIA BOM Export using Macro
Replies
1
Views
45
jmarkus
jmarkus
Capko
  • Locked
  • Question
Projected area CATIA macro VBS
Replies
0
Views
50
Capko
Capko

Part and Inventory Search

Sponsor

Back
Top