Adding drawing status on sheets.

[iamfallen]

Hello,

I am trying to come up with a way to add a drawing status "banner" at the time of image creation or plot. The problem I have is that I am trying to do it automatically via a button across multiple sheet sizes. I looked at just using the built in plot banner, but there are no options for changing the font, I am not able to find a way to drop "Message:" from the beginning, and most of my banner options are locked anyways even though we don't use them. I could throw together a macro to add an annotation, plot/save image, and then remove the annotation again, but I do not know how to define it a set distance from the right side of the sheet across the different roll sizes.

Any help would be appreciated. Thanks.

 

[UGperson]

This is what we use. We name the NX files in this format NNNNNN-XX-XXXXXXXX-DESCRIPTION.prt

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