Code:
Sub CATMain()Dim oPartDocument As PartDocument
Dim oParameterSet as ParameterSet
Dim oParameter as Parameter
Dim oUserRefPropertyParameter as Parameter
Dim strFormula as String
Dim oFormula as Formula
Dim i as Integer
Dim sParameterName as String
Set oUserRefPropertyParameter = Nothing
If TypeName(CATIA.ActiveDocument) <> "PartDocument" Then
MsgBox "No PartDocument opened and active", vbCritical
Exit Sub
End If
Set oPartDocument = CATIA.ActiveDocument
Set oParameterSet = oPartDocument.Part.Parameters.RootParameterSet.ParameterSets.Item("Stückliste")
for i = 1 to oParameterSet.DirectParameters.Count
Set oParameter = oParameterSet.DirectParameters.Item(i)
sParameterName = Right(oParameter.Name, (Len(oParameter.Name) - InStrRev(oParameter.Name,"\")))
if sParameterName <> "" then
Set oUserRefPropertyParameter = GetUserRefPropertiesByName(oPartDocument.Product, sParameterName)
if Not oUserRefPropertyParameter is Nothing then
strFormula = oPartDocument.Part.Parameters.GetNameToUseInRelation(oParameter)
Set oFormula = oPartDocument.Part.Relations.CreateFormula("", "", oUserRefPropertyParameter, strFormula)
end if
end if
next
End Sub
Function GetUserRefPropertiesByName(oProduct As Product, ParameterName As String) As Parameter
Dim UserProperties As Parameters
Dim I As Integer
Set UserProperties = oProduct.UserRefProperties
For I = 1 To UserProperties.Count
If Right(UserProperties.Item(I).Name, Len(ParameterName)) = ParameterName Then
Set GetUserRefPropertiesByName = UserProperties.Item(I)
Exit Function
End If
Next
Set GetUserRefPropertiesByName = Nothing
End Function