I am new to the VB programming.
I need your help below is my request.
I need to export the details from geometrical set to excel from catia tree using vba.
i have several fastener details like shown below.
'Get CATIA or Launch it if necessary.
On Error Resume Next
Set CATIA = GetObject(, "CATIA.Application")
If CATIA Is Nothing Then
Set CATIA = CreateObject("CATIA.Application")
CATIA.Visible = True
End If
On Error GoTo 0
GetNextNode CATIA.ActiveDocument.Product
Application.StatusBar = ""
End Sub
Sub GetNextNode(oCurrentProduct As Product)
Dim oCurrentTreeNode As Product
Dim StrNomenclature, StrDesignation, StrWindows As String
Dim i As Integer
Dim LastRow As Long
Set WS = ThisWorkbook.Sheets("Sheet1")
' Loop through every tree node for the current product
For i = 1 To oCurrentProduct.Products.Count
Set oCurrentTreeNode = oCurrentProduct.Products.Item(i)
Set oparameters = oCurrentTreeNode.ReferenceProduct.UserRefProperties
MyCurrParentPN = oCurrentTreeNode.PartNumber
StrWindows = oCurrentTreeNode.ReferenceProduct.Parent.FullName
Application.StatusBar = oCurrentTreeNode.PartNumber
On Error Resume Next
' Determine if the current node is a part, product or component
If Mid(MyCurrParentPN, 15, 4) = "-STD" Then
LastRow = WS.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
WS.Cells(LastRow, 1) = oCurrentTreeNode.PartNumbe
End If
'if sub-nodes exist below the current tree node, call the sub recursively
If oCurrentTreeNode.Products.Count > 0 Then
GetNextNode oCurrentTreeNode
End If
Next
End Sub
Function IsProduct(objCurrentProduct As Product) As Boolean
Dim oTestProduct As ProductDocument
Set oTestProduct = Nothing
On Error Resume Next
Set oTestProduct = CATIA.Documents.Item(objCurrentProduct.PartNumber & ".CATProduct")
If Not oTestProduct Is Nothing Then
IsProduct = True
Else
IsProduct = False
End If
End Function
there is a typo in the script above, but due to On Error Next the code won't stop there...
WS.Cells(LastRow, 1) = oCurrentTreeNode.PartNumbe -- r is missing in .PartNumber
Thank you for the reply LWolf.
After updating above also macro running until the part and its not extracting data from the geo sets as shown in picture
'Get CATIA or Launch it if necessary.
On Error Resume Next
Set CATIA = GetObject(, "CATIA.Application")
If CATIA Is Nothing Then
Set CATIA = CreateObject("CATIA.Application")
CATIA.Visible = True
End If
On Error GoTo 0
GetNextNode CATIA.ActiveDocument.Product
Application.StatusBar = ""
End Sub
Sub GetNextNode(oCurrentProduct As Product)
Dim oCurrentTreeNode As Product
Dim StrNomenclature, StrDesignation, StrWindows As String
Dim i As Integer
Dim LastRow As Long
Set WS = ThisWorkbook.Sheets("Sheet1")
' Loop through every tree node for the current product
For i = 1 To oCurrentProduct.Products.Count
Set oCurrentTreeNode = oCurrentProduct.Products.Item(i)
Set oparameters = oCurrentTreeNode.ReferenceProduct.UserRefProperties
MyCurrParentPN = oCurrentTreeNode.PartNumber
StrWindows = oCurrentTreeNode.ReferenceProduct.Parent.FullName
Application.StatusBar = oCurrentTreeNode.PartNumber
On Error Resume Next
' Determine if the current node is a part, product or component
If Mid(MyCurrParentPN, 15, 4) = "-STD" Then
' LastRow = WS.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
' WS.Cells(LastRow, 1) = MyCurrParentPN
Dim oCurrentTreeNodePart
Dim MBod
Set oCurrentTreeNodePart = oCurrentTreeNode.ReferenceProduct.Parent.Part
Debug.Print oCurrentTreeNodePart.Name
Set mBody = oCurrentTreeNodePart.MainBody
Debug.Print mBody.Name
Set objParameters = oCurrentTreeNodePart.Parameters
' Loop on parameters to retrieve them
[highlight #FCAF3E] For j = 1 To objParameters.Count
Set objParameter = objParameters.Item(j)
strParmName = objParameter.Name
Debug.Print strParmName
strParmValue = objParameter.ValueAsString
Debug.Print strParmValue
' MsgBox strParmName & " = " & strParmValue
Debug.Print strParmName & " = " & strParmValue
End If
'if sub-nodes exist below the current tree node, call the sub recursively
If oCurrentTreeNode.Products.Count > 0 Then
GetNextNode oCurrentTreeNode
End If
Next
End Sub
Function IsProduct(objCurrentProduct As Product) As Boolean
Dim oTestProduct As ProductDocument
Set oTestProduct = Nothing
On Error Resume Next
Set oTestProduct = CATIA.Documents.Item(objCurrentProduct.PartNumber & ".CATProduct")
If Not oTestProduct Is Nothing Then
IsProduct = True
Else
IsProduct = False
End If
End Function