Change Creo Model and Get Volume Values (Creo 9.0)

• Change the dimensions of a Creo model in Excel.
• Use the promised dimension name.
• Get measured volume values ​​automatically calculated in Creo. 

 

• You can develop various template programs using the code below.

▷Main Code

Option Explicit
Sub Model02()
    On Error GoTo RunError

    '// Module Name : CreoVBAStart
    Call CreoVBAStart.CreoConnt01
    
    Dim Solid As IpfcSolid
    Dim ModelItemOwner As IpfcModelItemOwner
    Dim BaseDimension As IpfcBaseDimension
    
    Dim ParameterModelitems As IpfcModelItems
    Dim ParameterOwner As IpfcParameterOwner
    Dim Parameters As IpfcParameters
    Dim BaseParameter As IpfcBaseParameter
    Dim ParamValue As IpfcParamValue
    Dim Parameter As IpfcParameter
    
        
    Set Solid = model
    Set ModelItemOwner = Solid
    
    
    '// SET Regenerate
    Dim RegenInstructions As New CCpfcRegenInstructions
    Dim Instrs As IpfcRegenInstructions
    Dim Window As pfcls.IpfcWindow
    Set Instrs = RegenInstructions.Create(False, False, Nothing)
    Set Window = BaseSession.CurrentWindow
    
    '// Dimension Name
    Dim rng As Range
    Set rng = Worksheets("RegenModel").Range("A6", Cells(Rows.Count, "A").End(xlUp))
    
    Dim i As Integer
    Dim j As Integer
    
    For j = 0 To rng.Count - 1
    
        Set BaseDimension = ModelItemOwner.GetItemByName(EpfcModelItemType.EpfcITEM_DIMENSION, Cells(j + 6, "B"))
        BaseDimension.DimValue = Cells(j + 6, "C")
        
    Next j
       
    
    '// Regenerate
    Call Solid.Regenerate(Instrs)
    Call Solid.Regenerate(Instrs)
    Window.Repaint
    
    
    Set ParameterModelitems = ModelItemOwner.ListItems(EpfcModelItemType.EpfcITEM_FEATURE)
    
    For i = 0 To ParameterModelitems.Count - 1
    
                Set ParameterOwner = ParameterModelitems.Item(i)
                Set Parameters = ParameterOwner.ListParams
                
                
                If Parameters.Count > 0 Then
                
                    Set BaseParameter = Parameters.Item(0)
                    Set ParamValue = BaseParameter.Value
                    
                    Worksheets("RegenModel").Cells(11, "C") = ParamValue.DoubleValue
                
                End If
    
    
    Next i
    
        
    MsgBox "Changed the 3D model", vbInformation, "korealionkk@gmail.com"
    
    conn.Disconnect (2)
    
    '// Cleanup
    Set asynconn = Nothing
    Set conn = Nothing
    Set BaseSession = Nothing
    Set model = Nothing
    
RunError:
            If Err.Number <> 0 Then
                MsgBox "Process Failed: An error occurred." & vbCrLf & _
                       "Error No: " & CStr(Err.Number) & vbCrLf & _
                       "Error Description: " & Err.Description & vbCrLf & _
                       "Error Source: " & Err.Source, vbCritical, "Error"
                If Not conn Is Nothing Then
                    If conn.IsRunning Then
                        conn.Disconnect (2)
                    End If
                End If
            End If

End Sub

 

modelchange01.cls

0.00MB

 

▷ Start Code

Option Explicit
Public asynconn As New pfcls.CCpfcAsyncConnection
Public conn As pfcls.IpfcAsyncConnection
Public BaseSession As pfcls.IpfcBaseSession
Public model As pfcls.IpfcModel
Public Sub CreoConnt01()
     
     '// connect creo model
     Set conn = asynconn.Connect("", "", ".", 5)
     Set BaseSession = conn.Session
     Set model = BaseSession.CurrentModel
     
    '// creo model connection check
     If model Is Nothing Then
        MsgBox "There are No Active Creo Models", vbInformation, "korealionkk@gmail.com"
        Exit Sub
     End If
          
End Sub

 

TOOLBOX_VBA-01.xlsm

0.03MB