Option Strict Off
Imports System
Imports System.IO
Imports NXOpen
Imports NXOpen.UF
Imports NXOpenUI
Module NXJournal
Dim theSession As Session = Session.GetSession()
Dim ufs As UFSession = UFSession.GetUFSession()
Dim workPart As Part = theSession.Parts.Work
Dim displayPart As Part = theSession.Parts.Display
'***********************************************************************
Sub Main
Dim dwgs as Drawings.DrawingSheetCollection
dwgs = workPart.DrawingSheets
Dim sheet As Drawings.DrawingSheet
Dim i as integer
Dim pdfFile as string
Dim currentPath as string
Dim currentFile as string
Dim partUnits as integer
Dim strPartNumber as string
Dim strPartDes as string
Dim strPartRev as string
Dim rsp
Dim cur_MM_DWG_STUDY_REV As String
Dim MM_DWG_STUDY_REV As String
'currentFile = GetFilePath() & GetFileName() & ".prt"
currentPath = GetFilePath()
currentFile = GetFileName1()
currentFile = GetFileName2()
currentPath = GetFilePath2()
partUnits = displayPart.PartUnits
'0 = inch
'1 = metric
' ----------------------------------------------
' Menu: Format->Layer Settings...
' ----------------------------------------------
Dim markId1 As Session.UndoMarkId
markId1 = theSession.SetUndoMark(Session.MarkVisibility.Visible, "Start")
theSession.SetUndoMarkName(markId1, "Layer Settings Dialog")
Dim stateArray1(0) As Layer.StateInfo
stateArray1(0).Layer = 245
stateArray1(0).State = Layer.State.Hidden
workPart.Layers.ChangeStates(stateArray1, False)
theSession.SetUndoMarkName(markId1, "Layer Settings")
theSession.DeleteUndoMark(markId1, Nothing)
MM_DWG_STUDY_REV1:
Try
cur_MM_DWG_STUDY_REV = thesession.Parts.Work.GetStringAttribute("MM_DWG_STUDY_REV")
Catch exc As NXException
MM_DWG_STUDY_REV = NXInputBox.GetInputString("Enter Study Version", "STUDY","S0")
MM_DWG_STUDY_REV = MM_DWG_STUDY_REV.ToUpper()
theSession.Parts.Work.SetAttribute("MM_DWG_STUDY_REV", MM_DWG_STUDY_REV)
goto MM_DWG_STUDY_REV
end try
MM_DWG_STUDY_REV = NXInputBox.GetInputString("Enter Study Version", "STUDY",cur_MM_DWG_STUDY_REV)
MM_DWG_STUDY_REV = MM_DWG_STUDY_REV.ToUpper()
theSession.Parts.Work.SetAttribute("MM_DWG_STUDY_REV", MM_DWG_STUDY_REV)
'retrieve MM_DWG_STUDY_REV attribute
MM_DWG_STUDY_REV:
Try
strPartRev = workPart.GetStringAttribute("MM_DWG_STUDY_REV")
Catch ex As Exception
strPartRev = Trim(pdfFile)
'While strPartRev = ""
'strPartRev = InputBox("Enter Drawing Revision", "Drawing Revision", "")
'End While
'workPart.SetAttribute("MM_DWG_STUDY_REV", strPartRev)
end try
' ----------------------------------------------
' Menu: File->Save Work Part Only
' ----------------------------------------------
Dim partSaveStatus1 As PartSaveStatus
partSaveStatus1 = workPart.Save(BasePart.SaveComponents.False, BasePart.CloseAfterSave.False)
partSaveStatus1.Dispose()
'****
'**** Export drawing sheets to .pdf file
i = 0
For Each sheet in dwgs
'msgbox (sheet.name)
i = i + 1
'pdfFile = GetFilePath() & GetFileName() & ".pdf"
pdfFile = GetFilePath() & GetFileName1() & "-" & strPartRev & "-STUDY" & GetFileName2() & "-" & GetFilePath2() & ".pdf"
try
ExportPDF(sheet, pdfFile, partUnits)
catch ex as exception
msgbox("Error occurred in PDF export" & vbcrlf & ex.message & vbcrlf & "journal exiting", vbcritical + vbokonly)
exit sub
end try
Next
if i = 0 then
msgbox("This part has no drawing sheets to export")
else
msgbox("Exported: " & i & " sheet(s) to pdf file" & vbcrlf & pdfFile, vbokonly + vbinformation)
end if
'****
End Sub 'end of Sub Main
'***********************************************************************
Function GetFileName2()
Dim strPath as String
Dim strPart as String
Dim pos as Integer
'get the full file path
strPath = displayPart.fullpath
'get the part file name
pos = InStrRev(strPath, "\")
strPart = Mid(strPath, pos + 1)
strPath = Left(strPath, pos)
'strip off the ".prt" extension
strPart = Left(strPart, Len(strPart) - 8)
strPart = Right(strPart, Len(strPart) - 18)
GetFileName2 = strPart
End Function
'***********************************************************************
Function GetFileName1()
Dim strPath as String
Dim strPart as String
Dim pos as Integer
Dim e as Integer
Dim l as Integer
'get the full file path
strPath = displayPart.fullpath
'get the part file name
pos = InStrRev(strPath, "\")
strPart = Mid(strPath, pos + 1)
strPath = Right(strPath, pos)
'strip off the ".prt" extension
'strPart = Left(strPart, Len(strPart) + 5)
'strPart = Right(strPart, pos - 1)
e = Len(strPart)
l =(e-6)
strPart = Left(strPart, Len(strPart) - l)
GetFileName1 = strPart
End Function
'***********************************************************************
Function GetFilePath()
Dim strPath as String
Dim strPart as String
Dim pos as Integer
'get the full file path
strPath = displayPart.fullpath
'get the part file name
pos = InStrRev(strPath, "\")
strPart = Mid(strPath, pos + 1)
strPath = Left(strPath, pos)
'strip off the ".prt" extension
strPart = Left(strPart, Len(strPart) - 4)
GetFilePath = strPath
End Function
'***********************************************************************
Function GetFilePath2()
Dim strPath as String
Dim strPart as String
Dim strPart2 as String
Dim pos as Integer
Dim pos2 as Integer
'get the full file path
strPart2 = displayPart.fullpath
pos = InStrRev(strPart2, "\")
strPart2 = Left(strPart2, pos -1)
strPath = strPart2
pos2 = InStrRev(strPath, "\")
strPart = Mid(strPath, pos2 + 1)
strPath = Left(strPath, pos)
strPart = Left(strPart, Len(strPart))
GetFilePath2 = strPart
End Function
'***********************************************************************
Sub ExportPDF(dwg as Drawings.DrawingSheet, outputFile as string, units as integer)
Dim printPDFBuilder1 As PrintPDFBuilder
printPDFBuilder1 = workPart.PlotManager.CreatePrintPdfbuilder()
printPDFBuilder1.Scale = 1.0
printPDFBuilder1.Colors = PrintPDFBuilder.Color.BlackOnWhite
printPDFBuilder1.Size = PrintPDFBuilder.SizeOption.ScaleFactor
if units = 0 then
printPDFBuilder1.Units = PrintPDFBuilder.UnitsOption.English
else
printPDFBuilder1.Units = PrintPDFBuilder.UnitsOption.Metric
end if
printPDFBuilder1.XDimension = dwg.height
printPDFBuilder1.YDimension = dwg.length
printPDFBuilder1.OutputText = PrintPDFBuilder.OutputTextOption.Polylines
printPDFBuilder1.RasterImages = True
printPDFBuilder1.ImageResolution = PrintPDFBuilder.ImageResolutionOption.Medium
printPDFBuilder1.Append = True
printPDFBuilder1.AddWatermark = True
printPDFBuilder1.Watermark = "PRELIMINARY"
Dim sheets1(0) As NXObject
Dim drawingSheet1 As Drawings.DrawingSheet = CType(dwg, Drawings.DrawingSheet)
sheets1(0) = drawingSheet1
printPDFBuilder1.SourceBuilder.SetSheets(sheets1)
printPDFBuilder1.Filename = outputFile
Dim nXObject1 As NXObject
nXObject1 = printPDFBuilder1.Commit()
printPDFBuilder1.Destroy()
End Sub
'***********************************************************************
'***********************************************************************
'***********************************************************************
End Module