Eng-Tips is the largest engineering community on the Internet

Intelligent Work Forums for Engineering Professionals

  • Congratulations waross on being selected by the Eng-Tips community for having the most helpful posts in the forums last week. Way to Go!

Extract Parameters below HybridShapes VBA

Status
Not open for further replies.

Sidtha

Aerospace
Nov 25, 2012
30
IN
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.
Param_yoayov.jpg


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(n)
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
 
Replies continue below

Recommended for you

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

regards,
LWolf
 
Hi LWolf,

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

BR
Siddu
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top