Code:
Imports InventorModule Module1
Public AuftrNr As String
Public letzteRev As String
Public Pfad As String
Public ThisApplication As Inventor.Application
Public oDrawDoc As Inventor.DrawingDocument
Public opropsets As PropertySets
Public odtPropertySet As PropertySet
Public apprentice As New Inventor.ApprenticeServerComponent
Public apprenticeDoc As Inventor.ApprenticeServerDocument
Public anzahl As Integer
Public ErstesBlatt As Integer
Public Zeilenabstand As Integer
Public oCheckbox(30) As System.Windows.Forms.CheckBox
Public AuswahlBlatt(30) As String
Sub main()
Try
Try
ThisApplication = GetObject(, "Inventor.Application")
oDrawDoc = ThisApplication.ActiveDocument
Catch ex As Exception
MsgBox("Die geöffnete Datei ist keine Zeichnung!" & vbCrLf & ex.StackTrace, vbCritical, "Fehler!")
Exit Sub
End Try
'iProperties abrufen mit Apprentice (müssen schon angelegt sein)
opropsets = oDrawDoc.PropertySets
odtPropertySet = opropsets.Item("Inventor User Defined Properties")
Try
AuftrNr = odtPropertySet.Item("AuftragsNr").Value
Catch ex As Exception
AuftrNr = ""
End Try
Try
letzteRev = odtPropertySet.Item("K letzte Rev").Value
Catch ex As Exception
letzteRev = ""
End Try
Form1.ShowDialog()
Exit Sub
' Get the PDF translator Add-In.
Dim PDFAddIn As TranslatorAddIn
PDFAddIn = ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")
Dim oContext As TranslationContext
oContext = ThisApplication.TransientObjects.CreateTranslationContext
oContext.Type = IOMechanismEnum.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
' Check whether the translator has 'SaveCopyAs' options
If PDFAddIn.HasSaveCopyAsOptions(oDrawDoc, oContext, oOptions) Then
' Options for drawings...
oOptions.Value("All_Color_AS_Black") = 0
oOptions.Value("Sheet_Range") = PrintRangeEnum.kPrintAllSheets
'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
'Dateinamen der PDF festlegen
If Len(AuftrNr) < 3 Then
oDataMedium.FileName = Mid(oDrawDoc.FullDocumentName, 1, Len(oDrawDoc.FullDocumentName) - 3) & "pdf"
Else
oDataMedium.FileName = Mid(oDrawDoc.FullDocumentName, 1, InStrRev(oDrawDoc.FullDocumentName, "\")) & AuftrNr & ".pdf"
End If
'Publish document.
Call PDFAddIn.SaveCopyAs(oDrawDoc, oContext, oOptions, oDataMedium)
Catch ex As Exception
MsgBox("Es gab ein Fehler beim erstellen der PDF!" & vbCrLf & ex.StackTrace, vbCritical, "Fehler!")
End Try
End Sub
End Module