Creo 9.0) 모델 치수 수정 하기

□ 소개

Open된 Creo 모델에서 치수 값을 가져옵니다. 치수 이름은 아래와 같이 정의 하였습니다.

1. DIM01
2. DIM02
3. DIM03

엑셀 에서 치수 값을 입력 하면. Creo 모델은 자동 변경 됩니다. Drawing 파일이 있으면 자동 변경 됩니다.
주) 치수 이름은 반드시 대문자를 사용 합니다. (소문자 사용도 가능 합니다)

□ Creo 모델 파일

[Dimension Name]

 

template_mpdel01.prt.1

0.14MB

 

□ 엑셀 프로그램 파일

가져오기 버튼  :
1) 현재 작업 폴더를 표시 합니다.
2) 활성화된 모델의 이름을 표시합니다
3) 엑셀에 정의된 이름과 동일한 모델의 치수 이름의 값을 표합니다

내보내기 버튼 :
1) 입력된 치수값으로 모델을 변경 합니다.

01TOOLBOX_VBA.xlsm

0.04MB

 

□ 코드 1 

엑셀에서 정의한 이름의 모델의 치수 값 가져오기

Option Explicit
Sub TMPLATE01()
    On Error GoTo RunError
    
    Application.EnableEvents = False
    
    '// Check if "Program03" worksheet exists
    If Not WorksheetExists("Program07") Then
        MsgBox "Worksheet 'Program07' not found.", vbExclamation, "Error"
        Exit Sub
    End If
    
    Dim asynconn As New pfcls.CCpfcAsyncConnection
    Dim conn As pfcls.IpfcAsyncConnection
     
    '// Check Creo Connect
    Set conn = asynconn.Connect("", "", ".", 5)
    
    If conn Is Nothing Then
        MsgBox "An error occurred while starting a new Creo Parametric Session", vbInformation, "www.idt21c.com"
        Exit Sub
    End If
    
    
    Dim BaseSession As pfcls.IpfcBaseSession
    Dim Session As IpfcSession
    Dim model As pfcls.IpfcModel
     
    '// Current Model Information
    Set BaseSession = conn.Session
    Set model = BaseSession.CurrentModel

    Worksheets("Program07").Cells(2, "D") = BaseSession.GetCurrentDirectory
    Worksheets("Program07").Cells(3, "D") = model.filename
    
    Dim Modelowner As IpfcModelItemOwner
    Dim modelitems As IpfcModelItems
    Dim BaseDimension As IpfcBaseDimension
    
    Set Modelowner = model
    Set modelitems = Modelowner.ListItems(EpfcModelItemType.EpfcITEM_DIMENSION)
    
    Dim i As Long
    Dim j As Long
    
    Dim rng As Range
    Set rng = Worksheets("Program07").Range("B6", Cells(Rows.Count, "B").End(xlUp))
    
    For i = 0 To modelitems.Count - 1
        Set BaseDimension = modelitems(i)
  
            For j = 0 To rng.Rows.Count - 1
                If Cells(j + 6, "B") = BaseDimension.Symbol Then
                
                        Cells(j + 6, "C") = BaseDimension.DimValue
                End If
            Next j
    Next i
    
  
    conn.Disconnect (2)
    
    ' Cleanup
    Set asynconn = Nothing
    Set conn = Nothing
    Set BaseSession = Nothing
    Set model = Nothing
    
Exit Sub

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

Function WorksheetExists(shtName As String) As Boolean
    On Error Resume Next
    WorksheetExists = Not Worksheets(shtName) Is Nothing
    On Error GoTo 0
End Function

 

□ 코드 2

입력된 치수 값으로 모델을 변경 하기

Sub DIM_REGEN01()
 On Error GoTo RunError
    
    Application.EnableEvents = False
    
    '// Check if "Program03" worksheet exists
    If Not WorksheetExists("Program07") Then
        MsgBox "Worksheet 'Program07' not found.", vbExclamation, "Error"
        Exit Sub
    End If
    
    Dim asynconn As New pfcls.CCpfcAsyncConnection
    Dim conn As pfcls.IpfcAsyncConnection
     
    '// Check Creo Connect
    Set conn = asynconn.Connect("", "", ".", 5)
    
    If conn Is Nothing Then
        MsgBox "An error occurred while starting a new Creo Parametric Session", vbInformation, "www.idt21c.com"
        Exit Sub
    End If
    
    
    Dim BaseSession As pfcls.IpfcBaseSession
    Dim Session As IpfcSession
    Dim model As pfcls.IpfcModel
    Dim Solid As IpfcSolid
    Dim ModelItemOwner As IpfcModelItemOwner
    
    '// Current Model Information
    Set BaseSession = conn.Session
    Set model = BaseSession.CurrentModel
    Set Solid = model
    Set ModelItemOwner = Solid
    
    '// Dimension Name
    Dim rng As Range
    Set rng = Worksheets("Program07").Range("B6", Cells(Rows.Count, "B").End(xlUp))
    
    '// SET Regenerate
    Dim RegenInstructions As New CCpfcRegenInstructions
    Dim Instrs As IpfcRegenInstructions
    Set Instrs = RegenInstructions.Create(False, False, Nothing)
        
    Dim BaseDimension As IpfcBaseDimension
    Dim j As Long
    
    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
    Dim Window As pfcls.IpfcWindow
    Set Window = BaseSession.CurrentWindow
     
    Window.Repaint
     
 conn.Disconnect (2)
    
    ' Cleanup
    Set asynconn = Nothing
    Set conn = Nothing
    Set BaseSession = Nothing
    Set model = Nothing
    
Exit Sub

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

 

사전에 정의된 모델의 치수 이름의 값을 가져 옵니다. 엑셀에서 치수 값을 변경 하면, 모델의 치수 값은 변경 됩니다.
위 코드를 이용하여 다양한 Template 모델이 사용 가능 합니다.  옵션 선택에 의해 치수 값을 반영 할수 있습니다.

사람의 개입 없이 자동으로 치수 값을 대입하여, 모델의 변경된 매개변수 값들을 가져올수 있습니다.    

---

영업문의 : lionkk@idt21c.com
카카오 채널 : http://pf.kakao.com/_fItAxb