---

Hallo Zusammen

ich wollte die iLogic Regel so umschreiben damit ich DWG erzeuge.

bekomme aber das mit dem DWG Addin nicht hin.

kann mir einer von euch helfen?

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

'check that the active document is an assembly file
If ThisApplication.ActiveDocument.DocumentType <> kAssemblyDocumentObject Then
MessageBox.Show("Bitte führen Sie die Regel aus der Baugruppendatei aus.","iLogic")
Exit Sub
End If

'get user input
RUsure = MessageBox.Show ( _
"Es wird eine PDF für alle Komponent der Baugruppe die eine Zeichnung referenzieren erstellt." _
& vbLf & "Die Zeichnung der Komponente muß den gleichen Namen & Speicherort wie die Komponente haben." _
& vbLf & " " _
& vbLf & "Sind Sie sicher, dass Sie PDF Zeichnungen für alle Komponenten der Baugruppe erstellen wollen?" _
& vbLf & "Dieser Vorgang kann einige Minuten dauern", "iLogic  - Batch Output 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") = 0
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 Files"

'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
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("Erstellung der PDf's im Ordner: " & vbLf & oFolder, "iLogic")
'open the folder where the new ffiles are saved
Shell("explorer.exe " & oFolder,vbNormalFocus)

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

---

Unbenannt.JPG

Habe mal versucht den Code umzuschreiben.
Bekomme aber eine Fehlermeldung

Fehlermeldung: Falscher Parameter

Komme nicht weiter, weis jemand Rat?

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

---

Wäre mal interessant zu sehen, was du draus gemacht hast, hier kann man ja deinen gfehler nicht nachvollziehen.

------------------
Gruß, Gandhi
It's not a bug, it's a feature!

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

---

Sorry
Anhang vergessen!

Hier noch einmal was ich versucht habe.

'------start of iLogic-------

oPath = ThisDoc.Path
oFileName = ThisDoc.FileName(False) 'without extension
oDWGAddIn = ThisApplication.ApplicationAddIns.ItemById("{C24E3AC4-122E-11D5-8E91-0010B541CD80}")
oContext = ThisApplication.TransientObjects.CreateTranslationContext
oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
oOptions = ThisApplication.TransientObjects.CreateNameValueMap
oDataMedium = ThisApplication.TransientObjects.CreateDataMedium

' Prüfen ob eine Baugruppe geöffnet ist
If ThisApplication.ActiveDocument.DocumentType <> kAssemblyDocumentObject Then
MessageBox.Show("Diese Funktion kann nur in einer Baugruppe (.iam) ausgeführt werden!", _
"INFO")
Exit Sub
End If

'Ordnername für die Zeichnungen
oFolder = oPath & "\" & oAsmName & " - DWG's"

'Prüfen ob es den Ordner gibt, wenn nicht wird er erstellt
If Not System.IO.Directory.Exists(oFolder) Then
    System.IO.Directory.CreateDirectory(oFolder)
End If

If oDWGAddIn.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

' DWG Zielordnerpfad
oFolder = Left(oPath, InStrRev(oPath, "\")) & "DWG"

'Prüft ob DWG Ordner vorhanden, wenn nicht wird er erstellt
If Not System.IO.Directory.Exists(oFolder) Then
    System.IO.Directory.CreateDirectory(oFolder)
End If

'erstellt Dateinamen
oDataMedium.FileName = oFolder & "\" & oFileName & _
" Rev" & oRevNum & ".dwg"

'Dokument veröffentlichen
oDWGAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)
'------end of iLogic-------

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

---

Du prüfst also nach, ob eine Baugruppe geöffnet ist und möchtest diese als dwg speichern?
Ist das korrekt?

------------------
mit freundlichem Gruß
aus Mönchengladbach
Lothar Boekels

-----------------------------------------------------
Wir unterstützen die Arbeit der
Rettungshundestaffel des DRK in Viersen

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

---

Hi,

@Lothar die ursprüngliche Ilogic Regel
speichert von einer geöffneten Baugruppe jedes referenzierte/enthaltene Teil in eine eigene PDF die PDFen werden dann in einem eigenen Ordner für PDF der Baugruppe abgelegt also schon ein bißchen umfangreicher als nur eine dwg von einer Baugruppe zu erstellen

aber einfach rauszufinden wenn man das mal übersetzt...
oder die Ilogicregel kopiert und ausprobiert        ...
'Define the active document as an assembly file
'check that the active document is an assembly file
'get user input
'get PDF target folder path
'Check for the PDF folder and create it if it does not exist
'look at the files referenced by the assembly
'work the the drawing files for the referenced models
'this expects that the model has a drawing of the same path and name
'If the model has no drawing of the same path and name - do nothing
'check to see that the model has a drawing of the same path and name
'write out the PDF for the Top Level Assembly Drawing file

u
s
w ...

Jetzt soll die selbe Art der Konvertierung mit dwg erfolgen.

MfG MacFly

------------------
- - - der Erleuchtung ist es egal wie du Sie erlangst - - -
- - - Wir leben alle unter demselben Himmel, aber wir haben nicht alle denselben Horizont - - - (K. Adenauer)

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

---

Hallo MacFly8

so habe den Code mal umgeschrieben.
Es wird ein Ordner der Baugruppe angelegt.
Die Zeichnungen der IAM's und ipt's werden geöffnet soweit in Ordnung
Wenn die Regel dann durchgelaufen ist wird der Ordner geöffnet auch in Ordnung.
Jetzt das Problem der Ordner ist leer,keine Ahnung was da schief läuft.

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

'check that the active document is an assembly file
If ThisApplication.ActiveDocument.DocumentType <> kAssemblyDocumentObject Then
MessageBox.Show("Bitte führen Sie die Regel aus der Baugruppendatei aus.","iLogic")
Exit Sub
End If

''get user input
'RUsure = MessageBox.Show ( _
'"Es wird eine DWG für alle Komponent der Baugruppe die eine Zeichnung referenzieren erstellt." _
'& vbLf & "Die Zeichnung der Komponente muß den gleichen Namen & Speicherort wie die Komponente haben." _
'& vbLf & " " _
'& vbLf & "Sind Sie sicher, dass Sie DWG Zeichnungen für alle Komponenten der Baugruppe erstellen wollen?" _
'& vbLf & "Dieser Vorgang kann einige Minuten dauern", "iLogic  - Batch Output DWGs ",MessageBoxButtons.YesNo)

If RUsure = vbNo Then
Return
Else
End If

'- - - - - - - - - - - - -DWG setup - - - - - - - - - - - -
oPath=ThisDoc.Path
Dim DWGAddIn As TranslatorAddIn
oDWGAddIn = ThisApplication.ApplicationAddIns.ItemById("{C24E3AC4-122E-11D5-8E91-0010B541CD80}")
'Set a reference to the active document (the document to be published).
Dim oDocument As Document
oDocument = ThisApplication.ActiveDocument
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

'get DWG target folder path
oFolder = oPath & "\" & oAsmName & " DWG Files"

'Check for the DWG 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 DWG exists And Is open Or read only, Resume Next
                'Set the DWG target file name
                oDataMedium.FileName = oFolder & "\" & oFileName & "dwg"
'Write out the DWG
                Call DWGAddIn.SaveCopyAs(oDrawDoc, oContext, oOptions, oDataMedium)
'close the file
                oDrawDoc.Close
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 DWG for the Top Level Assembly Drawing file
On Error Resume Next ' if DWG exists and is open or read only, resume next
'Set the DWG target file name
oDataMedium.FileName = oFolder & "\" & oAsmDrawingName & "dwg"
'Write out the DWG
Call DWGAddIn.SaveCopyAs(oAsmDrawingDoc, oContext, oOptions, oDataMedium)
'Close the top level drawing
oAsmDrawingDoc.Close
'- - - - - - - - - - - - -

'MessageBox.Show("Erstellung der DWG's im Ordner: " & vbLf & oFolder, "iLogic")
''open the folder where the new ffiles are saved
'Shell("explorer.exe " & oFolder,vbNormalFocus)

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