Export to pdf with the name of the sheet

[DeptaM]

Good day,
I have a rule for exporting from a drawing to PDF one sheet at a time. The file is always saved with the file name IDW. I need it to be saved with the sheet name.

Thank you for your help.

Sub Main PublishPDF()

    ' Get the PDF translator Add-In.

    Dim PDFAddIn As TranslatorAddIn

    PDFAddIn = ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")

    ' a reference to the active document (the document to be published).

    Dim oDocument As Document

     oDocument = ThisApplication.ActiveDocument

    Dim oContext As TranslationContext

     oContext = ThisApplication.TransientObjects.CreateTranslationContext

    oContext.Type = kFileBrowseIOMechanism

    ' Create a NameValueMap object

    Dim oOptions As NameValueMap

     oOptions = ThisApplication.TransientObjects.CreateNameValueMap

    ' Create a DataMedium object

    Dim oDataMedium As DataMedium

     oDataMedium = ThisApplication.TransientObjects.CreateDataMedium

oOptions.Value("Sheet_Range") = kPrintCurrentSheet

    ' Check whether the translator has 'SaveCopyAs' options

    If PDFAddIn.HasSaveCopyAsOptions(oDocument, oContext, oOptions) Then

        ' Options for drawings...

oOptions.Value("Sheet_Range") = Inventor.PrintRangeEnum.kPrintCurrentSheet

        oOptions.Value("All_Color_AS_Black") = 0

' oOptions.Value("Sheet_Range") = kPrintAllSheet

        'oOptions.Value("Remove_Line_Weights") = 0

        'oOptions.Value("Vector_Resolution") = 400 

        'oOptions.Value("Custom_Begin_Sheet") = 2

        'oOptions.Value("Custom_End_Sheet") = 4

    End If

    ' the destination file name

'oDataMedium.FileName = ThisDoc.PathAndFileName(False)&".pdf"

Dim sPath = ThisDoc.Path

Dim sFolder = "Výkresy PDF"

Dim sFile = ThisDoc.FileName(False)

Dim oPDFFolder = System.IO.Path.Combine(sPath, sFolder)

'Check for the PDF folder and create it if it does not exist

If Not System.IO.Directory.Exists(oPDFFolder) Then

    System.IO.Directory.CreateDirectory(oPDFFolder)

End If

oDataMedium.FileName = System.IO.Path.Combine(sPath, sFolder, sFile & ".pdf")

' Dim outputFile As String

' outputFile = ThisDoc.PathAndFileName(False)&"_"&iProperties.Value("Project", "Revision Number")&".pdf"

    'Publish document.

    Call PDFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)

End Sub

[Andrii_Humeniuk · Accepted solution]

Hi @DeptaM . I made some changes to your code. Now it works properly. Try it please.

Sub Main PublishPDF()
	Dim oInvApp As Inventor.Application
	oInvApp = ThisApplication
	' Get the PDF translator Add-In.
	Dim PDFAddIn As TranslatorAddIn
	PDFAddIn = oInvApp.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")
	
	' a reference to the active document (the document to be published).
	Dim oDocument As Document
	oDocument = oInvApp.ActiveDocument
	
	If Not TypeOf oDocument Is DrawingDocument Then Exit Sub
	Dim oDDoc As DrawingDocument
	oDDoc = oDocument
	
	Dim oContext As TranslationContext
	oContext = oInvApp.TransientObjects.CreateTranslationContext
	oContext.Type = kFileBrowseIOMechanism
	
	' Create a NameValueMap object
	Dim oOptions As NameValueMap
	oOptions = oInvApp.TransientObjects.CreateNameValueMap
	
	' Create a DataMedium object
	Dim oDataMedium As DataMedium
	oDataMedium = oInvApp.TransientObjects.CreateDataMedium
	
	oOptions.Value("Sheet_Range") = kPrintCurrentSheet
	
	' Check whether the translator has 'SaveCopyAs' options
	If PDFAddIn.HasSaveCopyAsOptions(oDocument, oContext, oOptions) Then
	
		' Options for drawings...
		oOptions.Value("Sheet_Range") = Inventor.PrintRangeEnum.kPrintCurrentSheet
		oOptions.Value("All_Color_AS_Black") = 0
		' oOptions.Value("Sheet_Range") = kPrintAllSheet
		'oOptions.Value("Remove_Line_Weights") = 0
		'oOptions.Value("Vector_Resolution") = 400 
		'oOptions.Value("Custom_Begin_Sheet") = 2
		'oOptions.Value("Custom_End_Sheet") = 4
	
	End If
	
	' the destination file name
	'oDataMedium.FileName = ThisDoc.PathAndFileName(False)&".pdf"
	Dim sPath = IO.Path.GetDirectoryName(oDocument.FullDocumentName)
	Dim sFolder = "Výkresy PDF"
	Dim sFile = oDDoc.ActiveSheet.Name
	
	Dim oPDFFolder = System.IO.Path.Combine(sPath, sFolder)
	
	'Check for the PDF folder and create it if it does not exist
	If Not System.IO.Directory.Exists(oPDFFolder) Then
		System.IO.Directory.CreateDirectory(oPDFFolder)
	End If
	sFile = sFile.Replace(":", "(") & ")"
	oDataMedium.FileName = System.IO.Path.Combine(sPath, sFolder, sFile & ".pdf")

	' Dim outputFile As String
	' outputFile = ThisDoc.PathAndFileName(False)&"_"&iProperties.Value("Project", "Revision Number")&".pdf"
	
	'Publish document.
	Call PDFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)
End Sub

[DeptaM]

Good day,
thank you very much, this helped me.
Have a nice day