cancel
Showing results for 
Search instead for 
Did you mean: 
cancel
Showing results for 
Search instead for 
Did you mean: 

Community Tip - Need to share some code when posting a question or reply? Make sure to use the "Insert code sample" menu option. Learn more! X

Trying to get coordinate systems with VBA

BJKluft
3-Visitor

Trying to get coordinate systems with VBA

Hello all,

 

I try to get the coordinate systems from a model (based on the following tutorial). However my VBA (so not VB!) script is as follows:

 

 

 

Public Function createHoleUDFInPart(ByVal placementModel As IpfcSolid, _
                                    ByVal Name01 As String, _
                                    ByVal csysName As String, _
                                    ByVal Dim1 As Double, _
                                    ByVal Dim2 As Double) _
                                    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

    IpfcCoordSystem = Nothing
'     On Error GoTo Try
        
        Set cSystems = placementModel.ListItems(EpfcModelItemType.EpfcITEM_COORD_SYS)

        For i = 0 To cSystems.Count - 1
            If (cSystems.Item(i).GetName.ToString = 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 = CCpfcUDFCustomCreateInstructions.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.
        '======================================================================
        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

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 FunctionPublic Function createHoleUDFInPart(ByVal placementModel As IpfcSolid, _
                                    ByVal Name01 As String, _
                                    ByVal csysName As String, _
                                    ByVal Dim1 As Double, _
                                    ByVal Dim2 As Double) _
                                    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

    IpfcCoordSystem = Nothing
'     On Error GoTo Try
        
        Set cSystems = placementModel.ListItems(EpfcModelItemType.EpfcITEM_COORD_SYS)

        For i = 0 To cSystems.Count - 1
            If (cSystems.Item(i).GetName.ToString = 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 = CCpfcUDFCustomCreateInstructions.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.
        '======================================================================
        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

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

 

 

 

 

However I get stuck at the following line:

Set cSystems = placementModel.ListItems(EpfcModelItemType.EpfcITEM_COORD_SYS)

It gives me a compile error (Method or data member not found), which links to the .ListItems part. I don't seem to be able to solve this.

Any ideas?

 

Kind regards,

Jeroen

1 ACCEPTED SOLUTION

Accepted Solutions
GBod
4-Participant
(To:BJKluft)

I'm trying to solve the same problem and what seem to work for me is:

Dim cUCCI As CCpfcUDFCustomCreateInstructions

Dim udfInstructions As IpfcUDFCustomCreateInstructions

Set cUCCI = New CCpfcUDFCustomCreateInstructions

Set udfInstructions = cUCCI.Create(Name01)

 

But I might have over complicated the definition.

 

View solution in original post

6 REPLIES 6

Hi,

Thanks for the reply but this is not the issue. I have the library connected and am able to connect to Creo. The issue is that I want to extract the coordinate systems from my current model (to be able to place an UDF in the end), however the script errors out on this line.

BJKluft
3-Visitor
(To:BJKluft)

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)

BJKluft
3-Visitor
(To:BJKluft)

Oke,

 

Getting to understand a bit more but still far from solved...

The following should be a function, but Excel VBA does not recognize it as such. This has something to do with the Reference itself I guess, however I'm not able to have a look into this reference.

CCpfcUDFCustomCreateInstructions

 The VBA script line should be:

Set udfInstructions = CCpfcUDFCustomCreateInstructions(Name01)

But then the error "Complie error: Sub or Function not defined".

Any help?

GBod
4-Participant
(To:BJKluft)

I'm trying to solve the same problem and what seem to work for me is:

Dim cUCCI As CCpfcUDFCustomCreateInstructions

Dim udfInstructions As IpfcUDFCustomCreateInstructions

Set cUCCI = New CCpfcUDFCustomCreateInstructions

Set udfInstructions = cUCCI.Create(Name01)

 

But I might have over complicated the definition.

 

BJKluft
3-Visitor
(To:BJKluft)

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:

BJKluft_0-1710832446145.png

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.

Top Tags