반응형
- 작업 폴더에 있는 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
'VBA For Creo' 카테고리의 다른 글
엑셀에서 Parameter 값 입력 -> Creo 변경 (0) | 2022.10.23 |
---|---|
작업 폴더에 있는 Drawing 파일 인쇄 ver 0.1 - PCF (0) | 2022.10.13 |
Creo Drawing 파일 PDF 변환 하기 (0) | 2022.10.11 |
모듈화 구성 해보기 (0) | 2022.10.11 |
MAPKEY 실행하기 (1) | 2022.10.07 |