Trying to get coordinate systems with VBA

Try to link Creo VB Type Library

https://learn.microsoft.com/en-us/office/vba/Language/Reference/User-Interface-Help/references-dialog-box

Getting a step further.

First I noticed I have copied the function twice in my original post. I have modified the function a bit so I now got to the next step:

Public Function createHoleUDFInPart(ByVal placementModel As IpfcSolid, _
 ByVal Name01 As String, _
 ByVal csysName As String, _
 ByVal Dim1 As Double, _
 ByVal Dim2 As Double, _
 ByVal Modell As IpfcModelItemOwner) _
 As IpfcFeatureGroup

 Dim csys As IpfcCoordSystem
 Dim cSystems As IpfcModelItems
 Dim i As Integer
 Dim udfInstructions As IpfcUDFCustomCreateInstructions
 Dim csysSelection As IpfcSelection
 Dim csysReference As IpfcUDFReference
 Dim references As CpfcUDFReferences
 Dim variantDims As IpfcUDFVariantDimension
 Dim variantDims2 As IpfcUDFVariantDimension
 Dim variantVals As IpfcUDFVariantValues
 Dim group As IpfcFeatureGroup

 Set csys = Nothing
 On Error GoTo Try
 
 Set cSystems = Modell.ListItems(EpfcModelItemType.EpfcITEM_COORD_SYS)

 For i = 0 To cSystems.Count - 1
 If (cSystems.Item(i).GetName = csysName) Then
 Set csys = cSystems.Item(i)
 Exit For
 End If
 Next

 If csys Is Nothing Then
 MsgBox ("Coordinate System not found in current Solid")
 End If

 '======================================================================
 'Instructions for UDF creation
 '======================================================================
 Set udfInstructions = New CCpfcUDFCustomCreateInstructions
 udfInstructions.InstanceName = "Name01"
 
 '======================================================================
 'Make non variant dimensions blank to disable their display
 '======================================================================
 udfInstructions.DimDisplayType = EpfcUDFDimensionDisplayType.EpfcUDFDISPLAY_BLANK

 '======================================================================
 'Initialize the UDF reference and assign it to the instructions.
 'The string argument is the reference prompt for the particular
 'reference.
 '======================================================================
 Set csysSelection = CMpfcSelect.CreateModelItemSelection(csys, Nothing)

 Set csysReference = CCpfcUDFReference.Create("Reference Coordinate System", csysSelection)

 Set references = CpfcUDFReferences.Set(0, csysReference)

 udfInstructions.references = references

 '======================================================================
 'Initialize the variant dimension and assign it to the instructions.
 'The string argument is the dimension symbol for the variant dimension.
 '======================================================================
 Set variantDims = CCpfcUDFVariantDimension.Create("d6", Dim1)
 Set variantDims2 = CCpfcUDFVariantDimension.Create("d7", Dim2)
 Set variantVals = CpfcUDFVariantValues.Set(0, variantDims)
 Set variantVals = CpfcUDFVariantValues.Set(1, variantDims2)
 
 udfInstructions.VariantValues = variantVals

 '======================================================================
 'We need the placement model for the UDF for the call to
 'CreateUDFGroup(). If you were placing the UDF in a model other than
 'the owner of the coordinate system, the placement would need to be
 'provided separately.
 '======================================================================

 Set group = placementModel.CreateUDFGroup(udfInstructions)
' createHoleUDFInPart = group
 MsgBox ("Hole Created")
Try:
 If Err.Number <> 0 Then
 MsgBox "Process Failed : Unknown error occurred." + Chr(13) + _
 "Error No: " + CStr(Err.Number) + Chr(13) + _
 "Error: " + Err.Description, vbCritical, "Error"
 End If
End Function

I have the coordinate info and now I want to create the UDF:

For this i declared "udfInstructions" as "IpfcUDFCustomCreateInstructions"

However when I want to set the udfInstructions (create a new one) with the following line I get a type mismatch error:

Set udfInstructions = New CCpfcUDFCustomCreateInstructions

Any idea how to solve this?

(I have to say the documentation on this VB API (vbug.pdf) is very incomplete and is missing a lot of information. And examples would be a nice touch as well)

For all who would like the complete solution. This VBA function is heavily based on the VB  script by William Quintero: Original VB script Take a look at his post first! You will need it to create the initial part (Box.prt) and the used UDF. It uses the same form layout:

The following function is triggered by the "Insert UDF" button.

Private Sub btnUpdate_Click()
 Dim asyncConnection As IpfcAsyncConnection
 Dim cAC As CCpfcAsyncConnection
 Dim session As IpfcBaseSession
 Dim Model As IpfcModel
 Set asyncConnection = Nothing

 On Error GoTo Try
 Set cAC = New CCpfcAsyncConnection
 Set asyncConnection = cAC.Connect(dbnull, dbnull, dbnull, dbnull)
 Set session = asyncConnection.session
 Set Model = session.CurrentModel
 If Model Is Nothing Then
 MsgBox ("Model not present")
 End If
 If (Not Model.Type = EpfcModelType.EpfcMDL_PART) And _
 (Not Model.Type = EpfcModelType.EpfcMDL_ASSEMBLY) Then
 MsgBox ("Model is not a solid")
 End If
 If SetDimensions(Model, txtLength.Text, txtWidth.Text, txtHeight.Text) Then
 MsgBox "Dimensions Changed."
 End If


Try:
 If Err.Number <> 0 Then
 MsgBox "Process Failed : Unknown error occurred." + Chr(13) + _
 "Error No: " + CStr(Err.Number) + Chr(13) + _
 "Error: " + Err.Description, vbCritical, "Error"
 If Not asyncConnection Is Nothing Then
 If asyncConnection.IsRunning Then
 asyncConnection.Disconnect (1)
 End If
 End If
 Else
 asyncConnection.Disconnect (1)
 End If
 UserForm1.Hide
End Sub

Then that function triggers the actual UDF insert.

Public Function createHoleUDFInPart(ByVal placementModel As IpfcSolid, _
 ByVal Name01 As String, _
 ByVal csysName As String, _
 ByVal DimX As Double, _
 ByVal DimY As Double, _
 ByVal Modell As IpfcModelItemOwner) _
 As IpfcFeatureGroup

'Create Hole UDF In Part
'======================================================================
'Function : createHoleUDFInPart
'Purpose : This function places copies of a node UDF at a
' particular coordinate system location in a part. The
' node UDF is a cylinder cut centered at the coordinate
' system whose diameter is driven by the argument to the
' method. The method returns the Feature Group object
' created.
'======================================================================
 Dim csys As IpfcCoordSystem
 Dim cSystems As IpfcModelItems
 Dim cBody As IpfcSolidBody
 Dim i As Integer
 Dim cUCCI As CCpfcUDFCustomCreateInstructions
 Dim udfInstructions As IpfcUDFCustomCreateInstructions
 Dim cSEL As CMpfcSelect
 Dim csysSelection As IpfcSelection
 Dim csysSelBody As IpfcSelection
 Dim cREF As CCpfcUDFReference
 Dim csysRefCoor As IpfcUDFReference
 Dim csysRefMod As IpfcUDFReference
 Dim cREFS As CpfcUDFReferences
 Dim cVDIM As CCpfcUDFVariantDimension
 Dim variantDimX As IpfcUDFVariantDimension
 Dim variantDimY As IpfcUDFVariantDimension
 Dim variantVals As CpfcUDFVariantValues
 Dim group As IpfcFeatureGroup

 On Error GoTo ErrorHandler

 Set cSystems = Modell.ListItems(EpfcModelItemType.EpfcITEM_COORD_SYS)
 Set cBody = placementModel.GetDefaultBody

 For i = 0 To cSystems.Count - 1
 If cSystems.Item(i).GetName = csysName Then
 Set csys = cSystems.Item(i)
 Exit For
 End If
 Next

 If csys Is Nothing Then
 MsgBox "Coordinate System not found in current Solid"
 Exit Function
 End If

 '======================================================================
 'Instructions for UDF creation
 '======================================================================
 Set cUCCI = New CCpfcUDFCustomCreateInstructions
 Set udfInstructions = cUCCI.Create(Name01)

 '======================================================================
 'Make non variant dimensions blank to disable their display
 '======================================================================
 udfInstructions.DimDisplayType = EpfcUDFDimensionDisplayType.EpfcUDFDISPLAY_BLANK

 '======================================================================
 'Initialize the UDF reference and assign it to the instructions.
 'The string argument is the reference prompt for the particular
 'reference. This is defined while creating the UDF! Make sure you use
 'the correct names.
 'The first ref is to the coordinate system, the second is for the body. 
 '======================================================================
 Set cSEL = New CMpfcSelect
 Set csysSelection = cSEL.CreateModelItemSelection(csys, Nothing)
 Set csysSelBody = cSEL.CreateModelItemSelection(cBody, Nothing)
 Set cREF = New CCpfcUDFReference
 Set csysRefCoor = cREF.Create("Reference Coordinate System", csysSelection)
 Set csysRefMod = cREF.Create("Reference Body", csysSelBody)
 
 Set cREFS = New CpfcUDFReferences
 Call cREFS.Set(0, csysRefCoor)
 Call cREFS.Set(1, csysRefMod)

 udfInstructions.references = cREFS

 '======================================================================
 'Initialize the variant dimension and assign it to the instructions.
 'The string argument is the dimension symbol for the variant dimension.
 'This argument is the dimension of the original UDF.
 'Again make sure you use the correct names/references.
 '======================================================================
 Set cVDIM = New CCpfcUDFVariantDimension
 Set variantDimX = cVDIM.Create("d33", CDbl(DimX))
 Set variantDimY = cVDIM.Create("d34", CDbl(DimY))

 Set variantVals = New CpfcUDFVariantValues
 Call variantVals.Set(0, variantDimX)
 Call variantVals.Set(1, variantDimY)
 
 udfInstructions.VariantValues = variantVals

 '======================================================================
 'We need the placement model for the UDF for the call to
 'CreateUDFGroup(). If you were placing the UDF in a model other than
 'the owner of the coordinate system, the placement would need to be
 'provided separately.
 '======================================================================

 Set group = placementModel.CreateUDFGroup(udfInstructions)
 Set createHoleUDFInPart = group
 Exit Function

ErrorHandler:
 MsgBox Err.Description & vbCrLf & Err.Number, vbExclamation
 Set createHoleUDFInPart = Nothing
End Function

I also added the functions for the "Update Creo Parameters", defining the shape of the box.prt. First the function that is triggered by the "Update Creo parameters" button:

Private Sub btnInsertUDF_Click()
 Dim asyncConnection As IpfcAsyncConnection
 Dim cAC As CCpfcAsyncConnection
 Dim session As IpfcBaseSession
 Dim Model As IpfcModel
 Dim Solid As IpfcSolid
 Set asyncConnection = Nothing

 On Error GoTo Try
 Set cAC = New CCpfcAsyncConnection
 Set asyncConnection = cAC.Connect(dbnull, dbnull, dbnull, dbnull)
 Set session = asyncConnection.session
 Set Model = session.CurrentModel
 If Model Is Nothing Then
 MsgBox ("Model not present")
 End If
 If (Not Model.Type = EpfcModelType.EpfcMDL_PART) And _
 (Not Model.Type = EpfcModelType.EpfcMDL_ASSEMBLY) Then
 MsgBox ("Model is not a solid")
 End If
 Set Solid = Model
 If Not createHoleUDFInPart(Solid, txtUDF.Text, txtCS.Text, txtX.Text, txtY.Text, Model) Is Nothing Then
 MsgBox "Hole Created."
 End If
 
Try:
 If Err.Number <> 0 Then
 MsgBox "Process Failed : Unknown error occurred." + Chr(13) + _
 "Error No: " + CStr(Err.Number) + Chr(13) + _
 "Error: " + Err.Description, vbCritical, "Error"
 If Not asyncConnection Is Nothing Then
 If asyncConnection.IsRunning Then
 asyncConnection.Disconnect (1)
 End If
 End If
 Else
 asyncConnection.Disconnect (1)
 End If
 UserForm1.Hide
End Sub

This function then calls for another function setting the sizes:

Public Function SetDimensions(ByVal mModel As IpfcModel, _
 ByVal dLength As Double, _
 ByVal dDepth As Double, _
 ByVal dHeight As Double) As Boolean

Dim px As IpfcParameterOwner
Dim p1 As IpfcParameter
Dim p2 As IpfcBaseParameter
Dim Mitem As CMpfcModelItem
Dim cSolid As IpfcSolid
Dim pv1 As IpfcParamValue
Dim Param As Object
 Set Param = CreateObject("Scripting.Dictionary")
 Param.Add "LENGTH", dLength
 Param.Add "DEPTH", dDepth
 Param.Add "HEIGHT", dHeight
 Set px = mModel
 For i = 0 To Param.Count - 1
 Set p1 = px.GetParam(Param.Keys()(i))
 Set p2 = p1
 Set Mitem = New CMpfcModelItem
 Set pv1 = Mitem.CreateDoubleParamValue(CDbl(Param.Items()(i)))
 p2.Value = pv1
 Next i
 Set cSolid = mModel
 Call cSolid.Regenerate(Nothing)
 SetDimensions = True

End Function

A number of improvements can/should be made: First the connection to Creo is done within the "button" functions, this should be a dedicated function creating or closing the the connection. Other things are the 'fixed' references to form elements and UDF references. However this is the first time and I think is works pretty well.