4-6 # Parameter : Part File List 프로그램 Ver 0.1

특정 폴더에 있는 Ceo 파일의 이름과 이미지, 매개 변수를 불러오는 프로그램

 

Part File List 프로그램

1 단계 : Creo 연결

 

Sub Filelist_Parameter()

    Dim asynconn As New pfcls.CCpfcAsyncConnection
    Dim conn As pfcls.IpfcAsyncConnection: Set conn = asynconn.Connect("", "", ".", 5)
    Dim session As pfcls.IpfcBaseSession: Set session = conn.session
    
    'Cells 초기화
    Range(Cells(5, "A"), Cells(Rows.Count, "A")).EntireRow.Delete
    
    '사용자가 입력하는 폴더 정의 cells
    Dim oForderName As String: oForderName = Range("D2")
    session.ChangeDirectory (oForderName)

 

특정한 cell을 초기화 하는 방법
Sheet3.Range("d2").ClearContents

---

2단계 : Part File 리스트로 만들기

 

    '사용자가 정의한 폴더의 Part들 파일 리스트로 만들기
    Dim oStringseq As Istringseq
    Set oStringseq = session.ListFiles("*.prt", EpfcFILE_LIST_LATEST, oForderName)
    Dim i As Integer
    
        For i = 0 To oStringseq.Count - 1
            Cells(i + 5, "L") = oStringseq.Item(i)
        Next i
       
    '파일 이름만 축출 하는 함수
    Call filename

 

폴더 이름 + FILE 이름으로 결합된 TEXT가  "L5" 부터 저장 된다.

---

3단계 :  파일명 + 파일 확장자

"L5" 텍스트 문자열을 편집하여, 파일 명과 파일 확장자를 표시 한다.

 

Sub filename()

    Dim rng As Integer: rng = Cells(Rows.Count, "L").End(xlUp).Row - 4
    Dim oFilename As String, oEndword As String, oCroeFileName As String
    Dim oEndpos As Integer, j As Integer, OcreoFileLength As Integer
       
    For j = 1 To rng
        oFilename = Cells(j + 4, "L")
        oEndpos = Len(oFilename) - InStrRev(oFilename, "\", -1, vbTextCompare)
        oEndword = Right(oFilename, oEndpos)
        OcreoFileLength = Len(oEndword) - InStr(oEndword, ".")
        oCroeFileName = Left(oEndword, (Len(oEndword) - OcreoFileLength + 3))
                
        Cells(j + 4, "A") = j
        Cells(j + 4, "C") = oCroeFileName
    Next j
    
    Columns("L").Delete

End Sub

---

4 단계 : 파일 OPEN, 이미지 저장, 매개변수 표시를 하기 위한 매개변수 정의 

 

 '파일 open 변수 정의
    Dim oNamerng As Integer: oNamerng = Cells(Rows.Count, "C").End(xlUp).Row - 4
    Dim ModelDescriptorCreate As New CCpfcModelDescriptor
    Dim ModelDescriptor As IpfcModelDescriptor
    Dim window As IpfcWindow
     
    '파일 매개변 변수 정의
    Dim Powner As pfcls.IpfcParameterOwner
    Dim param As IpfcBaseParameter
    Dim paramValue As IpfcParamValue
    Dim PART_NO As String, PART_NO_value As String, PART_NAME As String, PART_NAME_value As String
    Dim Model As pfcls.IpfcModel
    
    '파일 jpg 변수 정의
    Dim instructions As IpfcRasterImageExportInstructions
    Dim imageExtension As String
    Dim rasterHeight As Double, rasterWidth As Double
        rasterHeight = 5
        rasterWidth = 5
    Dim dotsPerInch As Integer, imageDepth As Integer
        dotsPerInch = EpfcDotsPerInch.EpfcRASTERDPI_200
        imageDepth = EpfcRasterDepth.EpfcRASTERDEPTH_24
      
    Dim oViewOwner As IpfcViewOwner
    Dim oIpfcView As IpfcView
    
    Dim creJPEG As New CCpfcJPEGImageExportInstructions
    Dim JPEGInstrs As IpfcJPEGImageExportInstructions
    Set JPEGInstrs = creJPEG.Create(rasterWidth, rasterHeight)
    Set instructions = JPEGInstrs
    
    'jpg 파일 붙여넣기
    Dim Osheet As Worksheet: Set Osheet = ActiveSheet
    Dim Orangeimg As Range
    Dim oImagepic As Shape

 

5단계 : 메인 프로그램 실행

매개변수 이름을 변경 할수 있다. 이미지 저장은 ISOVIEW로 저장된 뷰를 불러온다

 

For k = 1 To oNamerng
        oCroeCellName = Cells(k + 4, "C")
        Set ModelDescriptor = ModelDescriptorCreate.CreateFromFileName(oCroeCellName)
        Set window = session.OpenFile(ModelDescriptor)
        
        window.Activate
        
        Set Model = session.CurrentModel
        Set Powner = Model
        
        Set param = Powner.GetParam("PART_NO")
        If Not param Is Nothing Then
            Set paramValue = param.Value
            Cells(k + 4, "D") = paramValue.StringValue
'            Cells(k + 4, "D") = PART_NO_value
        End If
        
        Set param = Powner.GetParam("PART_NAME")
        If Not param Is Nothing Then
            Set paramValue = param.Value
            PART_NAME_value = paramValue.StringValue
            Cells(k + 4, "E") = PART_NAME_value
        End If
        
        Set oViewOwner = session.CurrentModel
        Set oIpfcView = oViewOwner.RetrieveView("isoview")
        Set JPEGInstrs = creJPEG.Create(rasterWidth, rasterHeight)
        Set instructions = JPEGInstrs
        oJpgfilename = Model.FullName & ".JPG"
            
        session.ChangeDirectory ("D:\IDT\IMAGES")
        Call window.ExportRasterImage(oJpgfilename, instructions)
        Cells(k + 4, "b").Select
        Set oImagepic = Osheet.Shapes.AddPicture("D:\IDT\IMAGES" & "\" & oJpgfilename, _
        False, True, ActiveCell.Left + 1, ActiveCell.Top + 1, ActiveCell.Width - 2, ActiveCell.Height - 2)
        
        session.ChangeDirectory (oForderName)
        window.Close
                     
   Next k

 

---

전체 소스

 

Sub Filelist_Parameter()

    Dim asynconn As New pfcls.CCpfcAsyncConnection
    Dim conn As pfcls.IpfcAsyncConnection: Set conn = asynconn.Connect("", "", ".", 5)
    Dim session As pfcls.IpfcBaseSession: Set session = conn.session
    
    'Cells 초기화
    Range(Cells(5, "A"), Cells(Rows.Count, "A")).EntireRow.Delete
    
    '사용자가 입력하는 폴더 정의 cells
    Dim oForderName As String: oForderName = Range("D2")
    session.ChangeDirectory (oForderName)
         
    '사용자가 정의한 폴더의 Part들 파일 리스트로 만들기
    Dim oStringseq As Istringseq
    Set oStringseq = session.ListFiles("*.prt", EpfcFILE_LIST_LATEST, oForderName)
    Dim i As Integer
    
        For i = 0 To oStringseq.Count - 1
            Cells(i + 5, "L") = oStringseq.Item(i)
        Next i
       
    '파일 이름만 축출 하는 함수
    Call filename
    
    
    '파일 open 변수 정의
    Dim oNamerng As Integer: oNamerng = Cells(Rows.Count, "C").End(xlUp).Row - 4
    Dim ModelDescriptorCreate As New CCpfcModelDescriptor
    Dim ModelDescriptor As IpfcModelDescriptor
    Dim window As IpfcWindow
     
    '파일 매개변 변수 정의
    Dim Powner As pfcls.IpfcParameterOwner
    Dim param As IpfcBaseParameter
    Dim paramValue As IpfcParamValue
    Dim PART_NO As String, PART_NO_value As String, PART_NAME As String, PART_NAME_value As String
    Dim Model As pfcls.IpfcModel
    
    '파일 jpg 변수 정의
    Dim instructions As IpfcRasterImageExportInstructions
    Dim imageExtension As String
    Dim rasterHeight As Double, rasterWidth As Double
        rasterHeight = 5
        rasterWidth = 5
    Dim dotsPerInch As Integer, imageDepth As Integer
        dotsPerInch = EpfcDotsPerInch.EpfcRASTERDPI_200
        imageDepth = EpfcRasterDepth.EpfcRASTERDEPTH_24
      
    Dim oViewOwner As IpfcViewOwner
    Dim oIpfcView As IpfcView
    
    Dim creJPEG As New CCpfcJPEGImageExportInstructions
    Dim JPEGInstrs As IpfcJPEGImageExportInstructions
    Set JPEGInstrs = creJPEG.Create(rasterWidth, rasterHeight)
    Set instructions = JPEGInstrs
    
    'jpg 파일 붙여넣기
    Dim Osheet As Worksheet: Set Osheet = ActiveSheet
    Dim Orangeimg As Range
    Dim oImagepic As Shape
          
    For k = 1 To oNamerng
        oCroeCellName = Cells(k + 4, "C")
        Set ModelDescriptor = ModelDescriptorCreate.CreateFromFileName(oCroeCellName)
        Set window = session.OpenFile(ModelDescriptor)
        
        window.Activate
        
        Set Model = session.CurrentModel
        Set Powner = Model
        
        Set param = Powner.GetParam("PART_NO")
        If Not param Is Nothing Then
            Set paramValue = param.Value
            Cells(k + 4, "D") = paramValue.StringValue
'            Cells(k + 4, "D") = PART_NO_value
        End If
        
        Set param = Powner.GetParam("PART_NAME")
        If Not param Is Nothing Then
            Set paramValue = param.Value
            PART_NAME_value = paramValue.StringValue
            Cells(k + 4, "E") = PART_NAME_value
        End If
        
        Set oViewOwner = session.CurrentModel
        Set oIpfcView = oViewOwner.RetrieveView("isoview")
        Set JPEGInstrs = creJPEG.Create(rasterWidth, rasterHeight)
        Set instructions = JPEGInstrs
        oJpgfilename = Model.FullName & ".JPG"
            
        session.ChangeDirectory ("D:\IDT\IMAGES")
        Call window.ExportRasterImage(oJpgfilename, instructions)
        Cells(k + 4, "b").Select
        Set oImagepic = Osheet.Shapes.AddPicture("D:\IDT\IMAGES" & "\" & oJpgfilename, _
        False, True, ActiveCell.Left + 1, ActiveCell.Top + 1, ActiveCell.Width - 2, ActiveCell.Height - 2)
        
        session.ChangeDirectory (oForderName)
        window.Close
                     
   Next k
   
'   session.ChangeDirectory (oForderName)
    
'Disconnect with Creo
    conn.Disconnect (2)
    
End Sub

 

 

Part File List 프로그램

 

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