Wanted to extract the values from geometrical set to excel

[Sidtha]

Hello All,

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.

please help me
Thank you

 

[Sidtha]

Below is code return in excel vba
Dim WS As Worksheet
Sub CATMain()


ThisWorkbook.Sheets("Sheet1").Range("A3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("A1").Select

Dim CATIA As Object

'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

 

[LWolf]

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

regards,
LWolf

 

[Sidtha]

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

 

[tesak]

I do not see any code to extract parameters into excel sheet, as I see it you only extract part number, nothing else.

Tesak

https://scripts4all.eu/play-tetris-in-catia-v5-drawing-vba/

- Play Tetris in CATIA V5 drawing

 

[Sidtha]

Hi tesak,

yes i am not able write code for that so i am asking that how i can extract the parameters

 

[tesak]

Then please upload a sample product as it is really hard to do something meaningful without data.

Tesak

https://scripts4all.eu/play-tetris-in-catia-v5-drawing-vba/

- Play Tetris in CATIA V5 drawing

 

[Sidtha]

Below is my complete code written in VBA

In highlighted code its giving the results for all the data below the part, but i need the data only from the geometrical set like shown below.

Dim WS As Worksheet
Sub CATMain()

Application.ScreenUpdating = True
ThisWorkbook.Sheets("Sheet1").Range("A3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("A1").Select

Dim CATIA As Object

'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

LastRow = WS.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
WS.Cells(LastRow, 1) = MyCurrParentPN
WS.Cells(LastRow, 2) = strParmName & " = " & strParmValue

Next[/highlight]

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

 

[tesak]

Sorry, but it is really hard to give you advice if we can't test it by ourselves.

Tesak

https://scripts4all.eu/play-tetris-in-catia-v5-drawing-vba/

- Play Tetris in CATIA V5 drawing

 

[Sidtha]

Sorry i think i have not asked proper way sorry for that Tesak


My question is-- is there way to extract data from the particular geometrical set.
For ex:- in My case geometrical set name is "Modified".

 

[Sidtha]

now i am getting parameters from all geo sets

 

[LWolf]

yes you can, by using the code along
oCurrentTreeNodePart.Parameters.SubList(oShape, False)

regards,
LWolf