---

Hallo Inventor Gemeinde,
ich bin schon seit längerem aktiver Mitleser eure Beiträge, und nun stehe ich vor einem Problem
und komme nicht weiter.
Nach langer Suche zu dem Thema bleibt mir nichts über als die "Meister" um Hilfe zu bitten.

Ich habe ein Regel gefunden die wunderbar alle Zeichnungen als PDF aus einer Baugruppe ablegt.
Jetzt soll nur noch der Name der in den iProperty steht hinter den Dateinamen geschrieben werden-> gekennzeichnet mit 
Bei der Zeichnung der Oberbaugruppe klappt das schon....
------------------------------------------------

'Sicherstellen das das Dokument eine Baugruppe ist
If ThisApplication.ActiveDocument.DocumentType <> kAssemblyDocumentObject Then
MessageBox.Show("Bitte die Regel innerhalb einer Baugruppe ausführen!", "iLogic")
Exit Sub
End If

'Prüfen des Dokuments
Dim oAsmDoc As AssemblyDocument
oAsmDoc = ThisApplication.ActiveDocument
oAsmName = Left(oAsmDoc.DisplayName, Len(oAsmDoc.DisplayName) -4)

'Massagebox mit aufforderungen
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") = 1
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

'gehe zum PDF Zielordnerpfad
oFolder = oPath & "\" & oAsmName & "-" &iProperties.Value("Custom", "NameDE")

'prüfung ob Zeilordner vorhanden ist, wenn nicht erstellung des Zielordners
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) -4) & oDocName

            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  & oDocName & ".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) -4)
'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 &" " &iProperties.Value("Project", "Revision Number")&" "&iProperties.Value("custom", "NameDe")& ".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)

-------------------------ENDE REGEL

Vllt habt Ihr da schon etwas?!

Vielen Dank,
ArenMcFly

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo...

Folgender Code (ungetestet):

Code:

---

'- - - - - - - - - - - - -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 oDPS as PropertySet
Set oDPS = oRefDoc.PropertySets.Item("Design Tracking Properties")

Dim oCPS as PropertySet
Set oCPS = oRefDoc.PropertySets.Item("Inventor Custom Properties")

Dim strRevision as String
Set strRevision = oPDS.Properties.Item("Revision Number").value

Dim strNameDe as String
Set strNameDe = oCPS.Properties.Item("NameDe").value

                        Dim oDrawDoc As DrawingDocument
                oDrawDoc = ThisApplication.Documents.Open(idwPathName, True)
            oFileName = Left(oRefDoc.DisplayName, Len(oRefDoc.DisplayName) -4) & oDocName
            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  & oDocName & " " & strRevision & " " & strNameDe & ".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
'- - - - - - - - - - - - -

---

------------------
Mit Besten Grüßen

Ruzy5624

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Ruzy5624,

vielen Dank für deine Antwort.

Leider gibt Inventor mir die Fehlermeldung " Set und let wird nicht mehr unterstützt"
aus. Und "oPDS ist nicht definiert".

Hast du vllt noch eine Idee?

Gruß,
ArenMcFly

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Oh sry, da habe ich wohl zu flüchtig geschaut und gar nicht bemerkt das es sich bei deinem Code um iLogic Code handelt...
Mein Code war VBA 

Streiche einfach die vier "Set" aus meinem Code und teste es dann nochmal...

Bin mir gerade auch nicht 100% sicher, ob ich vom "oRefDoc" direkt auf die Properties zugreifen kann.
Sollte das nicht gehen, dann passe ich meinen Code aber gerne nochmal entsprechend an 

------------------
Mit Besten Grüßen

Ruzy5624

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Ruzy5624,

habe gerade versucht die Regel auszuführen, leider hat es nicht geklappt.
Es kommt immernoch folgende Fehlermeldung.

"Fehler in Zeile 74 : "oPDS" ist nicht deklariert. Auf das Objekt kann aufgrund der Schutzstufe möglicherweise nicht zugegriffen werden."

Ich danke dir nochmals für deine Hilfe!

Grüße,
ArenMcFly

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP