Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.
Anonymous
in reply to: Anonymous

Got it.

 

Sub Main()
    Dim oDoc As Document
    Dim oPDFAddIn As TranslatorAddIn
	Dim oContext As TranslationContext
	Dim oOptions As NameValueMap
	Dim oDataMedium As DataMedium
	
	Try
		Dim ThisApp = ThisApplication
		Dim TransObj As TransientObjects = ThisApp.TransientObjects
		oDoc = ThisDoc.Document
		docFile = ThisDoc.ModelDocument
		Dim FNamePos As Long
FNamePos = InStrRev(docFile.FullFileName, "\", -1)                        
Dim docFName As String 
docFName = Right(docFile.FullFileName, Len(docFile.FullFileName) - FNamePos) 
dim SN as String
SN = iProperties.Value(docFName, "Project", "Stock Number")

		If oDoc.DocumentType <> 12292 Then '12292 = kDrawingDocument object
			MessageBox.Show("This Rule must be run from within a Drawing Document.", "Incorrect Document Type")
			Exit Sub
		End If
		
		oPDFAddIn = ThisApp.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")
		
		oContext = TransObj.CreateTranslationContext
		oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
		oOptions = TransObj.CreateNameValueMap
		oDataMedium = TransObj.CreateDataMedium
		
		If oPDFAddIn.HasSaveCopyAsOptions(oDoc, oContext, oOptions) Then
			oOptions.Value("All_Color_AS_Black") = 0 ' 0 = False, 1 = True
			oOptions.Value("Remove_Line_Weights") = 1 ' 0 = False, 1 = True
			oOptions.Value("Vector_Resolution") = 400 ' DPI
			oOptions.Value("Sheet_Range") = Inventor.PrintRangeEnum.kPrintAllSheets
			'oOptions.Value("Custom_Begin_Sheet") = 2
			'oOptions.Value("Custom_End_Sheet") = 4
		End If
		
		'Set the PDF target file name
		oDataMedium.FileName = ThisDoc.Path & "\" & ThisDoc.FileName(False) &"_" & SN & ".pdf"
	Catch
		MessageBox.Show("Error Getting Document Information" & vbCr & "Is the current Document Saved?", "Document Error")
	End Try
'Publish document

	Try
		oPDFAddIn.SaveCopyAs(oDoc, oContext, oOptions, oDataMedium)
	Catch
		MessageBox.Show("Unable to Save PDF" & vbCr & "Is the file open or read only?", "Error Saving Document")
	End Try
End Sub