---

Hallo,
ist es möglich mit einem Makro eine Zeichnung mit zwei oder mehr Blättern in einem Durchgang als
dxf (für Zulieferer), pdf (für Zeichnungsaustausch) und dwfx (für die Fertigung) in den selben Ordner,
wo die entsprechende Zeichnung liegt, auszugeben.
Ich habe schon etwas mit dem VB Tool experimentiert und verschiedene Makros aus dem Forum versucht.
Einzelne pdf-Blätter habe ich herausbekommen.
Ebenso auch mehrere dxf-Blätter.
dwfx wollte nicht so richtig.
Grundlegende Programmierkenntnisse habe ich, jedoch bin ich schon sehr lange raus.
Es währe schön, wenn mir jemand eine Hilfestellung geben könnte, wie ich das Makro aufbaue und wie den Export von dwfx erledigen kann.
Es sollen einfach nur die Dateien abgelegt werden (Alte überschrieben), damit alle den selben Stand haben.
Gruß

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

---

Hallo...
Sollte möglich sein...
Ungetestet:

Code:

---

Sub drawing()

Dim oapp As Inventor.Application
Set oapp = ThisApplication
Dim odoc As Inventor.DrawingDocument
Dim osource As String
Dim odest As String

If oapp.ActiveDocument Is Nothing Then
    Exit Sub
End If

If oapp.ActiveDocumentType <> kDrawingDocumentObject Then
    Exit Sub
End If

Set odoc = oapp.ActiveDocument
osource = odoc.FullFileName
odest = Left(osource, Len(osource) - 4)

Dim osheet As Inventor.Sheet
Dim counter As String

counter = 1

For Each osheet In odoc.Sheets
osheet.Activate
Call odoc.SaveAs(odest & "Blatt" & counter & ".dxf", True)
Call odoc.SaveAs(odest & "Blatt" & counter & ".pdf", True)
Call odoc.SaveAs(odest & "Blatt" & counter & ".dwfx", True)
counter = counter + 1
Next

End Sub

---

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

---

@noctis79
Danke für den Code, funktioniert erst mal ganz gut.
Hab es mal getestet.
Er wirft mit jedes Blatt einzeln als pdf, dxf und dwfx raus.
Wie müsste man den Code anpassen, damit er die einzelnen Blätter in eine dwfx zusammenfasst.
Bei dxf ist das vereinzeln ok.
Eine weitere Frage ist, wie kann man vermeiden, das er bei einem Blatt immer Blatt1 dahinter schreibt.
Nach meinen Erfahrungen muss man doch noch einmal eine IF Schleife einbauen die abfragt, wie viele Blätter es sind und dann entsprechend weiter macht.
Welches Objekt zeigt mit die Anzahl der Blätter im Dokument?
Seh ich das Richtig?
Danke

Edit:
Meine Lösung:
Sub drawing()

Dim oapp As Inventor.Application
Set oapp = ThisApplication
Dim odoc As Inventor.DrawingDocument
Dim osource As String
Dim odest As String

If oapp.ActiveDocument Is Nothing Then
    Exit Sub
End If

If oapp.ActiveDocumentType <> kDrawingDocumentObject Then
    Exit Sub
End If

Set odoc = oapp.ActiveDocument
osource = odoc.FullFileName
odest = Left(osource, Len(osource) - 4)

Dim osheet As Inventor.Sheet
Dim counter As String
Dim zaehler As String

zaehler = 0
counter = 1

For Each osheet In odoc.Sheets
osheet.Activate
zaehler = zaehler + 1
Next

If zaehler = 1 Then
    Call odoc.SaveAs(odest & ".dxf", True)
    Call odoc.SaveAs(odest & ".pdf", True)
    Call odoc.SaveAs(odest & ".dwfx", True)
Exit Sub
End If

For Each osheet In odoc.Sheets
osheet.Activate
Call odoc.SaveAs(odest & "Blatt" & counter & ".dxf", True)
Call odoc.SaveAs(odest & "Blatt" & counter & ".pdf", True)
Call odoc.SaveAs(odest & "Blatt" & counter & ".dwfx", True)
counter = counter + 1
Next

End Sub

[Diese Nachricht wurde von themass am 19. Feb. 2013 editiert.]

[Diese Nachricht wurde von themass am 20. Feb. 2013 editiert.]

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

---

Hallo,

hm.. wenn Du alle Blätter haben willst, würde ich über das
Translator AddIn gehen...

Siehe hierzu:
Beitrag

Den Namen baust du ja im Call- Befehl zusammen:

Code:

---

Call odoc.SaveAs(odest & "Blatt" & counter & ".dxf", True)

---

Wenn Du hier

Code:

---

& "Blatt"

---

entfernst kommt dann die laufende Nummerierung ohne "Blatt".
Die Anzahl der Blätter brauchst du für die schleife nicht.
Du durchläufst ja alle Blätter mit der For Each- Schleife.

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

---

Hier noch mal mein angepasster Code.
Der legt die Zeichnungen als dwfx in einer Datei ab und vereinzelt die Blätter als pdf und dxf.

Sub dxf_pdf_dwfx_export()

Dim AddIns As ApplicationAddIns
Set AddIns = ThisApplication.ApplicationAddIns

Dim oapp As Inventor.Application
Set oapp = ThisApplication
Dim odoc As Inventor.DrawingDocument
Dim osource As String
Dim odest As String

Dim DWFAddIn As TranslatorAddIn
Dim i As Integer
For i = 1 To AddIns.Count
If AddIns(i).AddInType = kTranslationApplicationAddIn Then
If AddIns(i).ClassIdString = "{0AC6FD95-2F4D-42CE-8BE0-8AEA580399E4}" Then
Set DWFAddIn = AddIns.Item(i)
Exit For
End If
End If
Next i

Dim oDocument As Document
Set oDocument = ThisApplication.ActiveDocument

Dim oContext As TranslationContext
Set oContext = ThisApplication.TransientObjects.CreateTranslationContext
oContext.Type = kFileBrowseIOMechanism

Dim oOptions As NameValueMap
Set oOptions = ThisApplication.TransientObjects.CreateNameValueMap

Dim oDataMedium As DataMedium
Set oDataMedium = ThisApplication.TransientObjects.CreateDataMedium

If oapp.ActiveDocument Is Nothing Then
    Exit Sub
End If

If oapp.ActiveDocumentType <> kDrawingDocumentObject Then
    Exit Sub
End If

Set odoc = oapp.ActiveDocument
osource = odoc.FullFileName
odest = Left(osource, Len(osource) - 4)

Dim osheet As Inventor.Sheet
Dim counter As String
Dim zaehler As String

zaehler = 0
counter = 1

For Each osheet In odoc.Sheets
osheet.Activate
zaehler = zaehler + 1
Next

If zaehler = 1 Then
    Call odoc.SaveAs(odest & ".dxf", True)
    Call odoc.SaveAs(odest & ".pdf", True)
    'Call odoc.SaveAs(odest & ".dwfx", True)
   
Exit Sub
End If

For Each osheet In odoc.Sheets
osheet.Activate
Call odoc.SaveAs(odest & "_Blatt_" & counter & ".dxf", True)
Call odoc.SaveAs(odest & "_Blatt_" & counter & ".pdf", True)
'Call odoc.SaveAs(odest & "_Blatt_" & counter & ".dwfx", True)
counter = counter + 1
Next
' Check whether the translator has 'SaveCopyAs' options
        If DWFAddIn.HasSaveCopyAsOptions(oDataMedium, oContext, oOptions) Then
        oOptions.Value("Launch_Viewer") = 0
' Other options...
'oOptions.Value("Publish_Component_Props") = 0
'oOptions.Value("Publish_Mass_Props") = 0
'oOptions.Value("Password") = 0
            If TypeOf oDocument Is DrawingDocument Then
' Drawing options
            oOptions.Value("Publish_All_Sheets") = 1
            End If
        End If
oDataMedium.FileName = Replace(odoc.FullFileName, Right(odoc.FullFileName, 3), "dwfx")
Call DWFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)

End Sub

Wenn es noch irgendwo besser geht, bin ich für Anregungen jeder Zeit offen.
Danke

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

---

Ich hoffe mir kann jemand helfen.
Wir haben in der Firma alle Inventorinstallationen auf 2014 umgestellt.
Nun wollte ich mein Makro zur Ausgabe der dxf, pdf unf dwfx übertragen.
Leider bricht die Ausführung mit Laufzeitfehler 5 in der Zeile

......
If oapp.ActiveDocumentType <> kDrawingDocumentObject Then
    Exit Sub
End If

Set odoc = oapp.ActiveDocument
osource = odoc.FullFileName
odest = Left(osource, Len(osource) - 4)

Dim osheet As Inventor.Sheet
.....

ab.
Irgendwie bin ich mit meinem Latein am Ende.
Ich hoffe mir kann jemand einen Tipp geben.
Danke

[Diese Nachricht wurde von themass am 01. Okt. 2013 editiert.]

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

---

Hallo

Wurde die Datei vorher gespeichert? Sonst ist FullFileName leer und es kracht. Setz mal einen Haltepunkt auf die Zeile mit dem Fehler und schau dir den Inhalt von osource an.

------------------
MfG
Ralf

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

---

Oh Mannnnnn 
Manchmal sieht man den Wald vor lauter Bäumen nicht.
Ich hatte die Datei nicht gespeichert.
Und dann ist natürlich klar, dass er keinen Dateinamen findet.
Danke für den Hinweis.

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

---

Hi bin neu hier.
Der Code find ich super nur hab ich das problem das ich mit vielen IParts arbeite und dadurch Zeichnungen mit mehreren Blätter habe ist es möglich den Speichernamen nicht als FullPartName sondern als Bauteilnummer zu speichern?

Für eure Hilfe bedanke ich mich schon mal.

Grüße Piero

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

---

Hall0 Pie2909

Wie willst du denn in einer IDW die Bauteilnummer abfragen?? Der Zeichnungsname muss ja nicht zwigend mit dem Bauteilnamen identisch sein.
Oder hast du pro IPart ein einzelnes Blatt??

Kannst du mal ein Beispiel hochladen?
Gruss

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

---

Hi Meierjo,

Vielen Dank für deine schnelle Antwort.
Also ich bin leider nicht im Büro daher kann ich keine Datei hoch laden.
Also jedes Blatt hat eine andere IPart Datei und jede hat eine eigene Bauteilnummer
Wenn ich das vorhandene Makro ausführe bei mehreren Blätter wird jede pdf mit dem Dateinamen und Blattnummer abgespeichert das ist halt etwas aufwendig jeden Dateinamen zu ändern.
Kannst du mir helfen den speichernamen aus jedem Blatt (bauteilnummer) zu nutzen ?

Grüße

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

---

Hallo

Sorry, da steig ich nicht durch.
Eine IDW hat eine eigene Bezeichnung! Egal, was für ein Bauteil du da drin abbildest.
Können ja auch mehrere Ansichten von verschiedenen Bauteilen oder gar Bauteilen und Baugruppen drin sein.

Ohne zu wissen, wie eure Zeichnungen organisiert sind, und wo du den Bauteilnamen her holen willst, kann ich da nichts machen

Gruss

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

---

Hallo Pie2909,

du musst jedes Blatt der IDW einzeln nacheinander bearbeiten:
- Erstansicht des Blattes ermitteln,
- dargestellte Komponente der Erstansicht (IPT) und deren Bauteilnummer ermitteln.
- daraus den Dateinamen mit Pfad und .PDF bilden
- nur dieses eine Blatt als PDF ausgeben.
- Wenn Du DXF und DWFX brauchst, dann eben auch dieses Blatt entsprechend ausgeben.
Danach das nächste Blatt der IDW, bis alle fertig sind.

 

------------------
Gruß Roland

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

---

Hallo

Probier mal diesen Code

Code:

---

Sub dxf_pdf_dwfx_export()

Dim AddIns As ApplicationAddIns
Set AddIns = ThisApplication.ApplicationAddIns

Dim oapp As Inventor.Application
Set oapp = ThisApplication
Dim odoc As Inventor.DrawingDocument
Dim osource As String
Dim odest As String

Dim DWFAddIn As TranslatorAddIn
Dim i As Integer
For i = 1 To AddIns.Count
If AddIns(i).AddInType = kTranslationApplicationAddIn Then
If AddIns(i).ClassIdString = "{0AC6FD95-2F4D-42CE-8BE0-8AEA580399E4}" Then
Set DWFAddIn = AddIns.Item(i)
Exit For
End If
End If
Next i

Dim oDocument As Document
Set oDocument = ThisApplication.ActiveDocument

Dim oContext As TranslationContext
Set oContext = ThisApplication.TransientObjects.CreateTranslationContext
oContext.Type = kFileBrowseIOMechanism

Dim oOptions As NameValueMap
Set oOptions = ThisApplication.TransientObjects.CreateNameValueMap

Dim oDataMedium As DataMedium
Set oDataMedium = ThisApplication.TransientObjects.CreateDataMedium

If oapp.ActiveDocument Is Nothing Then
    Exit Sub
End If

If oapp.ActiveDocumentType <> kDrawingDocumentObject Then
    Exit Sub
End If

Set odoc = oapp.ActiveDocument
osource = odoc.FullFileName
odest = Left(osource, Len(osource) - 4)

Dim osheet As Inventor.Sheet
Dim counter As String
Dim zaehler As String

zaehler = 0
counter = 1

For Each osheet In odoc.Sheets
osheet.Activate
zaehler = zaehler + 1
Next

If zaehler = 1 Then
    Call odoc.SaveAs(odest & ".dxf", True)
    Call odoc.SaveAs(odest & ".pdf", True)
    'Call odoc.SaveAs(odest & ".dwfx", True)
   
Exit Sub
End If

For Each osheet In odoc.Sheets
osheet.Activate
'odest = Left(osheet.DrawingViews(1).ActiveMemberName, Len(osheet.DrawingViews(1).ActiveMemberName) - 4)
odest = Left(osource, InStrRev(osource, "\", -1, vbTextCompare)) & osheet.DrawingViews(1).ActiveMemberName
'Call odoc.SaveAs(odest & "_Blatt_" & counter & ".dxf", True)
Call odoc.SaveAs(odest & ".dxf", True)
'Call odoc.SaveAs(odest & "_Blatt_" & counter & ".pdf", True)
Call odoc.SaveAs(odest & ".pdf", True)
'Call odoc.SaveAs(odest & "_Blatt_" & counter & ".dwfx", True)
counter = counter + 1
Next
' Check whether the translator has 'SaveCopyAs' options
        If DWFAddIn.HasSaveCopyAsOptions(oDataMedium, oContext, oOptions) Then
        oOptions.Value("Launch_Viewer") = 0
' Other options...
'oOptions.Value("Publish_Component_Props") = 0
'oOptions.Value("Publish_Mass_Props") = 0
'oOptions.Value("Password") = 0
            If TypeOf oDocument Is DrawingDocument Then
' Drawing options
            oOptions.Value("Publish_All_Sheets") = 1
            End If
        End If
oDataMedium.FileName = Replace(odoc.FullFileName, Right(odoc.FullFileName, 3), "dwfx")
Call DWFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)

End Sub

---

Wobei ich glaube, die Schleife für die Dxf Files müsste Nichtsein, da der Inventor bei mehreren Blättern sowieso pro Blatt ein Dxf erstellt

Gruss

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

---

Hallo

Probier mal diesen Code

Code:

---

Sub dxf_pdf_dwfx_export()

Dim AddIns As ApplicationAddIns
Set AddIns = ThisApplication.ApplicationAddIns

Dim oapp As Inventor.Application
Set oapp = ThisApplication
Dim odoc As Inventor.DrawingDocument
Dim osource As String
Dim odest As String

Dim DWFAddIn As TranslatorAddIn
Dim i As Integer
For i = 1 To AddIns.Count
If AddIns(i).AddInType = kTranslationApplicationAddIn Then
If AddIns(i).ClassIdString = "{0AC6FD95-2F4D-42CE-8BE0-8AEA580399E4}" Then
Set DWFAddIn = AddIns.Item(i)
Exit For
End If
End If
Next i

Dim oDocument As Document
Set oDocument = ThisApplication.ActiveDocument

Dim oContext As TranslationContext
Set oContext = ThisApplication.TransientObjects.CreateTranslationContext
oContext.Type = kFileBrowseIOMechanism

Dim oOptions As NameValueMap
Set oOptions = ThisApplication.TransientObjects.CreateNameValueMap

Dim oDataMedium As DataMedium
Set oDataMedium = ThisApplication.TransientObjects.CreateDataMedium

If oapp.ActiveDocument Is Nothing Then
    Exit Sub
End If

If oapp.ActiveDocumentType <> kDrawingDocumentObject Then
    Exit Sub
End If

Set odoc = oapp.ActiveDocument
osource = odoc.FullFileName
odest = Left(osource, Len(osource) - 4)

Dim osheet As Inventor.Sheet
Dim counter As String
Dim zaehler As String

zaehler = 0
counter = 1

For Each osheet In odoc.Sheets
osheet.Activate
zaehler = zaehler + 1
Next

If zaehler = 1 Then
    Call odoc.SaveAs(odest & ".dxf", True)
    Call odoc.SaveAs(odest & ".pdf", True)
    'Call odoc.SaveAs(odest & ".dwfx", True)
   
Exit Sub
End If

For Each osheet In odoc.Sheets
osheet.Activate
'odest = Left(osheet.DrawingViews(1).ActiveMemberName, Len(osheet.DrawingViews(1).ActiveMemberName) - 4)
odest = Left(osource, InStrRev(osource, "\", -1, vbTextCompare)) & osheet.DrawingViews(1).ActiveMemberName
'Call odoc.SaveAs(odest & "_Blatt_" & counter & ".dxf", True)
Call odoc.SaveAs(odest & ".dxf", True)
'Call odoc.SaveAs(odest & "_Blatt_" & counter & ".pdf", True)
Call odoc.SaveAs(odest & ".pdf", True)
'Call odoc.SaveAs(odest & "_Blatt_" & counter & ".dwfx", True)
counter = counter + 1
Next
' Check whether the translator has 'SaveCopyAs' options
        If DWFAddIn.HasSaveCopyAsOptions(oDataMedium, oContext, oOptions) Then
        oOptions.Value("Launch_Viewer") = 0
' Other options...
'oOptions.Value("Publish_Component_Props") = 0
'oOptions.Value("Publish_Mass_Props") = 0
'oOptions.Value("Password") = 0
            If TypeOf oDocument Is DrawingDocument Then
' Drawing options
            oOptions.Value("Publish_All_Sheets") = 1
            End If
        End If
oDataMedium.FileName = Replace(odoc.FullFileName, Right(odoc.FullFileName, 3), "dwfx")
Call DWFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)

End Sub

---

Wobei ich glaube, die Schleife für die Dxf Files müsste nicht sein, da der Inventor bei mehreren Blättern sowieso pro Blatt ein Dxf erstellt

Gruss

[Diese Nachricht wurde von Meierjo am 02. Mrz. 2019 editiert.]

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

---

T2-OT-100xXXXXxXX-XXX.idw T2-OT-100xXXXXxXX-XXX.ipt

Guten MorgenMeierjo,

vvielen Dank für deinen Code leider hat das nicht so geklappt.
Anbei die IDW Datei.

Ich möchte eigentlich nur die PDF erzeugen.
ERklärung:
Geöffnete und abgespeicherte IDW mit mehreren Blätter soll als PDF abgespeichert werden der Name soll aus jedem Blatt seperat heraus genommen werden da ich mit Iparts arbeite habe ich im IProperties jede Variante einen eigenen Namen vergeben PartName (Bauteilnummer)
Dieser sollte dann als Dateinamen abgespeichert werden.

Ich hoffe ich habe mich besser ausgedrückt als davor 

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

---

Varianten.png PDFS.png

Hallo

Also, bei mir erstellt er pro Blatt eine PDF anhand der Varianten-Nummer

Was passt nicht??

Gruss

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

---

Hi Meierjo,

habs eben nochmal versucht und funktioniert einwandfrei 

Vielen Dank!!!!

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