Catia VBA, How to get "Bill of material" to an array - vba

Question

I want to get 2 parameters in "bill of material".
first "Length" in structure workbench, second is "quantity".
I try to find these 2 parameters in
CATIA.Documents.Item(Document).Product.ReferenceProduct
But can't.
I have an idea. I try find a way to get "Bill of material" into an array.
I found a code write Bill of material to excel file.
On Error Resume Next
Dim productDocument1 As productDocument
Set productDocument1 = CATIA.ActiveDocument
Dim product1 As Product
Set product1 = productDocument1.Product
Dim assemblyConvertor1 As AssemblyConvertor
Set assemblyConvertor1 = product1.GetItem("BillOfMaterial")
assemblyConvertor1.[Print] "XLS", "D:\BOM.xls", product1
How to get "Bill of material" data into an array? Thanks

Answer 1

The length parameter of elements of the structure design apparently only available trough the StrComputeServices
Example:
Sub CATMain()
Dim oRootProduct as Product
Dim oInstanceProduct as Product
Dim oStrWB as Workbench
Dim oStrServices As StrComputeServices
Set oRootProduct = CATIA.ActiveDocument.Product
Set oInstanceProduct = oRootProduct.Products.Item(1)
Set oStrWB = CATIA.ActiveDocument.GetWorkbench("StrWorkbench")
Set oStrServices = oStrWB.StrComputeServices
MsgBox CStr(oStrServices.GetLength(oInstanceProduct))
End Sub

Answer 2

I have developed this code below if it can help you :
https://www.catiavb.net/sourceCodeCATIA.php#getbom
You can find the function to get 'MaLangue' in same website (to return language used by CATIA if necessary). Or you can delete every line who refers to 'MaLangue'. To launch the sub you can write GetBOM(Catia.ActiveDocument.Product) if you want to get the BOM of the root product. Or you can launch for for an other product from the root.
You can then read lines of the txt file (thanks to a stream reader) and split by every vbTab to get your array. The advantage is that you will have a bill of materials that either lists all the parts, or only lists the first level as required by certain customer standards
'Genere la BOM
Public Sub GetBOM(p As Product)
Dim NomFichier As String = My. Computer . FileSystem . SpecialDirectories . Temp & "\BOM.txt"
Dim AssConvertor As AssemblyConvertor
AssConvertor = p. GetItem ( "BillOfMaterial" )
Dim nullstr ( 2 )
If MaLangue = "Anglais" Then
nullstr( 0 ) = "Part Number"
nullstr( 1 ) = "Quantity"
nullstr( 2 ) = "Type"
ElseIf MaLangue = "Francais" Then
nullstr( 0 ) = "Référence"
nullstr( 1 ) = "Quantité"
nullstr( 2 ) = "Type"
End If
AssConvertor. SetCurrentFormat (nullstr)
Dim VarMaListNom( 1 )
If MaLangue = "Anglais" Then
VarMaListNom( 0 ) = "Part Number"
VarMaListNom( 1 ) = "Quantity"
ElseIf MaLangue = "Français" Then
VarMaListNom( 0 ) = "Référence"
VarMaListNom( 1 ) = "Quantité"
End If
AssConvertor. SetSecondaryFormat (VarMaListNom)
AssConvertor. Print ( "HTML", NomFichier, p )
ModifFichierNomenclature (My. Computer . FileSystem . SpecialDirectories . Temp & "\BOM.txt" )
End Sub
Sub ModifFichierNomenclature(txt As String )
Dim strtocheck As String = ""
If MaLangue = "Francais" Then
strtocheck = "<b>Total des p"
Else
strtocheck = "<b>Total parts"
End If
Dim FichierNomenclature As String = My. Computer . FileSystem . SpecialDirectories . Temp & "\BOM_.txt"
If IO. File . Exists (FichierNomenclature) Then
IO . File . Delete (FichierNomenclature)
End If
Dim fs As FileStream = Nothing
fs = New FileStream( FichierNomenclature, FileMode. CreateNew )
Using sw As StreamWriter = New StreamWriter( fs, Encoding. GetEncoding ( "iso-8859-1" ) )
If IO. File . Exists (txt) Then
Using sr As StreamReader = New StreamReader(txt, Encoding. GetEncoding ( "iso-8859-1" ) )
Dim BoolStart As Boolean = False
While Not sr. EndOfStream
Dim line As String = sr. ReadLine
If Left (line, 8 ) = "<a name=" Then
If MaLangue = "Français" Then
line = "[" & Right (line, line. Length - 24 )
line = Left (line, line. Length - 8 )
line = line & "]"
sw . WriteLine (line)
Else
line = "[" & Right (line, line. Length - 27 )
line = Left (line, line. Length - 8 )
line = line & "]"
sw . WriteLine (line)
End If
ElseIf line Like " <tr><td><A HREF=*</td> </tr>*" Then
line = Replace (line, "</td><td>Assembly</td> </tr>", "" ) 'pas fait
line = Replace (line, "</td><td>Assemblage</td> </tr> ", "" )
line = Replace (line, " <tr><td><A HREF=", "" )
line = Replace (line, "</A></td><td>", ControlChars. Tab )
line = Replace (line, "#Bill of Material: ", "" )
line = Replace (line, "#Nomenclature : ", "" )
If line. Contains ( ">" ) Then
Dim lines( ) = Strings. Split (line, ">" )
line = lines( 1 )
End If
Dim lines_( ) = Strings. Split (line, ControlChars. Tab )
line = lines_( 0 ) & ControlChars . Tab & lines_( 1 )
If Strings. Left (line, 2 ) = " " Then line = Strings. Right (line, line. Length - 2 )
sw . WriteLine (line)
ElseIf Left (line, 14 ) = strtocheck Then
sw . WriteLine ( "[ALL-BOM-APPKD]" )
ElseIf line Like "*<tr><td>*</td> </tr>*" Then
line = Replace (line, "<tr><td>", "" )
line = Replace (line, "</td> </tr> ", "" )
line = Replace (line, "</td><td>", ControlChars. Tab )
Dim lines_( ) = Strings. Split (line, ControlChars. Tab )
line = lines_( 0 ) & ControlChars . Tab & lines_( 1 )
If Strings. Left (line, 2 ) = " " Then line = Strings. Right (line, line. Length - 2 )
sw . WriteLine (line)
Else
'nothing
End If
End While
sr . Close ( )
End Using
End If
sw . Close ( )
End Using
End Sub