Extract Parameters below HybridShapes VBA

[Sidtha]

Hi All,

I have written below to scan all the geo sets and shapes but unable to get the parameters below SHAPES, could someone please help me to get the same.

I am getting below result till
No of Geosets--2
Geosets name level1--Fasteners
Geosets name level2--Modified
Geosets name level3--Diameter_0.313_(5/16")_|_7.9mm
Count of Hybridshapes--68
Hybridshapes Name--en6114K5-12.263

Question is need to extract the parameters below the Hybridshapes, for reference please see the below picture.

Sub CATMain()
Dim WS As Worksheet
'Clear contents from the excel
Application.ScreenUpdating = True
ThisWorkbook.Sheets("Sheet1").Range("A3:AP3").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 = ""
WS.Range("B1").Value = ""
MsgBox "Update Done!!"
End Sub
Sub GetNextNode(oCurrentProduct As Product)

Dim oCurrentTreeNode As Product
Dim StrNomenclature, StrDesignation, StrWindows As String
Dim i As Integer
Dim R As Long, C As Long
Dim LastRow As Long
Dim LastColumn 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
On Error Resume Next

'---Determine the product is a STD container-----------------------------------
If Mid(MyCurrParentPN, 15, 4) = "-STD" Then
Dim oCurrentTreeNodePart
Set oCurrentTreeNodePart = oCurrentTreeNode.ReferenceProduct.Parent.Part

Dim MBody
Set MBody = oCurrentTreeNodePart.MainBody
'-------Get hybridBodies level1------------------------------------------------
Dim hybridBodies1
Set hybridBodies1 = oCurrentTreeNodePart.HybridBodies
Debug.Print hybridBodies1.Count
For j = 1 To hybridBodies1.Count
Set objBodies = hybridBodies1.Item(j)
If objBodies.Name = "Fasteners" Then
Debug.Print objBodies.Name
'---------------Get hybridBodies level2------------------------------------------------
Dim hybridBodies2
Set hybridBodies2 = objBodies.HybridBodies
For k = 1 To hybridBodies2.Count
Set objBodies2 = hybridBodies2.Item(k)
Debug.Print objBodies2.Name
'-------------------Get hybridBodies level3------------------------------------------------
Dim hybridBodies3
Set hybridBodies3 = objBodies2.HybridBodies
LastColumn = WS.Cells(2, Columns.Count).End(xlToLeft).Offset(1, 0).Column
LastRow = WS.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
For l = 1 To hybridBodies3.Count
C = 5
'-----------------------Get HybridShapes------------------------------------------------------
Set objBodies3 = hybridBodies3.Item(l)
Debug.Print objBodies3.Name
Set objShape = objBodies3.HybridShapes
Debug.Print objShape.Count
For m = 1 To objShape.Count
Set objShapeHS = objShape.Item(m)
Debug.Print objShapeHS.Name
'---------------------------Get parameters----------------------------------------------------
'From here i am unable to get the parameters from HybridShapes
'Please help me to get the same
Set parameters1 = objShapeHS.hybriShapeInstance.inputsCount
Debug.Print parameters1.Count
Set strParam1 = parameters1.Item(1)
Debug.Print strParam1.Value

For n = 1 To parameters1.Count
Set objParameter = strParam1.Item
strParmName = objParameter.Name
WS.Cells(LastRow, 1) = MyCurrParentPN
WS.Cells(LastRow, 2) = objBodies.Name
WS.Cells(LastRow, 3) = objBodies3.Name
WS.Cells(LastRow, 4) = objShapeHS.Name
WS.Cells(LastRow, 5) = parameters1.Name
LastRow = LastRow + 1
Next
Next
Next
Next
End If
Next
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]

but I have already told you how to obtain the parameters of a particular object

regards,
LWolf

 

[Sidtha]

Hi LWolf,

I got the result as expected thank you
Set parameters1 = oCurrentTreeNodePart.Parameters.SubList(objShapeHS, False)

BR
Siddu