Batch plot with plot stamp.

[ACritchelow]

I am trying to write a print rule that prints a set of drawings for our design releases. The way I have gone about this is to open every drawing that I need printed and hit the button. Then the rule puts the prints in the correct order and prints the correct qty (1 – A, 3 – B, 1-D). this is what our shop is used to getting. This has been working very well. The have requested a plot stamp that has the date and time that the print was issued. This is something that has been done manually and I was trying to automat it with the print rule. Below is the rule that I have put together. I am not a programmer and much of this is cut and paste from this forum.

My problem is I am adding the plot stamp to each drawing then plotting then deleting the plot stamp. This works like a charm if I do one drawing at a time but when I loop through the drawings it adds the plot stamp to all drawings but only deletes the stamp from the last drawing plotted. If anyone has any idea how I can improve this to make it work, I could sure use the help.

Sub main()
	Dim VisDocs As DocumentsEnumerator
	VisDocs = ThisApplication.Documents.VisibleDocuments
	Dim Count As Integer
	Count = VisDocs.Count
	Dim Arr(0 To Count) As String

	For i = 1 To Count
	    Arr(i) = VisDocs.Item(i).fullDocumentName
	Next i

	For i = 1 To UBound(Arr)
	    For j = i + 1 To UBound(Arr)
	        If (Arr(i)) < (Arr(j)) Then
	            temp = Arr(j)
	            Arr(j) = Arr(i)
	            Arr(i) = temp
	        End If
	    Next j
	Next i

	PrintQty = 1
	PrintNo = 1
	While PrintQty >= PrintNo
		For i = 1 To Count
			oDoc = ThisApplication.Documents.Open(Arr(i), False)
			
			If (oDoc.DocumentType = kDrawingDocumentObject) Then
				Call AddNote()
				oDoc.Activate
				Dim oDrawDoc As Document
				oDrawDoc = ThisApplication.ActiveDocument
				
				Dim oPrintMgr As DrawingPrintManager
				oPrintMgr = oDrawDoc.PrintManager
				
				With oPrintMgr
					.Printer = "HP DesignJet T930 PS HPGL2"
					.PrintRange = PrintRangeEnum.kPrintAllSheets
					.ColorMode = PrintColorModeEnum.kPrintDefaultColorMode
					.NumberOfCopies = 1
					.Orientation = PrintOrientationEnum.kLandscapeOrientation
					.ScaleMode = PrintScaleModeEnum.kPrintBestFitScale
					.PaperSize = PaperSizeEnum.kPaperSizeDSheet
					.SubmitPrint
					'MessageBox.Show(Arr(i), "Print D")
				End With
				'MessageBox.Show(Arr(i)+ " print " + CStr(PrintNo)+ " on printer " + oPrintMgr.Printer, "Print Test")
				Call DeleteNote()
			End If
		Next i
	PrintNo = PrintNo + 1
	End While

	For i = 1 To UBound(Arr)
	    For j = i + 1 To UBound(Arr)
	        If (Arr(i)) > (Arr(j)) Then
	            temp = Arr(j)
	            Arr(j) = Arr(i)
	            Arr(i) = temp
	        End If
	    Next j
	Next i

	PrintQty = 3
	PrintNo = 1
	While PrintQty >= PrintNo
		For i = 1 To Count
			oDoc = ThisApplication.Documents.Open(Arr(i), False)
			
			If (oDoc.DocumentType = kDrawingDocumentObject) Then
				Call AddNote()
				oDoc.Activate
				Dim oDrawDoc As Document
				oDrawDoc = ThisApplication.ActiveDocument
				
				Dim oPrintMgr As DrawingPrintManager
				oPrintMgr = oDrawDoc.PrintManager
				
				With oPrintMgr
					.Printer = "\\HCC-APPS\XEROX"
					.PrintRange = PrintRangeEnum.kPrintAllSheets
					.ColorMode = PrintColorModeEnum.kPrintDefaultColorMode
					.NumberOfCopies = 1
					.Orientation = PrintOrientationEnum.kLandscapeOrientation
					.ScaleMode = PrintScaleModeEnum.kPrintBestFitScale
					.PaperSize = PaperSizeEnum.kPaperSize11x17
					.SubmitPrint
					'MessageBox.Show(Arr(i), "Print B")
				End With
				'MessageBox.Show(Arr(i)+ " print " + CStr(PrintNo)+ " on printer " + oPrintMgr.Printer, "Print Test")
				Call DeleteNote()
			End If
		Next i
	PrintNo = PrintNo + 1
	End While

	PrintQty = 1
	PrintNo = 1
	While PrintQty >= PrintNo
		For i = 1 To Count
			oDoc = ThisApplication.Documents.Open(Arr(i), False)
			
			If (oDoc.DocumentType = kDrawingDocumentObject) Then
				Call AddNote()
				oDoc.Activate
				Dim oDrawDoc As Document
				oDrawDoc = ThisApplication.ActiveDocument
				
				Dim oPrintMgr As DrawingPrintManager
				oPrintMgr = oDrawDoc.PrintManager
				
				With oPrintMgr
					.Printer = "\\HCC-APPS\XEROX"
					.PrintRange = PrintRangeEnum.kPrintAllSheets
					.ColorMode = PrintColorModeEnum.kPrintDefaultColorMode
					.NumberOfCopies = 1
					.Orientation = PrintOrientationEnum.kLandscapeOrientation
					.ScaleMode = PrintScaleModeEnum.kPrintBestFitScale
					.PaperSize = PaperSizeEnum.kPaperSizeLetter
					.SubmitPrint
					'MessageBox.Show(Arr(i), "Print A")
				End With
				'MessageBox.Show(Arr(i)+ " print " + CStr(PrintNo)+ " on printer " + oPrintMgr.Printer, "Print Test")
				Call DeleteNote()
			End If
		Next i
	PrintNo = PrintNo + 1
	End While
End Sub

Sub AddNote()
	Dim AddNoteinvApp As Inventor.Application
	AddNoteinvApp = ThisApplication
	
	Dim AddNoteoDrawDoc As Document
	AddNoteoDrawDoc = AddNoteinvApp.ActiveEditDocument
	
	Dim UserStr As String
	Dim dateStr As Date
	Dim PlotStamp As String
	dateStr = Now
	UserStr = ThisApplication.GeneralOptions.UserName
	PlotStamp = UserStr +"     "+dateStr
	
	Dim AddNoteoTG As Inventor.TransientGeometry = AddNoteinvApp.TransientGeometry
	
	For Each AddNoteoSheet In AddNoteoDrawDoc.Sheets
	
		AddNoteoNote = AddNoteoSheet.DrawingNotes.GeneralNotes.AddFitted(AddNoteoTG.CreatePoint2d(.5,4), PlotStamp)
		
		With AddNoteoNote
			.Rotation = (PI/2)+.001 'radianti
			.LineSpacing = .8125
			.VerticalJustification = Inventor.VerticalTextAlignmentEnum.kAlignTextMiddle
			.HorizontalJustification = Inventor.HorizontalTextAlignmentEnum.kAlignTextLeft
			.FormattedText = "<StyleOverride FontSize = '.25'>" & PlotStamp & "</StyleOverride>"
		End With
		AddNoteoDrawDoc.Update()
	Next
 End Sub
 
 
 Sub DeleteNote()
 	Dim DeleteNoteinvApp As Inventor.Application
	DeleteNoteinvApp = ThisApplication
	
	Dim DeleteNoteoDrawDoc As Document
	DeleteNoteoDrawDoc = DeleteNoteinvApp.ActiveEditDocument
		
	For Each oSheet In DeleteNoteoDrawDoc.Sheets
		For Each oGeneralNote In oSheet.DrawingNotes.GeneralNotes
			If oGeneralNote.Rotation = (PI/2)+.001
				oGeneralNote.Delete
			End If
		Next
	Next
 End Sub

[Sergio.D.Suárez · Accepted solution]

Hi, Actually, I did not understand the procedure well, but I modified its code a bit to eliminate some lines that seemed to me with errors. To begin instead of the order to open a hidden file in a hidden mode, I directly perform actions, add note, print, delete the note, and then I close it (without saving) and move on to the next one.
Making the same modification for the remaining visible files. I think it is important to activate and deactivate each work file properly so that the rule add note and delete note act on the active documents that correspond to them.
I hope it will be useful. regards

Sub Main()
	Dim VisDocs As DocumentsEnumerator
	VisDocs = ThisApplication.Documents.VisibleDocuments
	Dim Count As Integer
	Count = VisDocs.Count
	Dim Arr(0 To Count) As String

	For i = 1 To Count
	    Arr(i) = VisDocs.Item(i).fullDocumentName
	Next i

	For i = 1 To UBound(Arr)
	    For j = i + 1 To UBound(Arr)
	        If (Arr(i)) < (Arr(j)) Then
	            temp = Arr(j)
	            Arr(j) = Arr(i)
	            Arr(i) = temp
	        End If
	    Next j
	Next i

	PrintQty = 1
	PrintNo = 1
	While PrintQty >= PrintNo
		For i = 1 To Count
			
			oDoc = ThisApplication.Documents.VisibleDocuments.Item(i)

			If (oDoc.DocumentType = kDrawingDocumentObject) Then
				oDoc.Activate
				
				Call AddNote()
				
				Dim oPrintMgr As DrawingPrintManager
				oPrintMgr = oDoc.PrintManager
				
				With oPrintMgr
					.Printer = "HP DesignJet T930 PS HPGL2"
					.PrintRange = PrintRangeEnum.kPrintAllSheets
					.ColorMode = PrintColorModeEnum.kPrintDefaultColorMode
					.NumberOfCopies = 1
					.Orientation = PrintOrientationEnum.kLandscapeOrientation
					.ScaleMode = PrintScaleModeEnum.kPrintBestFitScale
					.PaperSize = PaperSizeEnum.kPaperSizeDSheet
					.SubmitPrint
					'MessageBox.Show(Arr(i), "Print D")
				End With
				'MessageBox.Show(Arr(i)+ " print " + CStr(PrintNo)+ " on printer " + oPrintMgr.Printer, "Print Test")
				
				Call DeleteNote()
				oDoc.close
			End If
		Next i
	PrintNo = PrintNo + 1
	End While

	For i = 1 To UBound(Arr)
	    For j = i + 1 To UBound(Arr)
	        If (Arr(i)) > (Arr(j)) Then
	            temp = Arr(j)
	            Arr(j) = Arr(i)
	            Arr(i) = temp
	        End If
	    Next j
	Next i

	PrintQty = 3
	PrintNo = 1
	While PrintQty >= PrintNo
		For i = 1 To Count
			
			oDoc = ThisApplication.Documents.VisibleDocuments.Item(i)
			
			If (oDoc.DocumentType = kDrawingDocumentObject) Then
				oDoc.Activate
				Call AddNote()
				
				Dim oPrintMgr As DrawingPrintManager
				oPrintMgr = oDoc.PrintManager
				
				With oPrintMgr
					.Printer = "\\HCC-APPS\XEROX"
					.PrintRange = PrintRangeEnum.kPrintAllSheets
					.ColorMode = PrintColorModeEnum.kPrintDefaultColorMode
					.NumberOfCopies = 1
					.Orientation = PrintOrientationEnum.kLandscapeOrientation
					.ScaleMode = PrintScaleModeEnum.kPrintBestFitScale
					.PaperSize = PaperSizeEnum.kPaperSize11x17
					.SubmitPrint
					'MessageBox.Show(Arr(i), "Print B")
				End With
				'MessageBox.Show(Arr(i)+ " print " + CStr(PrintNo)+ " on printer " + oPrintMgr.Printer, "Print Test")
				Call DeleteNote()
				oDoc.close
			End If
		Next i
	PrintNo = PrintNo + 1
	End While

	PrintQty = 1
	PrintNo = 1
	While PrintQty >= PrintNo
		For i = 1 To Count
			
			oDoc = ThisApplication.Documents.VisibleDocuments.Item(i)
			
			If (oDoc.DocumentType = kDrawingDocumentObject) Then
				oDoc.Activate
				Call AddNote()
				
				Dim oPrintMgr As DrawingPrintManager
				oPrintMgr = oDoc.PrintManager
				
				With oPrintMgr
					.Printer = "\\HCC-APPS\XEROX"
					.PrintRange = PrintRangeEnum.kPrintAllSheets
					.ColorMode = PrintColorModeEnum.kPrintDefaultColorMode
					.NumberOfCopies = 1
					.Orientation = PrintOrientationEnum.kLandscapeOrientation
					.ScaleMode = PrintScaleModeEnum.kPrintBestFitScale
					.PaperSize = PaperSizeEnum.kPaperSizeLetter
					.SubmitPrint
					'MessageBox.Show(Arr(i), "Print A")
				End With
				'MessageBox.Show(Arr(i)+ " print " + CStr(PrintNo)+ " on printer " + oPrintMgr.Printer, "Print Test")
				Call DeleteNote()
				oDoc.Close
			End If
		Next i
	PrintNo = PrintNo + 1
	End While
End Sub

Sub AddNote()
	Dim AddNoteinvApp As Inventor.Application
	AddNoteinvApp = ThisApplication
	
	Dim AddNoteoDrawDoc As Document
	AddNoteoDrawDoc = AddNoteinvApp.ActiveEditDocument
	
	Dim UserStr As String
	Dim dateStr As Date
	Dim PlotStamp As String
	dateStr = Now
	UserStr = ThisApplication.GeneralOptions.UserName
	PlotStamp = UserStr +"     "+dateStr
	
	Dim AddNoteoTG As Inventor.TransientGeometry = AddNoteinvApp.TransientGeometry
	
	For Each AddNoteoSheet In AddNoteoDrawDoc.Sheets
	
		AddNoteoNote = AddNoteoSheet.DrawingNotes.GeneralNotes.AddFitted(AddNoteoTG.CreatePoint2d(.5,4), PlotStamp)
		
		With AddNoteoNote
			.Rotation = (PI/2)+.001 'radianti
			.LineSpacing = .8125
			.VerticalJustification = Inventor.VerticalTextAlignmentEnum.kAlignTextMiddle
			.HorizontalJustification = Inventor.HorizontalTextAlignmentEnum.kAlignTextLeft
			.FormattedText = "<StyleOverride FontSize = '.25'>" & PlotStamp & "</StyleOverride>"
		End With
		AddNoteoDrawDoc.Update()
	Next
 End Sub
 
 
 Sub DeleteNote()
 	Dim DeleteNoteinvApp As Inventor.Application
	DeleteNoteinvApp = ThisApplication
	
	Dim DeleteNoteoDrawDoc As Document
	DeleteNoteoDrawDoc = DeleteNoteinvApp.ActiveEditDocument
		
	For Each oSheet In DeleteNoteoDrawDoc.Sheets
		For Each oGeneralNote In oSheet.DrawingNotes.GeneralNotes
			If oGeneralNote.Rotation = (PI/2)+.001
				oGeneralNote.Delete
			End If
		Next
	Next
 End Sub

[ACritchelow]

Thank you for reviewing my work. I used the open instead of visible because i had to sort the files by filename. I do not know how to read the visible.item() and set it to a veritable. After testing your modifications, the files were being printed in the order they were opened and not in the order of file name A to Z on one printer and Z to A on the other, So i returned to the open. One item that i was missing was the .close after each file in the loop. After adding this it looks as if it works like a charm. I did some cleanup in my code as well and this is what my final code looks like.

If you could tell me how to sort my files by name and get the files to come up in order A to Z using the .item() i would love to learn from your experience!!!

Sub Main()
	Dim VisDocs As DocumentsEnumerator
	VisDocs = ThisApplication.Documents.VisibleDocuments
	Dim Count As Integer
	Count = VisDocs.Count
	Dim Arr(0 To Count) As String

	For i = 1 To Count
	    Arr(i) = VisDocs.Item(i).fullDocumentName
	Next i
	
	'Getting the sheets in the order they should be printed Z to A
	For i = 1 To UBound(Arr)
	    For j = i + 1 To UBound(Arr)
	        If (Arr(i)) < (Arr(j)) Then
	            temp = Arr(j)
	            Arr(j) = Arr(i)
	            Arr(i) = temp
	        End If
	    Next j
	Next i
	
	PrintQty = 1 '# of of prints required
	PrintNo = 1 '# being printed
	While PrintQty >= PrintNo
		For i = 1 To Count
			oDoc = ThisApplication.Documents.Open(Arr(i), False)
			
			If (oDoc.DocumentType = kDrawingDocumentObject) Then
				oDoc.Activate
				Call AddNote()	
				Paper = PaperSizeEnum.kPaperSizeLetter
				Call Plot(oDoc, Paper)
				Call DeleteNote()
				oDoc.close
			End If
		Next i
	PrintNo = PrintNo + 1
	End While

	'Getting the sheets in the order they should be printed A to Z
	For i = 1 To UBound(Arr)
	    For j = i + 1 To UBound(Arr)
	        If (Arr(i)) > (Arr(j)) Then
	            temp = Arr(j)
	            Arr(j) = Arr(i)
	            Arr(i) = temp
	        End If
	    Next j
	Next i

	PrintQty = 3 '# of of prints required
	PrintNo = 1 '# being printed
	While PrintQty >= PrintNo
		For i = 1 To Count
			oDoc = ThisApplication.Documents.Open(Arr(i), False)			
			If (oDoc.DocumentType = kDrawingDocumentObject) Then
				oDoc.Activate
				Call AddNote()	
				Paper = PaperSizeEnum.kPaperSize11x17
				Call Plot(oDoc, Paper)
				Call DeleteNote()
				oDoc.close
			End If
		Next i
	PrintNo = PrintNo + 1
	End While

	PrintQty = 1 '# of of prints required
	PrintNo = 1 '# being printed
	While PrintQty >= PrintNo
		For i = 1 To Count
			oDoc = ThisApplication.Documents.Open(Arr(i), False)
			
			If (oDoc.DocumentType = kDrawingDocumentObject) Then
				oDoc.Activate	
				Call AddNote()	
				Paper = PaperSizeEnum.kPaperSizeDSheet
				Call Plot(oDoc, Paper)
				Call DeleteNote()
				oDoc.close
			End If
		Next i
	PrintNo = PrintNo + 1
	End While
End Sub

Sub AddNote() 'add plot stamp
	Dim AddNoteinvApp As Inventor.Application
	AddNoteinvApp = ThisApplication
	
	Dim AddNoteoDrawDoc As Document
	AddNoteoDrawDoc = AddNoteinvApp.ActiveEditDocument
	
	Dim UserStr As String
	Dim dateStr As Date
	Dim PlotStamp As String
	dateStr = Now
	UserStr = ThisApplication.GeneralOptions.UserName
	PlotStamp = UserStr +"     "+dateStr
	
	Dim AddNoteoTG As Inventor.TransientGeometry = AddNoteinvApp.TransientGeometry
	
	For Each AddNoteoSheet In AddNoteoDrawDoc.Sheets
	
		AddNoteoNote = AddNoteoSheet.DrawingNotes.GeneralNotes.AddFitted(AddNoteoTG.CreatePoint2d(.5,4), PlotStamp)
		
		With AddNoteoNote
			.Rotation = (PI/2)+.001 'radianti
			.LineSpacing = .8125
			.VerticalJustification = Inventor.VerticalTextAlignmentEnum.kAlignTextMiddle
			.HorizontalJustification = Inventor.HorizontalTextAlignmentEnum.kAlignTextLeft
			.FormattedText = "<StyleOverride FontSize = '.1875'>" & PlotStamp & "</StyleOverride>"
		End With
		AddNoteoDrawDoc.Update()
	Next
 End Sub
 
 
 Sub DeleteNote()  'remove plot stamp
 	Dim DeleteNoteinvApp As Inventor.Application
	DeleteNoteinvApp = ThisApplication
	
	Dim DeleteNoteoDrawDoc As Document
	DeleteNoteoDrawDoc = DeleteNoteinvApp.ActiveEditDocument
		
	For Each oSheet In DeleteNoteoDrawDoc.Sheets
		For Each oGeneralNote In oSheet.DrawingNotes.GeneralNotes
			If oGeneralNote.Rotation = (PI/2)+.001
				oGeneralNote.Delete
			End If
		Next
	Next
 End Sub

 Sub Plot(oDoc, Paper) 'runs the prints
	 Dim oPrintMgr As DrawingPrintManager
	oPrintMgr = oDoc.PrintManager
	
	With oPrintMgr
		.Printer = "\\HCC-APPS\XEROX"
		.PrintRange = PrintRangeEnum.kPrintAllSheets
		.ColorMode = PrintColorModeEnum.kPrintDefaultColorMode
		.NumberOfCopies = 1
		.Orientation = PrintOrientationEnum.kLandscapeOrientation
		.ScaleMode = PrintScaleModeEnum.kPrintBestFitScale
		.PaperSize = Paper
		'.SubmitPrint
	End With
End Sub

[Sergio.D.Suárez]

Hello, first of all, I am also an apprentice, I am like your researcher and the doubts that arise also I learn.
Try to make a code that alphabetically orders open documents and this small segment seems to work.

	Dim VisDocs As DocumentsEnumerator
	VisDocs = ThisApplication.Documents.VisibleDocuments
	Dim Count As Integer
	Count = VisDocs.Count
	'---------------------------------------------------
	Dim  AlphaOrder As New ArrayList
	For i = 1 To Count
		 AlphaOrder.Add(VisDocs.Item(i).displayname)
	Next i
	 AlphaOrder.Sort()
	For i = 0 To Count - 1
		
		MessageBox.Show(AlphaOrder(i))
	Next i

  I have not tested it in its entirety, I think it could be added to your code, maybe correcting it in this way.

I hope it works. I'm sure there will be simpler methods and maybe more practical, if I can find some I'll leave it here. regards

	Dim VisDocs As DocumentsEnumerator
	VisDocs = ThisApplication.Documents.VisibleDocuments
	Dim Count As Integer
	Count = VisDocs.Count
	'---------------------------------------------------
	Dim  AlphaOrder As New ArrayList
	For i = 1 To Count
		 AlphaOrder.Add(VisDocs.Item(i).displayname)
	Next i
	 AlphaOrder.Sort()
	'--------------------------------------------------
	
	Dim Arr(0 To Count) As String
	For i = 1 To Count
		Filename = AlphaOrder(i - 1)
		For j = 1 To Count
			If VisDocs.Item(j).Displayname = Filename Then
			    Arr(j) = VisDocs.Item(j).fullDocumentName
				Exit For
			End If
		Next j
	Next i

	For i = 1 To UBound(Arr)
	    For j = i + 1 To UBound(Arr)
	        If (Arr(i)) < (Arr(j)) Then
	            temp = Arr(j)
	            Arr(j) = Arr(i)
	            Arr(i) = temp
	        End If
	    Next j
	Next i