#3 여러개의 drw 파일 → 2D pdf 파일 변환 프로그램

creo에서 여러개의 sheet를 가지고 있는 drw 파일은 파일 변환 할때 all, current sheet, range 3개의 옵션을

사용 할수 있습니다.  current sheet 옵션을 사용하여 pdf 변환을 개별로 할수 있습니다. 여러개의 pdf 파일을

만드려면 매번 "current sheet" 옵션을 선택 해야 합니다. 특정 폴더에 있는 Drw를 pdf로 변환 하는 프로그램 입니니다.

Drw 파일이 여러개의 Sheet로 구성 되어 있으면, PDF 파일은 여러개의 파일로 변환 됩니다. "파일 이름_1.pdf", 

"파일 이름_2.pdf" ... 로 변환 됩니다. Pen Table 옵션은 주석으로 처리 했습니다.  Confog.pro 파일에서 Pentable을

지정 하면, 주석 문자를 제거 하고 사용 합니다.

아래 프로그램을 응용 하면 pdf 파일 이름에 "품번"을 추가 할수 있습니다. 또한 "Stamp" 기능을 추가 할수 있습니다.

 

---

 

Sub main()
        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
    
        'Cells 초기화
        Range(Cells(5, "A"), Cells(Rows.Count, "A")).EntireRow.Delete
        
        '사용자가 입력하는 폴더 정의 cells
        Dim oForderName As String: oForderName = Range("b3")
        session.ChangeDirectory (oForderName)
        
        
        '사용자가 정의한 폴더의 drw들 리스트로 만들기
        Dim oStringseq As Istringseq
        Set oStringseq = session.ListFiles("*.drw", EpfcFILE_LIST_LATEST, oForderName)
        Dim i As Integer
    
        For i = 0 To oStringseq.Count - 1
            Cells(i + 5, "z") = oStringseq.Item(i)
        Next i
                
        '파일 이름만 축출 하는 프로 시저
        Call Filename
        
        
        '파일 open 정의
        Dim oNamerng As Integer: oNamerng = Cells(Rows.Count, "B").End(xlUp).Row - 4
        Dim ModelDescriptorCreate As New CCpfcModelDescriptor
        Dim ModelDescriptor As IpfcModelDescriptor
        Dim window As IpfcWindow
        Dim oCroeCellName As String
        
        Dim oSheetOwner As IpfcSheetOwner
        Dim oSheetallNumber As Long
        Dim oModel As IpfcModel
        
        
        Dim PDFExportInstrCreate As New CCpfcPDFExportInstructions
        Dim PDFExportInstr As IpfcPDFExportInstructions
        Set PDFExportInstr = PDFExportInstrCreate.Create()
        
        Dim PDF_Options As New pfcls.CpfcPDFOptions
        
        
        ' Set Sheetnumber Option
        Dim PDFOptionCreate_SHN As New CCpfcPDFOption
        Dim PDFOption_SHN As IpfcPDFOption
        Set PDFOption_SHN = PDFOptionCreate_SHN.Create
        PDFOption_SHN.OptionType = EpfcPDFOptionType.EpfcPDFOPT_SHEETS
        Dim newArg_SHN As New CMpfcArgument
        PDFOption_SHN.OptionValue = newArg_SHN.CreateIntArgValue(EpfcPrintSheets.EpfcPRINT_CURRENT_SHEET)
        Call PDF_Options.Append(PDFOption_SHN)
        
        ' Set Stroke All Fonts PDF Option
        Dim PDFOptionCreate_SAF As New CCpfcPDFOption
        Dim PDFOption_SAF As IpfcPDFOption
        Set PDFOption_SAF = PDFOptionCreate_SAF.Create
        PDFOption_SAF.OptionType = EpfcPDFOptionType.EpfcPDFOPT_FONT_STROKE
        Dim newArg_SAF As New CMpfcArgument
        PDFOption_SAF.OptionValue = newArg_SAF.CreateIntArgValue(EpfcPDFFontStrokeMode.EpfcPDF_STROKE_ALL_FONTS)
        Call PDF_Options.Append(PDFOption_SAF)
        
        
        ' Set Pen table Option
'        Dim PDFOptionCreate_PEN As New CCpfcPDFOption
'        Dim PDFOption_PEN As IpfcPDFOption
'        Set PDFOption_PEN = PDFOptionCreate_PEN.Create
'        PDFOption_PEN.OptionType = EpfcPDFOptionType.EpfcPDFOPT_PENTABLE
'        Dim newArg_PEN As New CMpfcArgument
'        PDFOption_PEN.OptionValue = newArg_PEN.CreateIntArgValue(True)
'        Call PDF_Options.Append(PDFOption_PEN)
        
        
        ' Set PDF EpfcPDFOPT_LAUNCH_VIEWER(Set FALSE Not to Launch Adobe reader)
        Dim PDFOptionCreate_LV As New CCpfcPDFOption
        Dim PDFOption_LV As IpfcPDFOption
        Set PDFOption_LV = PDFOptionCreate_LV.Create
        PDFOption_LV.OptionType = EpfcPDFOptionType.EpfcPDFOPT_LAUNCH_VIEWER
        Dim newArg_LV As New CMpfcArgument
        PDFOption_LV.OptionValue = newArg_LV.CreateBoolArgValue(False)
        Call PDF_Options.Append(PDFOption_LV)
        
               
        
        For k = 1 To oNamerng
            oCroeCellName = Cells(k + 4, "b")
            Set ModelDescriptor = ModelDescriptorCreate.CreateFromFileName(oCroeCellName)
            Set window = session.OpenFile(ModelDescriptor)
            window.Activate
            
            Set oModel = session.CurrentModel
            Set oSheetOwner = oModel
            oSheetallNumber = oSheetOwner.NumberOfSheets
            Cells(4 + k, "c") = oSheetallNumber
             
           If oSheetallNumber > 1 Then
              For j = 1 To oSheetallNumber
                    oSheetOwner.CurrentSheetNumber = j
                    PDFExportInstr.FilePath = "D:\IDT\DATA_EXPORT\2DPDF\" & oModel.FullName & "_" & j & ".pdf"
                    PDFExportInstr.Options = PDF_Options
                    Call oModel.Export(PDFExportInstr.FilePath, PDFExportInstr)
                    j = j
                    Cells(4 + k, 3 + j) = oModel.FullName & "_" & j & ".pdf"
                    
              Next j
           Else
                    PDFExportInstr.FilePath = "D:\IDT\DATA_EXPORT\2DPDF\" & oModel.FullName & ".pdf"
                    PDFExportInstr.Options = PDF_Options
                    Call oModel.Export(PDFExportInstr.FilePath, PDFExportInstr)
                    Cells(4 + k, "d") = "OK"
                    
           End If
            
        Next k


    conn.Disconnect (2)

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 Filename()

    Dim rng As Integer: rng = Cells(Rows.Count, "Z").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, "Z")
        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, "B") = oCroeFileName
    Next j
    
    Columns("Z").Delete

End Sub

 

 

---

DRW PDF EXCHANGE BY IDT V1.xlsm

0.03MB

 

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

---