Create Creo Parameter

VBA로 모델에 Parameter 만들기
Sting 타입의 Parameter를 만듭니다. Parameter 이름은 "E7 ~ E10"까지 입니다. 기본 값은 "IDT" 입니다.

[ Parameter Name

1. 새로운 Parameter를 생성 하는 코드

    - 이름이 동일한 Parameter가 모델에 있으면 오류가 발생 합니다
    - String 타입으로만 생성 됩니다

Option Explicit
Sub CreateParameter()

On Error GoTo RunError

        Dim asynconn As New pfcls.CCpfcAsyncConnection
        Dim conn As pfcls.IpfcAsyncConnection: Set conn = asynconn.Connect("", "", ".", 5)
        Dim oSession As pfcls.IpfcBaseSession: Set oSession = conn.session
        Dim oModel As IpfcModel: Set oModel = oSession.CurrentModel
        Dim oSolid As IpfcSolid: Set oSolid = oModel
           
        '// Model Information Display
        Range("D3") = oModel.Filename
        
        '// Parameter 변수 정의
        Dim oParamOwner As pfcls.IpfcParameterOwner: Set oParamOwner = oModel
        Dim oParameter  As IpfcParameter
        Dim oParamObject As New CMpfcModelItem
        Dim oParamValue As New CpfcParamValue
        '// Dim oCreoParamValue As IpfcParamValue
        
        '// Parameter Name Cell 
        Dim i As Long
        For i = 0 To 3
                Set oParamValue = oParamObject.CreateStringParamValue("IDT")
                Set oParameter = oParamOwner.CreateParam(Cells(i + 7, "E"), oParamValue)
        Next i
     
 conn.Disconnect (2)
    
    'Cleanup
    Set asynconn = Nothing
    Set conn = Nothing
    Set oSession = Nothing
    Set oModel = Nothing

Exit Sub
    
RunError:
    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 conn Is Nothing Then
            If conn.IsRunning Then
                conn.Disconnect (2)
            End If
        End If
    End If

End Sub

 

 

2. 타입을 선택 하여, 새로운 Parameter를 생성 하는 코드

 - 이름이 동일한 Parameter가 모델에 있으면 오류가 발생 합니다

Option Explicit
Sub CreateParameter()

On Error GoTo RunError

        Dim asynconn As New pfcls.CCpfcAsyncConnection
        Dim conn As pfcls.IpfcAsyncConnection: Set conn = asynconn.Connect("", "", ".", 5)
        Dim oSession As pfcls.IpfcBaseSession: Set oSession = conn.session
        Dim oModel As IpfcModel: Set oModel = oSession.CurrentModel
        Dim oSolid As IpfcSolid: Set oSolid = oModel
           
        '// Model Information Display
        Range("D3") = oModel.Filename
        
        '// Parameter 변수 정의
        Dim oParamOwner As pfcls.IpfcParameterOwner: Set oParamOwner = oModel
        Dim oParameter  As IpfcParameter
        Dim oParamObject As New CMpfcModelItem
        Dim oCreoParamValue As IpfcParamValue
        Dim oParamValue As New CpfcParamValue
               
        Dim i As Long
        For i = 0 To 3
                
                If Cells(i + 7, "F") = "STRING" Then                    
                    Set oParamValue = oParamObject.CreateStringParamValue("IDT")    
                ElseIf Cells(i + 7, "F") = "Real Number" Then              
                     Set oParamValue = oParamObject.CreateDoubleParamValue(0)  
                ElseIf Cells(i + 7, "F") = "Yes NO" Then              
                     Set oParamValue = oParamObject.CreateBoolParamValue(True)                    
                Else              
                     Set oParamValue = oParamObject.CreateIntParamValue(0)     
                End If   
             Set oParameter = oParamOwner.CreateParam(Cells(i + 7, "E"), oParamValue)
        Next i
     
 conn.Disconnect (2)
    
    'Cleanup
    Set asynconn = Nothing
    Set conn = Nothing
    Set oSession = Nothing
    Set oModel = Nothing

Exit Sub
    
RunError:
    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 conn Is Nothing Then
            If conn.IsRunning Then
                conn.Disconnect (2)
            End If
        End If
    End If

End Sub

 

3. 모델에 동일한 Parameter 이름이 있는 경우 체크

     - 동일한 Parameter 이름이 없으면 cell에 있는 Parameter 들을 모델에 생성 합니다. 기본값을 제공 합니다.
     - 동일한 Parameter 이름이 있으면 값을 표시합니다.
     - 사용자가 Parameter 추가, 삭제 할수 있습니다.  Parameter 이름을 변경 할수 있습니다.
     - 반드시 Parameter 타입은 입력 해야 합니다.

Option Explicit
Sub Modelopen()

On Error GoTo RunError

        Dim asynconn As New pfcls.CCpfcAsyncConnection
        Dim conn As pfcls.IpfcAsyncConnection: Set conn = asynconn.Connect("", "", ".", 5)
        Dim oSession As pfcls.IpfcBaseSession: Set oSession = conn.session
        Dim oModel As IpfcModel: Set oModel = oSession.CurrentModel
        Dim oSolid As IpfcSolid: Set oSolid = oModel
        
        
        '// Model Information Display
        
        Range("D3") = oModel.Filename
        Range("D4") = oSession.GetCurrentDirectory
        Range("D5") = Date
             
        
        '// Model Parameter Display
        
        Dim rng As Range
        Set rng = Range("E11", Cells(Rows.Count, "E").End(xlUp))
             
        Dim oBaseParameter As pfcls.IpfcBaseParameter
        Dim oParameterOwner As IpfcParameterOwner: Set oParameterOwner = oModel
        Dim oParameter As IpfcParameter
        Dim oParamValue As IpfcParamValue
        Dim oCMModelItem As New CMpfcModelItem
    
        Dim oModelItem As IpfcModelItem
        Dim oCellsParameterName, oCellsParameterType As String
              
        Dim i As Long

        
        For i = 0 To rng.Count - 1
    
            Set oBaseParameter = oParameterOwner.GetParam(Cells(i + 11, "E")) '// 엑셀의 PARAMETER 이름으로 모델의 PARAMETER 가져오기
            
            oCellsParameterType = Cells(i + 11, "F") '// 엑셀에서 PARAMETER 타입 가져오기
            
            If oBaseParameter Is Nothing Then
               
               If oCellsParameterType = "String" Then
                       Set oParamValue = oCMModelItem.CreateStringParamValue("IDT")

                ElseIf oCellsParameterType = "Real Number" Then
                       Set oParamValue = oCMModelItem.CreateDoubleParamValue(0)
               
                ElseIf oCellsParameterType = "Yes No" Then
                       Set oParamValue = oCMModelItem.CreateBoolParamValue(True)
                
                Else
                       Set oParamValue = oCMModelItem.CreateIntParamValue(0)

                End If
                 Set oBaseParameter = oParameterOwner.CreateParam(Cells(i + 11, "E"), oParamValue)
                  
            Else
            
              Set oParamValue = oBaseParameter.Value
            
              If oParamValue.discr = 0 Then
                  Cells(i + 11, "G") = oParamValue.StringValue
              
               ElseIf oParamValue.discr = 3 Then
                  Cells(i + 11, "G") = oParamValue.DoubleValue
                  
               ElseIf oParamValue.discr = "2" Then
                  Cells(i + 11, "G") = oParamValue.BoolValue
                   
               Else
                   Cells(i + 11, "G") = oParamValue.IntValue
              
               End If
               
            End If
                    
    Next i
                
       conn.Disconnect (2)
    
    'Cleanup
    Set asynconn = Nothing
    Set conn = Nothing
    Set oSession = Nothing
    Set oModel = Nothing

Exit Sub
    
RunError:
    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 conn Is Nothing Then
            If conn.IsRunning Then
                conn.Disconnect (2)
            End If
        End If
    End If

End Sub

 

 

by lionkk@idt21c.com

---