VB.NET DWG PDF

Imports Inventor
Imports System
Imports System.Drawing
Imports System.Windows.Forms
Imports System.IO
Module Makros
    Dim oDocument As Document
    Dim transObjs As TransientObjects
    Dim oContext As TranslationContext
    Dim oOptions As NameValueMap
    Dim oDataMedium As DataMedium
    Dim oDrawDoc As DrawingDocument
    Dim oReferencedDoc As Document
    Dim oPropValue As String
    Dim oDoc As Document
    Dim Länge_Dateiname_mit_Pfad As Integer
    Dim Name_Pfad As String
    Dim Länge_String As Integer
    Dim Dateiname_mit_Pfad As String
    Dim Dateiname As String
    Dim oPropSets As PropertySets
    Dim oPropSet As PropertySet
    Dim i As Integer
    Dim Pfad As String
    Public Sub DWG(ByVal ThisApplication As Inventor.Application)
        On Error Resume Next
        'DWG Translator AddIn
        Dim DWGAddIn As TranslatorAddIn
        DWGAddIn = ThisApplication.ActiveDocument

        oDocument = ThisApplication.ActiveDocument

        transObjs = ThisApplication.TransientObjects

        oContext = ThisApplication.TransientObjects.CreateTranslationContext
        oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism

        'Erstellung der NameValueMap Objekte
        oOptions = transObjs.CreateNameValueMap
        'Erstellung des DataMedium Objekts
        oDataMedium = transObjs.CreateDataMedium


        oDoc = ThisApplication.ActiveDocument


        '____________________________________________iProperties________________________________________________
        'iProperties Objekte erstellen
        oPropSets = oDoc.PropertySets

        'Feld "Status" auswählen
        oPropSet = oPropSets.Item("Design Tracking Properties")

        'Status der ipt
        oDrawDoc = ThisApplication.ActiveDocument
        oReferencedDoc = oDrawDoc.ReferencedDocuments.Item(1)

        'Speicher für den Wert von "Status"
        oPropValue = oReferencedDoc.PropertySets.Item("{32853F0F-3444-11D1-9E93-0060B03C1CA6}").Item("User Status").Value
        '____________________________________________iProperties________________________________________________

        Dateiname_mit_Pfad = oDoc.FullFileName
        Länge_Dateiname_mit_Pfad = Len(Dateiname_mit_Pfad)
        Name_Pfad = Mid(Dateiname_mit_Pfad, 1, Länge_Dateiname_mit_Pfad - 4)
        Länge_String = Len(Name_Pfad)
        MsgBox(Name_Pfad)
        i = 1
        Do Until Mid(Name_Pfad, Länge_String - i, 1) = "\"
            i = i + 1
        Loop

        Dateiname = Right(Name_Pfad, i)
        Name_Pfad = Mid(Dateiname_mit_Pfad, 1, Länge_Dateiname_mit_Pfad - i)

        '_______________________________________________DWG________________________________________________
        If DWGAddIn.HasSaveCopyAsOptions(oDocument, oContext, oOptions) Then
            oOptions.Value("Solid") = True
            oOptions.Value("Surface") = False
            oOptions.Value("Sketch") = False

            'DWG Version festlegen
            '23 = ACAD 2000 - AC1015
            '25 = ACAD 2004 - AC1018
            '27 = ACAD 2007
            '29 = ACAD 2010 - AC1024
            oOptions.Value("DwgVersion") = 25
        End If
        '_______________________________________________DWG________________________________________________

        'Ordnerauswahl einfügen
        'Pfad = "J:\"
        Pfad = Form1.FolderBrowserDialog1.SelectedPath

        If oPropValue = "" Then
            oDataMedium.FileName = Pfad & "\" & Dateiname & ".dwg"
        Else
            oDataMedium.FileName = Pfad & "\" & Dateiname & "_" & oPropValue & ".dwg"
        End If

        If Not Pfad = "" Then
            Call DWGAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)
            If Form1.alert.Checked = True Then
                MsgBox("DWG Export abgeschlossen!", MsgBoxStyle.OkOnly, "DWG Erstellt!")
            End If
        Else
            MsgBox("Export abgebrochen, kein Verzeichnis gewählt!", MsgBoxStyle.OkOnly, "Abbruch!")
        End If
    End Sub
    Public Sub PDF(ByVal ThisApplication As Inventor.Application)
        On Error Resume Next
        'PDF Translator AddIn
        Dim PDFAddIn As TranslatorAddIn
        PDFAddIn = ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")

        'Referenz zum aktiven Dokument
        oDocument = ThisApplication.ActiveDocument

        oContext = ThisApplication.TransientObjects.CreateTranslationContext
        oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism

        'NameValueMap erstellung
        oOptions = ThisApplication.TransientObjects.CreateNameValueMap

        'DataMedium erstellen
        oDataMedium = ThisApplication.TransientObjects.CreateDataMedium

        If PDFAddIn.HasSaveCopyAsOptions(oDocument, oContext, oOptions) Then
            'Darstellungsoptionen
            oOptions.Value("All_Color_AS_Black") = 0
        End If
        '_______________________________________________________________________________iProperties___________________
        oPropSets = oDoc.PropertySets
        oPropSet = oPropSets.Item("Design Tracking Properties")

        oDrawDoc = ThisApplication.ActiveDocument
        oReferencedDoc = oDrawDoc.ReferencedDocuments.Item(1)

        oPropValue = oReferencedDoc.PropertySets.Item("{32853F0F-3444-11D1-9E93-0060B03C1CA6}").Item("User Status").Value
        '_______________________________________________________________________________iProperties___________________

        Dateiname_mit_Pfad = oDoc.FullFileName
        Länge_Dateiname_mit_Pfad = Len(Dateiname_mit_Pfad)
        Name_Pfad = Mid(Dateiname_mit_Pfad, 1, Länge_Dateiname_mit_Pfad - 4)
        Länge_String = Len(Name_Pfad)

        i = 1
        Do Until Mid(Name_Pfad, Länge_String - i, 1) = "\"
            i = i + 1
        Loop

        Dateiname = Right(Name_Pfad, i)
        Name_Pfad = Mid(Dateiname_mit_Pfad, 1, Länge_Dateiname_mit_Pfad - i)

        'Ordnerauswahl einfügen
        Pfad = Form1.FolderBrowserDialog1.SelectedPath

        If oPropValue = "" Then
            oDataMedium.FileName = Pfad & "\" & Dateiname & ".pdf"
        Else
            oDataMedium.FileName = Pfad & "\" & Dateiname & "_" & oPropValue & ".pdf"
        End If
        Call PDFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)
        MsgBox("PDF Export abgeschlossen!", vbOKOnly, "PDF Erstellt!")
        Process.Start(oDataMedium.FileName)
    End Sub
End Module