Get dimension name and value of specific feature

I want to create a code to get the dimension name and value contained in a Feature with a specific name.

▷ Code to connect Creo models

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 CreoConnt02()
    On Error GoTo ErrorHandler '// Setting up an error handler
    
        '// Creo 연결 설정
        Set conn = asynconn.Connect(Null, Null, Null, Null)
    
        '// Creo Connection Settings
    On Error Resume Next '// Keep code execution going even when an exception occurs
        Set BaseSession = conn.Session
        If Err.Number <> 0 Then
            MsgBox "Failed to import Creo session. Check your connection status." & vbCrLf & _
                   "Error message: " & Err.Description, vbCritical, "error"
            Err.Clear
            Exit Sub
        End If
      
        '// Get current model
        Set model = BaseSession.CurrentModel
        If model Is Nothing Then
            MsgBox "There are currently no active Creo models", vbInformation, "alarm"
            Exit Sub
        End If
        '// MsgBox "Creo connection and model verification complete", vbInformation, "success"

ErrorHandler:
   ' ToolkitNotFound Special handling of error messages
    If InStr(Err.Description, "XToolkitNotFound") > 0 Then
        MsgBox "Make sure Creo is running.", vbCritical, "error"
        Exit Sub
    End If
End Sub

 

▷ Code : Get the dimension name and value of a feature

The feature name is "KOREA". Please enter it in capital letters. You can change the name in the code.

• You can get Feature objects with "IpfcModelItem".
• You can get Dimension objects with "IpfcFeature"

Option Explicit
Sub FeatureDimesnions()

 On Error GoTo RunError
    Application.EnableEvents = False

    '// Module Name : CreoVBAStart
    Call CreoVBAStart02.CreoConnt02
    
    Dim ModelItemOwner As IpfcModelItemOwner
    Dim ModelItem As IpfcModelItem
    Dim Feature As IpfcFeature
    Dim FeatureName01 As String: FeatureName01 = "korea"
    Dim ModelItems As IpfcModelItems
    Dim BaseDimension As IpfcBaseDimension
    Dim i As Integer
    
    Set ModelItemOwner = model
    Set ModelItem = ModelItemOwner.GetItemByName(EpfcModelItemType.EpfcITEM_FEATURE, FeatureName01)
    Set Feature = ModelItem
    Set ModelItems = Feature.ListSubItems(EpfcModelItemType.EpfcITEM_DIMENSION)
    
    For i = 0 To ModelItems.Count - 1
    
         Set BaseDimension = ModelItems.Item(i)
         Debug.Print BaseDimension.Symbol
         Debug.Print BaseDimension.DimValue
    
    Next i
    
MsgBox "I brought all the Dimension names.", 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

Creo	VBA execution results

by korealionkk@gmail.com

---