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

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.