'check that the active document is an assembly file
If ThisApplication.ActiveDocument.DocumentType <> kAssemblyDocumentObject Then
MessageBox.Show("Bitte die Regel innerhalb einer Baugruppe ausführen!", "iLogic")
Exit Sub
End If

'define the active document as an assembly file
Dim oAsmDoc As AssemblyDocument
oAsmDoc = ThisApplication.ActiveDocument
oAsmName = Left(oAsmDoc.DisplayName, Len(oAsmDoc.DisplayName) -4)

'get user input
RUsure = MessageBox.Show ( _
"Diese Regel wird alle in der Baugruppe enthaltenen Zeichnungen als PDF ausgeben." _
& vbLf & "Die Regel erwartet dass die Zeichnung den gleichen Namen und Speicherort wie das Bauteil hat." _
& vbLf & " " _
& vbLf & "Möchten Sie alle PDF Dateien erstellen?", "iLogic  - Batch PDFs ",MessageBoxButtons.YesNo)

If RUsure = vbNo Then
Return
Else
End If

'- - - - - - - - - - - - -PDF setup - - - - - - - - - - - -
oPath = ThisDoc.Path
PDFAddIn = ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")
oContext = ThisApplication.TransientObjects.CreateTranslationContext
oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
oOptions = ThisApplication.TransientObjects.CreateNameValueMap
oDataMedium = ThisApplication.TransientObjects.CreateDataMedium

If PDFAddIn.HasSaveCopyAsOptions(oDataMedium, oContext, oOptions) Then
'oOptions.Value("All_Color_AS_Black") = 0
oOptions.Value("Remove_Line_Weights") = 1
oOptions.Value("Vector_Resolution") = 400
oOptions.Value("Sheet_Range") = Inventor.PrintRangeEnum.kPrintAllSheets
'oOptions.Value("Custom_Begin_Sheet") = 2
'oOptions.Value("Custom_End_Sheet") = 4
End If

'get PDF target folder path
oFolder = oPath & "\" & oAsmName & "-PDF"

'Check for the PDF folder and create it if it does not exist
If Not System.IO.Directory.Exists(oFolder) Then
    System.IO.Directory.CreateDirectory(oFolder)
End If
'- - - - - - - - - - - - -

'- - - - - - - - - - - - -Component Drawings - - - - - - - - - - - -
'look at the files referenced by the assembly
Dim oRefDocs As DocumentsEnumerator
oRefDocs = oAsmDoc.AllReferencedDocuments
Dim oRefDoc As Document

'work the the drawing files for the referenced models
'this expects that the model has a drawing of the same path and name
For Each oRefDoc In oRefDocs
idwPathName = Left(oRefDoc.FullDocumentName, Len(oRefDoc.FullDocumentName) - 3) & "idw"
'check to see that the model has a drawing of the same path and name
If(System.IO.File.Exists(idwPathName)) Then
                        Dim oDrawDoc As DrawingDocument
                oDrawDoc = ThisApplication.Documents.Open(idwPathName, True)
            oFileName = Left(oRefDoc.DisplayName, Len(oRefDoc.DisplayName) -3)

            On Error Resume Next ' if PDF exists and is open or read only, resume next
                 'Set the PDF target file name
                oDataMedium.FileName = oFolder & "\" & oFileName & "pdf"
                'Write out the PDF
                Call PDFAddIn.SaveCopyAs(oDrawDoc, oContext, oOptions, oDataMedium)
            'close the file
                oDrawDoc.Close(True)
Else
'If the model has no drawing of the same path and name - do nothing
End If
Next
'- - - - - - - - - - - - -

'- - - - - - - - - - - - -Top Level Drawing - - - - - - - - - - - -
oAsmDrawing = ThisDoc.ChangeExtension(".idw")
oAsmDrawingDoc = ThisApplication.Documents.Open(oAsmDrawing, True)
oAsmDrawingName = Left(oAsmDrawingDoc.DisplayName, Len(oAsmDrawingDoc.DisplayName) -3)
'write out the PDF for the Top Level Assembly Drawing file
On Error Resume Next ' if PDF exists and is open or read only, resume next
 'Set the PDF target file name
oDataMedium.FileName = oFolder & "\" & oAsmDrawingName & "pdf"
'Write out the PDF
Call PDFAddIn.SaveCopyAs(oAsmDrawingDoc, oContext, oOptions, oDataMedium)
'Close the top level drawing
oAsmDrawingDoc.Close
'- - - - - - - - - - - - -

MessageBox.Show("Neue Dateien erstellt in: " & vbLf & oFolder, "iLogic")
'open the folder where the new ffiles are saved
Shell("explorer.exe " & oFolder,vbNormalFocus)