On Error Resume Next
Dim prms As parameters
Set prms = prd.parameters
Dim prm As parameter
Set prm = prms.CreateString("FeatureId", "")
Dim rlts As Relations
Set rlts = prd.Relations
Dim prmExp As String
prmExp = prms.GetNameToUseInRelation(Feature)
If left(prmExp, 1) = "`" Then
prmExp = prmExp & "->Id()"
Else
prmExp = "`" & prd.PartNumber & "" & prmExp & "`->Id()"
End If
Dim frml As Formula
Set frml = rlts.CreateFormula("GetId", "獲取Id", prm, prmExp)
GetFeatureId = prm.ValueAsString
rlts.Remove frml.name
prms.Remove prm.name
End Function
調用示例：
Sub test_getFeatId()
Dim doc As Document
Set doc = CATIA.ActiveDocument
Dim prd As product
Set prd = doc.product
Dim prt As Part
Set prt = doc.Part
Dim sel As Selection
Set sel = doc.Selection
Dim selObj As AnyObject
Set selObj = sel.Item(1).value
Debug.Print GetFeatureId(prd, selObj)
Debug.Print selObj.name
End Sub