Hi, klar hier ist es:
Option Explicit
Const EXPORTPATH As String = "C:\Temp\"
Public Sub ExportPDF()
On Error Resume Next
Dim oApp As Inventor.Application
Set oApp = ThisApplication
Dim oDrawDoc As DrawingDocument
Set oDrawDoc = ThisApplication.ActiveDocument
'Prüfung richtiges Dokument geöffnet
If oApp.Documents.Count = 0 Then Exit Sub
If oApp.ActiveDocument.DocumentType <> kDrawingDocumentObject Then
MsgBox "Funktion ist nur in Zeichnungen zulässig"
Exit Sub
End If
Dim oFileSystem As Object
Set oFileSystem = CreateObject("Scripting.FilesystemObject")
Dim PDFAddIn As TranslatorAddIn
Set PDFAddIn = ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")
Dim oContext As TranslationContext
Set oContext = ThisApplication.TransientObjects.CreateTranslationContext
oContext.Type = kFileBrowseIOMechanism
Dim oOptions As NameValueMap
Set oOptions = ThisApplication.TransientObjects.CreateNameValueMap
Dim oDataMedium As DataMedium
Set oDataMedium = ThisApplication.TransientObjects.CreateDataMedium
'Optionen für PDF Export wählen
If PDFAddIn.HasSaveCopyAsOptions(oDrawDoc, oContext, oOptions) Then
oOptions.Value("All_Color_AS_Black") = 0
oOptions.Value("Remove_Line_Weights") = 1
oOptions.Value("Vector_Resolution") = 4800
oOptions.Value("Sheet_Range") = kPrintAllSheets
'oOptions.Value("Custom_Begin_Sheet") = 2
'oOptions.Value("Custom_End_Sheet") = 4
End If
'Titel
Dim oTitle As String
oTitle = oDrawDoc.PropertySets.Item(1).Item(1).Expression
'Teilenummer
Dim oPrtNo As String
oPrtNo = oDrawDoc.PropertySets.Item("Design Tracking - Eigenschaften").Item("Part Number").Expression
'Zeichen aus Titel filtern
oTitle = Replace(oTitle, "/", "-")
oTitle = Replace(oTitle, "\", "-")
oTitle = Replace(oTitle, ":", "-")
oTitle = Replace(oTitle, "*", "-")
oTitle = Replace(oTitle, "?", "-")
oTitle = Replace(oTitle, "<", "-")
oTitle = Replace(oTitle, ">", "-")
oTitle = Replace(oTitle, "|", "-")
'Zeichnungsnummer
Dim oDrwNo As String
oDrwNo = oFileSystem.GetFilename(oDrawDoc.FullFileName)
'Revision
Dim oRev As String
oRev = oDrawDoc.PropertySets.Item("Inventor User Defined Properties").Item("Revision").Expression
'Dateiname ermittlen
Dim oDaNa As String
oDaNa = EXPORTPATH + oPrtNo & "_" & oDrwNo & "_" & oRev & "_" & oTitle
'Dateierweiterung ermitteln
Dim oDen As String
oDen = ".pdf"
'Dateiname festlegen
Dim FileName As String
FileName = oDaNa & oDen
' PDF speichern unter
oDataMedium.FileName = FileName
Call PDFAddIn.SaveCopyAs(oDrawDoc, oContext, oOptions, oDataMedium)
' Zoom
oDrawDoc.Views.Item(1).Fit
' Explorer starten
'Call VBA.Shell("explorer " & EXPORTPATH, vbNormalFocus)
End Sub
Ich habe gesucht ob in der Registry noch ein "oOptions.Value("")" schaltet habe aber nichts gefunden.
Das Kontrollkästchen im Inventor Export "Publizierte Datei Im Viewer anzeigen" demnach vermutlich nicht über die Registry mit beeinflusst. Sondern ist eine manuelle ak- oder deaktiverung.
