Catia VBA，如何获取数组 "Bill of material"
Catia VBA, How to get "Bill of material" to an array
我想在“material 的账单”中获取 2 个参数。
结构 workbench 中的第一个“长度”，第二个是“数量”。
我尝试在
中找到这两个参数
CATIA.Documents.Item(Document).Product.ReferenceProduct
但是不能。
我有个主意。我尝试找到一种方法将“material 的法案”放入数组中。
我发现一个代码将 material 的 Bill 写入 excel 文件。
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
如何将“Bill of material”数据放入数组中？谢谢
结构设计元素的长度参数显然只能通过 StrComputeServices 获得
示例：
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
如果对您有帮助，我已经在下面开发了这段代码：
https://www.catiavb.net/sourceCodeCATIA.php#getbom
您可以在同一网站上找到获取 'MaLangue' 的功能（如有必要，可获取 CATIA 使用的 return 语言）。或者您可以删除引用 'MaLangue' 的每一行。如果您想获取根产品的 BOM，则可以编写 GetBOM(Catia.ActiveDocument.Product) 来启动子产品。或者您可以从根目录启动其他产品。
然后您可以读取 txt 文件的行（感谢流 reader）并按每个 vbTab 拆分以获得您的数组。优点是您将拥有一份材料清单，其中要么列出所有零件，要么只列出某些客户标准要求的第一级
'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
我想在“material 的账单”中获取 2 个参数。 结构 workbench 中的第一个“长度”，第二个是“数量”。 我尝试在
中找到这两个参数CATIA.Documents.Item(Document).Product.ReferenceProduct
但是不能。 我有个主意。我尝试找到一种方法将“material 的法案”放入数组中。 我发现一个代码将 material 的 Bill 写入 excel 文件。
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
如何将“Bill of material”数据放入数组中？谢谢
结构设计元素的长度参数显然只能通过 StrComputeServices 获得 示例：
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
如果对您有帮助，我已经在下面开发了这段代码：
https://www.catiavb.net/sourceCodeCATIA.php#getbom
您可以在同一网站上找到获取 'MaLangue' 的功能（如有必要，可获取 CATIA 使用的 return 语言）。或者您可以删除引用 'MaLangue' 的每一行。如果您想获取根产品的 BOM，则可以编写 GetBOM(Catia.ActiveDocument.Product) 来启动子产品。或者您可以从根目录启动其他产品。
然后您可以读取 txt 文件的行（感谢流 reader）并按每个 vbTab 拆分以获得您的数组。优点是您将拥有一份材料清单，其中要么列出所有零件，要么只列出某些客户标准要求的第一级
'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