Creo File Copy & Retrieve

UI를 통해 CREO 파일을 선택하고, Session으로 파일을 읽어 드립니다. Creo 파일 이름은 엑셀에 표시됩니다, 
파일 타입은 "part"만 가능 합니다. 수동으로 새로운 part 파일 이름을 입력 합니다. 새로운 파일 이름으로 복사 됩니다.
Copy CREO File Name의 이름은 ".prt" 확장자를 붙여야 합니다. 만일 폴더에 동일한 파일명이 존재 하면 오류가
발생 합니다. 

 

 

프로그램 실행

 

프로그램 소스 코드

 

Sub creo_open()

        Dim asynconn As New pfcls.CCpfcAsyncConnection
        Dim conn As pfcls.IpfcAsyncConnection
        Dim oSession As IpfcSession
    
 On Error GoTo RunError
    
        Set conn = asynconn.Connect("", "", ".", 5)
        Set oSession = conn.session
    

        Dim oCreateFileOpen As New CCpfcFileOpenOptions
        Dim oFileOpenOptions As IpfcFileOpenOptions
        Set oFileOpenOptions = oCreateFileOpen.Create("*.prt")
        
        Dim oOpenBox As String
        oOpenBox = oSession.UIOpenFile(oFileOpenOptions)
 
 
        Dim oEndpos As String
        Dim oEndword As String
        Dim oCroeFileName As String
        Dim OcreoFileLength As Integer

        oEndpos = Len(oOpenBox) - InStrRev(oOpenBox, "\", -1, vbTextCompare)
        oEndword = Right(oOpenBox, oEndpos)
        OcreoFileLength = Len(oEndword) - InStr(oEndword, ".")
        oCroeFileName = Left(oEndword, (Len(oEndword) - OcreoFileLength + 3))
        
        Cells(4, "d") = oCroeFileName

        Dim ModelDescriptorCreate As New CCpfcModelDescriptor
        Dim ModelDescriptor As IpfcModelDescriptor
        Set ModelDescriptor = ModelDescriptorCreate.Create(EpfcModelType.EpfcMDL_PART, oCroeFileName, "")


        Dim session As IpfcBaseSession
        Set session = conn.session
        Dim window As IpfcWindow
        Set window = session.OpenFile(ModelDescriptor)

        window.Activate

    conn.Disconnect (2)
    
    'Cleanup
    Set asynconn = Nothing
    Set conn = Nothing
    Set session = Nothing
    Set model = 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

Sub creo_copy()

        Dim asynconn As New pfcls.CCpfcAsyncConnection
        Dim conn As pfcls.IpfcAsyncConnection
        Dim session As pfcls.IpfcBaseSession
    
    On Error GoTo RunError
        Set conn = asynconn.Connect("", "", ".", 5)
        Set session = conn.session
    
        Dim model As IpfcModel
        Set model = session.CurrentModel

        Dim cModelName As String
        cModelName = Cells(8, "d")
    
        Call model.Copy(cModelName, Null)

        Dim ModelDescriptorCreate As New CCpfcModelDescriptor
        Dim ModelDescriptor As IpfcModelDescriptor
        Set ModelDescriptor = ModelDescriptorCreate.Create(EpfcModelType.EpfcMDL_PART, cModelName, "")


        Dim oWindow As pfcls.IpfcWindow
        Set oWindow = session.OpenFile(ModelDescriptor)
        oWindow.Close
        oWindow.Activate


        conn.Disconnect (2)
        
        'Cleanup
        Set asynconn = Nothing
        Set conn = Nothing
        Set session = Nothing
        Set model = 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

 

 

CREO VBA 프로그램 파일

 

SAVE AND COPY.xlsm

0.03MB

 

 

IpfcModel 클래의 .Copy() 메소드는 기존 Creo 파일을 ▶ 새로운 파일로 저장하고, Session 까지 읽어 온다.

Creo 메인 화면에는 표시 되지 않는다.  IpfcWindow 클래스를 사용하여  Creo 메인 화면에는 표시 한다.

만일 동일한 파일 이름이 폴거에 존재 한다면, 오류가 발생 한다.

PART 파일 이름과 동일한 Drawing 파일이 있으면 Drawing 파이도 복사 된다. 단 config.pro 파일 환경을 변경 해야

한다. 어셈블 파일은 어셈블을 구성 하는 파일들은 Copy 되지 않는다. 어셈블 파일만 Copy 된다

 

 

비즈니스 문의 : lionkk@idt21c.com

---