Template 프로그램 #2

■ 새로운 파일 이름으로 저장 하기

1. Backup 코드

Template 파일은 3D 이름과 동일한 2D 파일로 구성 되어야 하고, Search_path로 정의되어 있어야 합니다.

또한 설계자가 입력한 Work Folder에 저장 합니다. Template Drawing 파일을 Open 합니다. Template Drawing 파일을 BackUP 합니다. 자동으로 3D Template 파일은 BACKUP 합니다.

 '//
 '// Creo Model Backup (3D , 2D )
 '//
        Dim oTemplateDrawingName As String
        oTemplateDrawingName = Replace(Cells(7, "D"), ".prt", ".drw")
       
       Dim oCreateModelDescriptor As New CCpfcModelDescriptor
       Dim oTempDrw, oBackupDrw As IpfcModelDescriptor
       Set oTempDrw = oCreateModelDescriptor.CreateFromFileName(oTemplateDrawingName)
                
       Set oModel = oSession.RetrieveModel(oTempDrw) '//Session으로 Template Drawing 불러오기
                 
       oModel.Display '//Template Drawing 파일 불러오기
                 
       Set oBackupDrw = oCreateModelDescriptor.CreateFromFileName(oModel.Filename) '//Template Drawing 파일 Backup 파일 선택
                 
       Dim oPathName As String: oPathName = Cells(8, "D") & "\"  ' // 파일이 저장될 폴더 정의
       oBackupDrw.Path = oPathName
        
       Call oModel.Backup(oBackupDrw) '//파일 backup
                 
       oModel.EraseWithDependencies '// 파일

2. New Name 코드

"Target Work Folder"에 저장되어 있는 2D/ 3D를 Session으로 불러 옵니다. 반드시 3D 먼저 Rename 합니다.

2D를 Rename를 한후 반드시 "Save" 코드를 추가 합니다

'//
'//  Creo Model Rename (3D , 2D )
'//
                
       oSession.ChangeDirectory (Cells(8, "D") & "\") '//Creo Work Folder               
                
       Dim oOpenPartName As IpfcModelDescriptor
       Set oOpenPartName = oCreateModelDescriptor.CreateFromFileName(Cells(7, "D"))
       Dim oPartmodel As IpfcModel
       Set oPartmodel = oSession.RetrieveModel(oOpenPartName) '//Session으로 part 불러오기
                
           '//
           '//  Creo Drawing Rename
           '//
                     
                 Set oModel = oSession.RetrieveModel(oTempDrw) '//Session으로 Drawing 불러오기
                 oModel.Display '//Template Drawing 파일 활성화
                             
                 Dim oDraingRename As String
                 oDraingRename = Replace(Cells(9, "D"), ".prt", ".drw")
                 
                 Call oPartmodel.Rename(Cells(9, "D"), False) '// Part File Rename
                 Call oModel.Rename(oDraingRename, False) '// Drawing File Rename
                 oModel.Save
              
                oModel.EraseWithDependencies '// 파일들 Session에서 지우기

3. 전체 코드

- Template 모델 (3D / 2D)을 Rename를 하고, Rename한 모델의 치수 값을 표시 합니다.

Option Explicit
Sub TemplateFileOpen02()

On Error GoTo RunError

Application.ScreenUpdating = False '화면 업데이트 일시 정지

     
         Dim asynconn As New pfcls.CCpfcAsyncConnection
         Dim conn As pfcls.IpfcAsyncConnection
         Set conn = asynconn.Start("C:\PTC\Creo 9.0.2.0\Parametric\bin\parametric.bat", "") '//Creo Auto
         
         Set conn = asynconn.Connect("", "", ".", 5)
         Dim oSession As pfcls.IpfcBaseSession: Set oSession = conn.session
         oSession.ChangeDirectory ("C:\PTC\WORK90") '//Creo Work Folder
                
                
         Dim oModel As IpfcModel

        
          Dim oTemplateDrawingName As String
         oTemplateDrawingName = Replace(Cells(7, "D"), ".prt", ".drw")
         
         '//
         '// Creo Model Backup (3D , 2D )
         '//
         
                 Dim oCreateModelDescriptor As New CCpfcModelDescriptor
                 Dim oTempDrw, oBackupDrw As IpfcModelDescriptor
                 Set oTempDrw = oCreateModelDescriptor.CreateFromFileName(oTemplateDrawingName)
                
                 Set oModel = oSession.RetrieveModel(oTempDrw) '//Session으로 Template Drawing 불러오기
                 
                 oModel.Display '//Template Drawing 파일 불러오기
                 
                 Set oBackupDrw = oCreateModelDescriptor.CreateFromFileName(oModel.Filename) '//Template Drawing 파일 Backup 파일 선택
                 
                 Dim oPathName As String: oPathName = Cells(8, "D") & "\"  ' // 파일이 저장될 폴더 정의
                 oBackupDrw.Path = oPathName
        
                 Call oModel.Backup(oBackupDrw) '//파일 backup
                 
                 oModel.EraseWithDependencies '// 파일
         
         '//
         '//  Creo Model Rename (3D , 2D )
         '//
                
                oSession.ChangeDirectory (Cells(8, "D") & "\") '//Creo Work Folder
                
                
                Dim oOpenPartName As IpfcModelDescriptor
                Set oOpenPartName = oCreateModelDescriptor.CreateFromFileName(Cells(7, "D"))
                Dim oPartmodel As IpfcModel
                Set oPartmodel = oSession.RetrieveModel(oOpenPartName) '//Session으로 part 불러오기
                
                     '//
                     '//  Creo Drawing Rename
                     '//
                     
                     Set oModel = oSession.RetrieveModel(oTempDrw) '//Session으로 Drawing 불러오기
                     oModel.Display '//Template Drawing 파일 활성화
                             
                     Dim oDraingRename As String
                     oDraingRename = Replace(Cells(9, "D"), ".prt", ".drw")
                    
                     Call oModel.Rename(oDraingRename, False) '// Drawing File Rename
                     
                     '//
                     '//  Creo Drawing Rename
                     '//
  
                
                oPartmodel.Display   '// Part 활성화
                
                
                 '//
                 '//  Dimension Value Display
                 '//
                
                
                 Dim oSolid As IpfcSolid: Set oSolid = oPartmodel
                 Dim oModelItemOwner As IpfcModelItemOwner: Set oModelItemOwner = oSolid
                 Dim oDimValue As IpfcBaseDimension
         
         
                 ' Dimension Name List Count
                 Dim rng As Range
                 Set rng = Range("E11", Cells(Rows.Count, "E").End(xlUp))
                 Dim i As Long
         
                 For i = 0 To rng.Count - 1
                 
                    Set oDimValue = oModelItemOwner.GetItemByName(EpfcModelItemType.EpfcITEM_DIMENSION, Cells(i + 11, "E"))
             
                    Cells(i + 11, "F") = oDimValue.DimValue
                                        
                 Next i
                

                
                Call oPartmodel.Rename(Cells(9, "D"), False)
                                
                oModel.EraseWithDependencies '// 파일
                           
                   
         MsgBox "새로운 파일을 생성 하였습니다", vbInformation, "www.idt21c.com"
                   
                                     
         conn.Disconnect (2)

        
         'Cleanup
         Set asynconn = Nothing
         Set conn = Nothing
         Set oSession = Nothing
         Set oModel = Nothing
        
                
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

■ 치수값 변경 하기

 '//
 '//  Dimension Value Display
 '//
                             
        Dim oSolid As IpfcSolid: Set oSolid = oPartmodel
        Dim oModelItemOwner As IpfcModelItemOwner: Set oModelItemOwner = oSolid
        Dim oDimValue As IpfcBaseDimension
        
        ' // Dimension Name List Count
               Dim rng As Range
               Set rng = Range("E11", Cells(Rows.Count, "E").End(xlUp))
               Dim i As Long
         
               For i = 0 To rng.Count - 1
                   Set oDimValue = oModelItemOwner.GetItemByName(EpfcModelItemType.EpfcITEM_DIMENSION, Cells(i + 11, "E"))
                   Cells(i + 11, "F") = oDimValue.DimValue
               Next i

■ 치수 값 변경 하기

cell에 있는 치수 이름의 값을 변경 합니다

Option Explicit
Sub Dimension_Value02()

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

        Dim oPartFileName As String: oPartFileName = Cells(9, "D")
        Dim oCreateModelDescriptor As New CCpfcModelDescriptor
        Dim oPartFileOpen As IpfcModelDescriptor
        Set oPartFileOpen = oCreateModelDescriptor.CreateFromFileName(oPartFileName)
        Set oModel = oSession.RetrieveModel(oPartFileOpen) '//Session으로 Template Drawing 불러오기
             
        Dim oSolid As IpfcSolid: Set oSolid = oModel
        Dim oModelItemOwner As IpfcModelItemOwner: Set oModelItemOwner = oSolid
        Dim oDimValue As IpfcBaseDimension
         
         
           ' // Dimension Name List Count
                 
                 Dim rng As Range
                 Set rng = Range("E11", Cells(Rows.Count, "E").End(xlUp))
                 Dim i As Long
         
                 For i = 0 To rng.Count - 1
                 
                    Set oDimValue = oModelItemOwner.GetItemByName(EpfcModelItemType.EpfcITEM_DIMENSION, Cells(i + 11, "E"))
                    oDimValue.DimValue = Cells(i + 11, "F")
                                        
                 Next i
         
         
        '// SET Regenerate
        
            Dim RegenInstructions As New CCpfcRegenInstructions
            Dim oInstrs As IpfcRegenInstructions

            Set oInstrs = RegenInstructions.Create(False, False, Nothing)
 

        '// Regenerate 실행

            Call oSolid.Regenerate(oInstrs)
            Call oSolid.Regenerate(oInstrs)
               
        MsgBox "모델이 변경 되었습니다", vbInformation, "www.idt21c.com"
      
        conn.Disconnect (2)
    
        'Cleanup
        Set asynconn = Nothing
        Set conn = Nothing
        Set oSession = Nothing
        Set oModel = Nothing
    

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

■ 프로그램 실행 결과

Template	New Model

Template 모델을 이용하여 새로운 모델을 만들수 있습니다. 제품 카탈로그에 치수값을 입력 하면, 자동으로 Creo가 실행 되고 정의된 값으로 새로운 모델 및 도면을 생성 할수 있습니다. BOM 문서도 자동으로 생성 할 수 있습니다.

설계자는 자동으로 변경 가능한 모델을 만들고. 치수 이름을 넣으면 VBA 프로그램으로 자동으로 모델 생성이 가능 합니다.

VBA 프로그램을 사용하여 어셈블의 모든 도면을 Backup 하고 (동일한 이름의 3D는 자동으로 Backup 됩니다) > Total 어셈블을 Backup 합니다.> 사용자가 입력한 tag로 파일 이름을 재 설정 합니다 > 입력된 치수 값으로 모델을 변경 합니다.

Rename 된 모델 변경은 Skeleton 또는 사용자가 선택한 모델의 치수 값을 변경 합니다. Creo를 사용을 하는 곳에 따라 다양한 방법으로 적용 될수 있을것 입니다.

VBA 엑셀은 CELL이라는 최소 단위를 갖고 있습니다. CELL에 어떤 값을 넣을건지 약속만 있으면, CREO 모델을 변경 할수 있습니다. Creo를 사용하는 설계자는 꼭 VBA 엑셀을 사용해 보십시요. 새로운 세계를 열수 있습니다

Template 모델과 VBA 엑셀을 결합 하고, 아래 표와 같은 것이 있다면 수백, 수천개의 CREO 3D 및 2D 파일을 한번의
명령으로 만들수 있습니다.

■ 동영상

TEST MODEL (CREO 9.0)

template_code01.drw.2

0.11MB

template_code01.prt.5

0.16MB

ToolBOX VBA

Template Model 02.xlsm

0.10MB

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

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

Regenerate 코드 (0)	2022.12.18
Create Creo Parameter (0)	2022.12.16
Template 프로그램 #1 (0)	2022.12.08
의뢰] Part List 프로그램 Customizing A02 (2)	2022.12.07
도면 자동 생성 기능 (0)	2022.11.30