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

작업 폴더에 있는 Drawing 파일 인쇄 ver0.1 - PDF 변환

by ToolBOX01 2022. 10. 11.
반응형
  • 작업 폴더에 있는 Drawing 파일을 카운트 하여 가져 옵니다.
  • 작업 폴더의 이름을 가져 옵니다.
  • 변환 하여 저장 하는 폴더 이름을 입력 합니다.  반드시  이름 마지막은 "\"이 있어야 합니다.
     - 예시)  c:\idt\pdf\
  • 프로그램이 데이텀 플랜, 포인트, 축, 좌표계를 자동으로 숨깁니다.
  • Ver 0.1은 pdf만 변경 할수 있습니다
    - 기존 Pdf 파일은 변활 할때 자동으로 덮어 씁니다.
    - 모든 sheet는 개별로 변환 되지 않습니다. 하나의  pdf 파일 안에 모두 변환 됩니다. 

 

■ 화면 구성

 

[ 변환 프로그램 ]

1. 새로고침 : 현재 작업 폴더에서 Drawing 파일 이름들을 가져 옵니다.

2. DXF : 표시된 Drawing 파일들을 DXF 파일을 변환 합니다

3. PDF : 표시된 Drawing 파일들을 PDF 파일을 변환 합니다

4. Print : 표시된 Drawing 파일들을 Print를 합니다

5. 초기화 :  입력된 모든 것이 삭제 됩니다.

 

■ 프로그램 동작 방법

1. Creo에서 도면 파일이 있는 작업 폴더를 선택 합니다

2. "새로 고침" 명령을 실행 하여, CREO 도면 이름을 가져 옵니다.

3. "Save Folder"를 입력 합니다. pdf 파일이 저장될 위치 입니다. 예제) c:\idt\pdf\

4. "pdf" 버튼을 클릭 합니다. 자동으로 Drawing 파일을 Open 하고,  pdf 파일을 변환 됩니다. 

 

*************************************************************************************************************************************

1. 새로 고침 코드

Public asynconn As New pfcls.CCpfcAsyncConnection
Public conn As pfcls.IpfcAsyncConnection
Public oBaseSession As pfcls.IpfcBaseSession
Public oModel As pfcls.IpfcModel

Sub workfolderModel_Name()
    
On Error GoTo RunError

    Dim asynconn As New pfcls.CCpfcAsyncConnection
    Dim conn As pfcls.IpfcAsyncConnection: Set conn = asynconn.Connect("", "", ".", 5)
    'Get the current session
    Set oBaseSession = conn.session
    
    Dim oStringseq As Cstringseq
    Dim cutrentworkfolder As String, oFilename As String, oEndword As String, oCroeFileName As String
    Dim i As Integer
    Dim oCheckObject As Object

    ' Current Creo Wokrfolder
    cutrentworkfolder = oBaseSession.GetCurrentDirectory
    Cells(4, "C") = cutrentworkfolder
        
    Set oStringseq = oBaseSession.ListFiles("*.drw", EpfcFILE_LIST_LATEST, cutrentworkfolder)

    For i = 0 To oStringseq.Count - 1
               Cells(i + 8, "A") = i + 1
               oFilename = oStringseq.Item(i)
               oEndpos = Len(oFilename) - InStrRev(oFilename, "\", -1, vbTextCompare)
               oEndword = Right(oFilename, oEndpos)
               OcreoFileLength = Len(oEndword) - InStr(oEndword, ".")
               oCroeFileName = Left(oEndword, (Len(oEndword) - OcreoFileLength + 3))
               Cells(i + 8, "C") = oCroeFileName
               
               Set oCheckObject = ActiveSheet.CheckBoxes.Add(Left:=Cells(i + 8, "B").Left, _
                                  Top:=Cells(i + 8, "B").Top, Width:=Cells(i + 8, "B").Width, Height:=Cells(i + 8, "B").Height)
    
               With oCheckObject
                    
                    .Caption = ""
                    
               End With
    Next i

    ' Creo Drawing Count
    Cells(5, "C") = oStringseq.Count
    MsgBox "Drawing 파일 검색을 완료 하였습니다"

    'Disconnect with Creo
    conn.Disconnect (2)

 

     'Cleanup
    Set asynconn = Nothing
    Set conn = Nothing
    Set session = Nothing
    Set Model = Nothing

         
Exit Sub
    
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

 

2. 초기화 코드

Sub modelinitialzation()

           'Cells clear
            Cells(4, "C").Select: Selection.ClearContents
            Cells(5, "C").Select: Selection.ClearContents
            Cells(6, "C").Select: Selection.ClearContents
            Range(Cells(8, "A"), Cells(Rows.Count, "A")).EntireRow.Delete
            
            'Cells CheckBox Clear
            Dim ChkB As Object
            For Each ChkB In ActiveSheet.CheckBoxes
                ChkB.Delete
            Next ChkB
            
            MsgBox "Cells 내용을 삭제 하였습니다"
            
                      
End Sub

 

3. pdf 변환 코드

 

Sub PrintDrawingWithPCF()

    Dim asynconn As New pfcls.CCpfcAsyncConnection
    Dim conn As pfcls.IpfcAsyncConnection
    Dim CreoSession As pfcls.IpfcBaseSession
    Dim CreoCurrentModel As pfcls.IpfcModel
    
    'Make an asynchronous connection with Pro/ENGINEER
    Set conn = asynconn.Connect("", "", ".", 5)
    
    'Get the current session
    Set CreoSession = conn.session
    
    'Show the current Working Directory
    MsgBox "This is the current Working Directory: " & vbCrLf & CreoSession.GetCurrentDirectory
    
    Set CreoCurrentModel = CreoSession.CurrentModel
    
    'Show the name of the Pro/E Model in a messagebox
    MsgBox "Model name = " & CreoCurrentModel.Filename


    Set oWindow = CreoSession.GetModelWindow(CreoCurrentModel)

    'Activate the new window before printing
    oWindow.Activate

    Dim PrinterInstrCreate As CCpfcPrinterInstructions
    Dim PrinterInstr As IpfcPrinterInstructions
    Dim printerPCFOptionsCreate As CCpfcPrinterPCFOptions
    Dim printerPCFOptions As IpfcPrinterPCFOptions
    Dim creoWindow As IpfcWindow

    Set PrinterInstrCreate = New CCpfcPrinterInstructions
    Set PrinterInstr = PrinterInstrCreate.Create
    Set printerPCFOptionsCreate = New CCpfcPrinterPCFOptions
    Set printerPCFOptions = printerPCFOptionsCreate.Create
    Set printerPCFOptions = CreoSession.GetPrintPCFOptions("C:\temp\postscript.pcf", CreoCurrentModel)

    PrinterInstr.PrinterOption = printerPCFOptions.PrinterOption
    PrinterInstr.ModelOption = printerPCFOptions.ModelOption
    PrinterInstr.PlacementOption = printerPCFOptions.PlacementOption

    'Set SaveToFile = True if a plot file has to be saved to Disk
    PrinterInstr.PrinterOption.SaveToFile = True
    ' Set the output plot file name here
    PrinterInstr.PrinterOption.Filename = CreoCurrentModel.InstanceName

    'Set SendToPrinter = True if the plot should be directed to Printer
    PrinterInstr.PrinterOption.SendToPrinter = True
    'Print command should be set to print to a printer if it is not set in the PCF file
    PrinterInstr.PrinterOption.PrintCommand = "windows_print_manager \\machine_name\Device_Name"

    Set creoWindow = CreoSession.GetModelWindow(CreoCurrentModel)
    PrinterInstr.WindowId = creoWindow.GetId
    CreoCurrentModel.Export CreoCurrentModel.InstanceName, PrinterInstr

    'Disconnect with Pro/ENGINEER
    conn.Disconnect (2)
    'Cleanup
    Set asynconn = Nothing
    Set conn = Nothing
    Set session = Nothing
    Set oModel = Nothing

End Sub
Sub Drawingpdfexport()

On Error GoTo RunError
     
     Set conn = asynconn.Connect("", "", ".", 5)
    'Get the current session
    Set oBaseSession = conn.session
    
    Dim oModelDescriptorCreate As New CCpfcModelDescriptor
    Dim oModelDescriptor As IpfcModelDescriptor
    Dim oWindow As IpfcWindow
    Dim oCreoFileName As String
    Dim i As Long
    
    '저장위치
    Dim oFolderName As String: oFolderName = Cells(6, "C")
    
    'config.pro 옵션
    Call oBaseSession.SetConfigOption("display_planes", "no")
    Call oBaseSession.SetConfigOption("display_axes", "no")
    Call oBaseSession.SetConfigOption("display_coord_sys", "no")
    Call oBaseSession.SetConfigOption("display_points", "no")
     
    
    For i = 0 To Cells(5, "C") - 1
        
         oCroeCellName = Cells(i + 8, "C")
         Set oModelDescriptor = oModelDescriptorCreate.CreateFromFileName(oCroeCellName)
         Set oWindow = oBaseSession.OpenFile(oModelDescriptor)
          
         'Creo Drawing Open
         oWindow.Activate
         Set oModel = oBaseSession.CurrentModel

        Dim PDFExportInstrCreate As New CCpfcPDFExportInstructions
        Dim PDFExportInstr As IpfcPDFExportInstructions:  Set PDFExportInstr = PDFExportInstrCreate.Create
        Dim PDF_Options As New pfcls.CpfcPDFOptions

        ' 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 COLOR_DEPTH value (Set EpfcPDF_CD_MONO to have Black & White output)
        Dim PDFOptionCreate_CD As New CCpfcPDFOption
        Dim PDFOption_CD As IpfcPDFOption: Set PDFOption_CD = PDFOptionCreate_CD.Create
        PDFOption_CD.OptionType = EpfcPDFOptionType.EpfcPDFOPT_COLOR_DEPTH
    
        Dim newArg_CD As New CMpfcArgument
        PDFOption_CD.OptionValue = newArg_CD.CreateIntArgValue(EpfcPDFColorDepth.EpfcPDF_CD_MONO)
        Call PDF_Options.Append(PDFOption_CD)

        ' 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)

        'Set Output PDF File Name
        PDFExportInstr.FilePath = oFolderName & oModel.FullName & ".pdf"
        PDFExportInstr.Options = PDF_Options
        Call oModel.Export(PDFExportInstr.FilePath, PDFExportInstr)
         
        oWindow.Close
        
        Cells(i + 8, "E") = "OK"
        
    Next i
    
    MsgBox "pdf 변환을 완료 하였습니다"
    
    'Disconnect with Pro/ENGINEER
    conn.Disconnect (2)
    'Cleanup
    Set asynconn = Nothing
    Set conn = Nothing
    Set oBaseSession = 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

 

 

drawing print ver02.xlsm
0.04MB