모델의 Parameter 이름 및 타입, 값 과 엑셀 내용과 비교

1. 모델에 있는 Parameter 이름과 엑셀 파일의 Parameter 이름 비교
엑셀 VBA로 엑셀의 Parameter 이름이 모델 Parameter 이름에 있는지 비교 합니다. YES / NO로 표시

모델의 Parameter 이름	엑셀의 Parameter 이름

■ 소스 코드

Option Explicit
Sub ModelParameter()
    
  On Error GoTo RunError
  
    Dim asynconn As New pfcls.CCpfcAsyncConnection
    Dim conn As pfcls.IpfcAsyncConnection
    Dim oBaseSession As pfcls.IpfcBaseSession
    Dim oModel As pfcls.IpfcModel
     
    Set conn = asynconn.Connect("", "", ".", 5)
    Set oBaseSession = conn.session
    Set oModel = oBaseSession.CurrentModel
   
    Dim rng As Range
    Set rng = Worksheets("Sheet1").Range("A2", Cells(Rows.Count, "A").End(xlUp))

    
    'Parameter
    Dim oBaseParameter As IpfcBaseParameter
    Dim oParameterOwner As IpfcParameterOwner
    Dim oParameter As IpfcParameter
    Dim oParamValue As IpfcParamValue
    Dim oCMModelItem As New CMpfcModelItem

    Dim oModelItem As IpfcModelItem
    Dim i As Long
    Dim oCellsParameterName As String
      
    
    For i = 0 To rng.Count - 1
    
            Set oParameterOwner = oModel
            ' 엑셀의 PARAMETER 이름으로 모델의 PARAMETER 가져오기 
            Set oBaseParameter = oParameterOwner.GetParam(Cells(i + 2, "A"))
            
            If oBaseParameter Is Nothing Then
                Cells(i + 2, "B") = "NO"
            Else
                Cells(i + 2, "B") = "YES"
            End If
                    
    Next i

    'Disconnect with Creo
    conn.Disconnect (2)
    
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

■ 프로그램 실행 결과

만일 oBaseParameter 변수 값이 nothing이면 모델이 해당하는 Parameter가 없는 것 입니다.

모델에서 Parameter의 타입 (정수, 텍스트. . .)과 값을 가져 옵니다.

■ 소스 코드

Option Explicit
Sub ModelParameter()
    
  On Error GoTo RunError
  
    Dim asynconn As New pfcls.CCpfcAsyncConnection
    Dim conn As pfcls.IpfcAsyncConnection
    Dim oBaseSession As pfcls.IpfcBaseSession
    Dim oModel As pfcls.IpfcModel
     
    Set conn = asynconn.Connect("", "", ".", 5)
    Set oBaseSession = conn.session
    Set oModel = oBaseSession.CurrentModel
   
    Dim rng As Range
    Set rng = Worksheets("Sheet1").Range("A2", Cells(Rows.Count, "A").End(xlUp))

    
    'Parameter
    Dim oBaseParameter As IpfcBaseParameter
    Dim oParameterOwner As IpfcParameterOwner
    Dim oParameter As IpfcParameter
    Dim oParamValue As IpfcParamValue
    Dim oCMModelItem As New CMpfcModelItem


    Dim i As Long
    Dim oCellsParameterName As String
      
    
    For i = 0 To rng.Count - 1
    
            Set oParameterOwner = oModel
            Set oBaseParameter = oParameterOwner.GetParam(Cells(i + 2, "A"))
            
            
            If Not oBaseParameter Is Nothing Then
                 
               Cells(i + 2, "B") = "YES"
               Set oParamValue = oBaseParameter.Value

                 If oParamValue.discr = 0 Then 'If parameter is string
                    
                    Cells(i + 2, "C") = "String"
                    Cells(i + 2, "D") = oParamValue.StringValue
           
                  ElseIf oParamValue.discr = 3 Then 'if parameter is real value
                    Cells(i + 2, "C") = "Double"
                    Cells(i + 2, "D") = oParamValue.DoubleValue
                    
                  End If
                  
              Else
              
                Cells(i + 2, "B") = "NO"
                Cells(i + 2, "C") = "없음"
                Cells(i + 2, "D") = "없음"
                
              End If
    Next i


'Disconnect with Creo
    conn.Disconnect (2)
    
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

프로그램 실행 결과

■ Creo Parameter와 Excel 파일 비교 하기

1. CREO 모델의 PARAMETER 이름과 Excel PARAMETER 이름 비교 합니다.
- Excel PARAMETER 이름이 모델이 없는 경우 자동으로 추가 합니다.
2. CREO 모델의 PARAMETER 값과 Excel PARAMETER 값을 비교 합니다.
- Excel PARAMETER 값으로 CREO 모델의 PARAMETER 값으로 변경 합니다.

Creo Parameter	Excel Parameter
1. PART_NO : IDT30-1001 2. PART_NMAE : TEST 입니다. 3. MATERIAL : CU	1. PART_NO 2. PART_NAME : 이것은 브라켓 입니다 3. MATERIAL 4. MASS : 40.4

☞ 프로그램 실행 전

☞ 프로그램 실행 후

■ 소스 코드

주의 > 엑셀에 Parameter 값이 있고, CREO 파일에 Parameter 가 있으면 오류가 납니다. 새로 고침 코드에 엑셀 파일의 Parameter 이름을 검색하여, 없는 Parameter 이름을 추가 하는 코드를 작성 해야 합니다

A2 ~ A6는 표시하고자 하는 Parameter 입니다. 만일 "Size" Parameter가 모델에 저장 되어 있지 않다면. 추가 하는 기능을 만들어야 합니다. B2 ~ B6는 이해 하기 쉽게 모델의 Parameter 값을 예시로 표시하였습니다. 만일 C2 ~ C6 값 중 입력이 없는 경우 모델의 Parameter 값은 변경 되지 않습니다. 만일 동일 하다면 변경 되지 않습니다. 다르다면 엑셀 파일의 값이 모델에 저장 됩니다.

Option Explicit
Sub ParameterSave()

  On Error GoTo RunError
  
    Dim asynconn As New pfcls.CCpfcAsyncConnection
    Dim conn As pfcls.IpfcAsyncConnection
    Dim oBaseSession As pfcls.IpfcBaseSession
    Dim oModel As pfcls.IpfcModel
     
    Set conn = asynconn.Connect("", "", ".", 5)
    Set oBaseSession = conn.session
    Set oModel = oBaseSession.CurrentModel
    
    
    Dim rng As Range
    Set rng = Worksheets("Sheet1").Range("A2", Cells(Rows.Count, "A").End(xlUp))

    'Parameter
    Dim oBaseParameter As IpfcBaseParameter
    Dim oParameterOwner As IpfcParameterOwner
    Dim oParameter As IpfcParameter
    Dim oParamValue As IpfcParamValue
    Dim oCMModelItem As New CMpfcModelItem
    
    
    Dim i As Long
    Dim oParameterSting As String
    Dim oParameterDouble As Double
    
    Set oParameterOwner = oModel
     
    For i = 0 To rng.Count - 1
       
        Set oBaseParameter = oParameterOwner.GetParam(Cells(i + 2, "A"))
         
        If Len(Cells(i + 2, "c")) <> 0 Then
          
            Set oParamValue = oBaseParameter.Value
            
                If oParamValue.discr = 0 Then 'If parameter is string
                    
                    oParameterSting = oParamValue.StringValue
                    
                        If oParameterSting <> Cells(i + 2, "c") Then
                           
                           Set oParamValue = oCMModelItem.CreateStringParamValue(Cells(i + 2, "c"))
                           oBaseParameter.Value = oParamValue
                           
                        End If
                 ElseIf oParamValue.discr = 3 Then 'if parameter is Double

                        oParameterDouble = oParamValue.DoubleValue
                    
                           If oParameterDouble <> Cells(i + 2, "c") Then
                            
                           Set oParamValue = oCMModelItem.CreateDoubleParamValue(Cells(i + 2, "c"))
                           oBaseParameter.Value = oParamValue
                           
                           End If
    
                 End If
            
          End If
    
    Next i
    
    
    oModel.Save



'Disconnect with Creo
    conn.Disconnect (2)
    
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

part parameter v02.xlsm

0.03MB

저작자표시 비영리 변경금지

'VBA For Creo' 카테고리의 다른 글

UI를 이용하여 폴더 만들고, 선택 하기 (0)	2022.11.03
ToolBOX PartList 베타 (0)	2022.10.27
엑셀에서 Parameter 값 입력 -> Creo 변경 (0)	2022.10.23
작업 폴더에 있는 Drawing 파일 인쇄 ver 0.1 - PCF (0)	2022.10.13
작업 폴더에 있는 Drawing 파일 인쇄 ver0.1 - PDF 변환 (0)	2022.10.11