Home > Software engineering >  Catia VBA, How to get "Bill of material" to an array
Catia VBA, How to get "Bill of material" to an array

Time:05-17

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

CodePudding user response:

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

CodePudding user response:

i developped 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
  • Related