본문 바로가기
  • 환영 합니다 ! Welcome!
VBA For Creo

Template 프로그램 #1

by ToolBOX01 2022. 12. 8.
반응형

■ 소개

VBA 프로그램을 사용하여 자동으로 Creo 프로그램을 실행 할수 있습니다. 또한 Creo part 파일을 자동으로 open 할수 있습니다. 입력한 치수값을 모델에 대입하고, 새로운 Creo 파일 (3D, 2D)를 생성 할 수 있습니다. VBA 프로그램을 사용하여 자동으로 Creo 프로그램을 강제로 Kill 할수 있습니다.

. Template 모델을 open 하고, 엑셀 파일에 입력된 치수 값을 모델에 적용.
. Part 파일이 가지고 있는 특정 Feature를 삭제. (옵션 기능)
. 변경된 치수 값으로 새로운 모델 (3D/ 2D)만들기.

■ 엑셀 매크로 파일에서 CREO 프로그램을 실행 할수 있습니다.

Option Explicit
Sub CreoExecution()

    Dim asynconn As New pfcls.CCpfcAsyncConnection
    Dim conn As pfcls.IpfcAsyncConnection
    Set conn = asynconn.Start("C:\PTC\Creo 8.0.6.0\Parametric\bin\parametric.bat", "")
        
End Sub

엑셀 매크로 파일 화면이 껌벅거리는 현상을 제거 하려면 아래 코드를 추가 합니다

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

■ 엑셀 매크로 파일에서 CREO 프로그램을 kill 할수 있습니다.

Option Explicit
Sub CreoShotDown()

    Dim asynconn As New pfcls.CCpfcAsyncConnection
    Dim conn As pfcls.IpfcAsyncConnection
    
    conn.End

End Sub

 

▶참고 사이트

 

VBA Fundamentals #2

VBA는 계층적 구조의 개체를 사용하여 프로그램을 개발 합니다. IpfcAsyncConnection 개체를 사용하여 Creo를 실행 할 수 있습니다. Option Explicit Sub CreoExecution() Dim asynconn As New pfcls.CCpfcAsyncConnection Dim conn

tool-2020.tistory.com

 

■ 특정 폴더에 있는 Creo 파일 Open 하기

Sub TemplateFileOpen()
     
        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 oCreateModelDescriptor As New CCpfcModelDescriptor
        Dim oModelDescriptor As IpfcModelDescriptor
        Set oModelDescriptor = oCreateModelDescriptor.CreateFromFileName("template_code01.prt")
        
        Set oModel = oSession.RetrieveModel(oModelDescriptor) '//모델을 Session으로 가져오기
        oModel.display '// 모델 활성화 하기
        

               
        conn.Disconnect (2)

 

▶참고 사이트

 

IpfcBaseSession.RetrieveModel()

■Harddisk 파일 -> Session으로 가져오기 작업폴더에 있는 Creo 파일을 Creo session으로 가져 옵니다. 응용을 하면 Cell에 있는 파일 이름으로 Creo 파일을 session으로 가져 옵니다. ipfcwindow () 함수를 이용하

tool-2020.tistory.com

 

■  모델의 Dimension 값 표시 하기

모델이 가지고 있는 치수 이름을 모두 표시 합니다. 치수 값을 모두 표시 합니 

Option Explicit
Sub TemplateFileOpen()
     
        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 owindow As IpfcWindow
            
        Dim oCreateModelDescriptor As New CCpfcModelDescriptor
        Dim oModelDescriptor As IpfcModelDescriptor
        Set oModelDescriptor = oCreateModelDescriptor.CreateFromFileName("template_code01.prt")
        
        Set oModel = oSession.RetrieveModel(oModelDescriptor) '//Creo Session으로 모델불러오기
        oModel.Display
                     
         Dim oSolid As IpfcSolid: Set oSolid = oModel
         Dim oModelItemOwner As IpfcModelItemOwner: Set oModelItemOwner = oSolid
         Dim oDimensionList As IpfcModelItems: Set oDimensionList = oModelItemOwner.ListItems(EpfcITEM_DIMENSION) '//Dimension List
         
         Dim oDimValue As IpfcBaseDimension
         
         Dim i As Long
         
         For i = 0 To oDimensionList.Count - 1
         
             Cells(i + 5, "A") = oDimensionList(i).GetName '//Dimension Name
             
             Set oDimValue = oModelItemOwner.GetItemByName(EpfcModelItemType.EpfcITEM_DIMENSION, Cells(i + 5, "A"))
             
             Cells(i + 5, "B") = oDimValue.DimValue '// Dimension Value
                           
         Next i
           
        conn.Disconnect (2)
                
End Sub

▶참고 사이트

 

파일에서 Dimension 값 가져오는 프로그램

Part의 치수값 가져오기. 어셈블의 치수 값 가져오기. 아래와 같은 구조의 객체 변수들을 사용한다. 모델 ▶ 솔리드 ▶ 모델 아이뎀 ▶ Dimension 순서로 이름 및 값을 가져 올수 있다. ▶ Interface IpfcM

tool-2020.tistory.com

 


■  VBA Template 프로그램

[ 프로그램 화면 ]

  • Part 파일을 새로운 파일로 저장 합니다. 도면과 함께 저장 합니다.
  • 모델에서 치수의 이름은 반드시 "대문자"로 시작 해야 합니다. 프로그램 "Dimesion Name"과 동일 해야 합니다.
  • "Dimesion Value"는 "음수"를 대입 할수 없습니다.
  • Template 모델은 Config.pro "search_path"에 정의 되어 있어야 합니다
  • Drawing Format 파일은 Config.pro "format_dir"에 정의 되어 있어야 합니다

■ VBA 코드

Option Explicit
Sub TemplateFileOpen()

On Error GoTo RunError

         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 File Open
         
         Set conn = asynconn.Connect("", "", ".", 5)
         Dim oSession As pfcls.IpfcBaseSession: Set oSession = conn.session
         
         oSession.ChangeDirectory ("C:\PTC\WORK90")
         
         Dim oModel As IpfcModel
         Dim owindow As IpfcWindow
        
         Dim oTemplateName As String: oTemplateName = Cells(7, "D") '//Template Model Name
            
         Dim oCreateModelDescriptor As New CCpfcModelDescriptor
         Dim oModelDescriptor As IpfcModelDescriptor
         Set oModelDescriptor = oCreateModelDescriptor.CreateFromFileName(oTemplateName)
        
         Set oModel = oSession.RetrieveModel(oModelDescriptor) '//Creo Session으로 모델불러오기
         oModel.Display
         
         
         ' Current Creo Wokrfolder
         Cells(8, "D") = oSession.GetCurrentDirectory
         
                     
         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("D11", Cells(Rows.Count, "D").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
         
                           
         'conn.Disconnect (2)
         
         conn.End
        
         MsgBox "All dimension values have been displayed", vbInformation, "www.idt21c.com"
        
         '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 Model 프로그램.xlsm
0.09MB

 


 

 

 

 

 

 

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

Create Creo Parameter  (0) 2022.12.16
Template 프로그램 #2  (0) 2022.12.09
의뢰] Part List 프로그램 Customizing A02  (2) 2022.12.07
도면 자동 생성 기능  (0) 2022.11.30
의뢰] Part List 프로그램 변형 A01  (0) 2022.11.25