File List Beta 0.2 - 작업 공간의 Part 파일 표시

작업공간의 모든 "PART" 파일을 읽고 번호, 이미지, 파일 이름 , 품번 표시 하기- 주의 사항 품번은 매개 변수 "PART_NO" 스트링 타입으로 만들어져 있어야 합니다. 만일 없다면, 오류가 발생 합니다.

 

코드 1.

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
    
    Range(Cells(5, "A"), Cells(Rows.Count, "A")).EntireRow.Delete

 

A5 부터 대각선 방향으로 모든 쉘의 내용을 삭제 하는 명령을 맨 아래 줄에 추가 했습니다. 데이터를 초기화 하는
명령입니다.

코드 2.

Dim oForderName As String
    oForderName = Range("D2")
    session.ChangeDirectory (oForderName)
         
    Dim oStringseq As Istringseq
    Set oStringseq = session.ListFiles("*.prt", EpfcFILE_LIST_LATEST, oForderName)

 

코드 3.

    For i = 0 To oStringseq.Count - 1
        Cells(i + 5, "L") = oStringseq.Item(i)
    Next i

 

Range "L5" 아래로 폴더 이름과 및 파일 이름이 표시 된다.  " D:\ElectricMotor-models\13833001.prt.3"

코드 4.

Sub filename()

    Dim rng As Integer
    rng = Cells(Rows.Count, "L").End(xlUp).Row - 4
    
    Dim oFilename As String
    Dim oEndword As String
    Dim oEndpos As Integer
       
    For i = 1 To rng
        oFilename = Cells(i + 4, "L")
        oEndpos = Len(oFilename) - InStrRev(oFilename, "\", -1, vbTextCompare)
        oEndword = Right(oFilename, oEndpos)
        Cells(i + 4, "A") = i
        Cells(i + 4, "C") = oEndword

    Next i

 

Creo 파일 이름을 표시합니다. "*******.prt.3" 형식으로 표시 합니다. 

 

코드 5.

 For k = 1 To oNamerng
        oCroeCellName = Cells(k + 4, "C")
        OcreoFileLength = Len(oCroeCellName) - InStr(oCroeCellName, ".")
        oCroeFileName = Left(oCroeCellName, (Len(oCroeCellName) - OcreoFileLength + 3))  
 Next k

 

Creo 파일 이름을 표시합니다. "*******.prt" 형식으로 표시 합니다.  버전 관리 확장자를 제거 해야 하는 이유는
프로그램으로 모델을 Open 해야 하기 때문 입니다.

 

코드 6

For k = 1 To oNamerng
        oCroeCellName = Cells(k + 4, "C")
        OcreoFileLength = Len(oCroeCellName) - InStr(oCroeCellName, ".")
        oCroeFileName = Left(oCroeCellName, (Len(oCroeCellName) - OcreoFileLength + 3))
        Set ModelDescriptor = ModelDescriptorCreate.CreateFromFileName(oCroeFileName)
        Set window = session.OpenFile(ModelDescriptor)
        
        window.Activate
        Set Model = session.CurrentModel
        Set Powner = Model
        Set param = Powner.GetParam("PART_NO")
        Set paramValue = param.Value
        PART_NO_value = paramValue.StringValue
        Cells(k + 4, "D") = PART_NO_value
        
        Set param = Powner.GetParam("PART_NAME")
        Set paramValue = param.Value
        PART_NAME_value = paramValue.StringValue
        Cells(k + 4, "E") = PART_NAME_value
        window.Close
                     
   Next k

 

왼쪽 CREO 리스트셀 에서 CROE 파일을 읽고, PART_NO, PART_NAME 매개 변수를 불러오는 코드 

 

코드 7

        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

jpg 파일 변환 및 이미지 파일 붙여 넣기

---

소스코드

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")
        Set paramValue = param.Value
        PART_NO_value = paramValue.StringValue
        Cells(k + 4, "D") = PART_NO_value
        
        Set param = Powner.GetParam("PART_NAME")
        Set paramValue = param.Value
        PART_NAME_value = paramValue.StringValue
        Cells(k + 4, "E") = PART_NAME_value
        
        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

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

---

PART LIST BY IDT_v7.xlsm

0.03MB

 

 

[VBA] 엑셀에 그림 자동으로 넣기

 

---