---

Hallo,
als Inventornewbie komme ich bei folgender Thematik nicht weiter.
Es gibt hier einige Beiträge die sich mit ähnlichen Problemen befassen, aber leider habe ich noch keines gefunden das ich genau auf meinen Fall anwenden kann.

Hier mein Problem:
Ich möchte gerne aus einer Baugruppe die aus 3 Blechen besteht, aus jedem jeweiligen Blech die DXF zum Lasern erzeugen. Dies sollte am liebsten über einen "neuen Knopf" der Baugruppenumgebung oder gleich nach dem aktualisieren der Baugruppe geschehen. Die DXF Dateien sollten dann im Speicherort der Ausgangsbaugruppe liegen.
Leider kenne ich mich in der VBA Applikation noch nicht aus, aber ich habe gelesen das andere User ähnliche Fälle damit lösen.

Wärt Ihr bitte so lieb mir bei meinem Problem zu helfen?

Gruß
gunni0815

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

---

Hallo gunni0815

vielleicht hilft Dir das hier weiter:

Public Sub PublishDXF()
    ' Get the DXF translator Add-In.
    Dim DXFAddIn As TranslatorAddIn
    Set DXFAddIn = ThisApplication.ApplicationAddIns.ItemById("{C24E3AC4-122E-11D5-8E91-0010B541CD80}")

    'Set a reference to the active document (the document to be published).
    Dim oDocument As Document
    Set oDocument = ThisApplication.ActiveDocument

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

    ' Create a NameValueMap object
    Dim oOptions As NameValueMap
    Set oOptions = ThisApplication.TransientObjects.CreateNameValueMap

    ' Create a DataMedium object
    Dim oDataMedium As DataMedium
    Set oDataMedium = ThisApplication.TransientObjects.CreateDataMedium

    ' Check whether the translator has 'SaveCopyAs' options
    If DXFAddIn.HasSaveCopyAsOptions(oDocument, oContext, oOptions) Then
        Dim strIniFile As String
        strIniFile = "C:\tempDXFOut.ini"

        ' Create the name-value that specifies the ini file to use.
        oOptions.Value("Export_Acad_IniFile") = strIniFile
    End If

    'Set the destination file name
    oDataMedium.FileName = "c:\tempdxfout.dxf"

    'Publish document.
    Call DXFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)
End Sub

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

---

Danke für den Code Volker,
könntest mir den umbauen damit die dxf aus der abwicklung der jeweiligen Teile erzeugt wird? Oder kennt jemand eine Möglichkeit Befehle zu tracken um damit ein Makro selber zu schreiben?

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

---

hier mal mein verwendetes Makro zum Export der Abwicklung und ein beispielhafter Aufruf dafür (Sub Test). Der Aufruf mit der Schleife ist aber ungetestet.

Code:

---

Sub Test
  For Each oDoc In ThisApplication.ActiveDocument.ReferencedDocuments
    Call WriteSheetMetalDXF("C:\temp\", oDoc.DisplayName, oDoc)
  Next
End Sub

Public Sub WriteSheetMetalDXF(sPfad As String, sDatName As String, Optional oDoc As Document)
' bildet den Befehl ab
' Abwicklung -> Kopie speichern unter -> dxf ...
'

On Error GoTo ErrHnd

    ' Make sure the document is a sheet metal document.
    If Not (oDoc.SubType = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}") Then
        MsgBox "Das ref. Dokument ist kein Blechteil!" & vbCrLf _
                & oDoc.DisplayName, vbInformation + vbOKOnly, "no Sheet Metal"
        Exit Sub
    End If
   
    ' Get the sheet metal component definition.  Because this is a part document whose
    ' sub type is sheet metal, the document will return a SheetMetalComponentDefinition
    ' instead of a PartComponentDefinition.
    Dim oSheetMetalCompDef As SheetMetalComponentDefinition
    Set oSheetMetalCompDef = oDoc.ComponentDefinition
   
    Dim oFlat As FlatPattern
    Set oFlat = oSheetMetalCompDef.FlatPattern
   
    If oFlat Is Nothing Then
        MsgBox "Das ref. Dokument enthält keine Abwicklung!" & vbCrLf _
                & oDoc.DisplayName, vbInformation + vbOKOnly, "no Flat"
        Exit Sub
    End If
   
'Get the DataIO object.
Dim oDataIO As DataIO
Set oDataIO = oDoc.ComponentDefinition.DataIO

' Build the string that defines the format of the DXF file.
' Parameter aus Hilfe zu DataIO Interface
Dim sOut As String
sOut = "FLAT PATTERN DXF?"
sOut = sOut & "AcadVersion=R12"    '2010, 2007, 2004, 2000, or R12
sOut = sOut & "&OuterProfileLayer=IV_outer"
sOut = sOut & "&InteriorProfilesLayer=IV_inner"
sOut = sOut & "&FeatureProfilesLayer=IV_Profiles"
sOut = sOut & "&TangentLayer=IV_Tangent"
'sOut = sOut & "&BendLayer=IV_Bend"    'Alternativ zu BendUp/-Down
sOut = sOut & "&BendUpLayer=IV_BendUp"
sOut = sOut & "&BendDownLayer=IV_BendDown"
sOut = sOut & "&ToolCenterLayer=IV_ToolCenter"
sOut = sOut & "&ArcCentersLayer=IV_ArcCenter"
sOut = sOut & "&SimplifySplines=True"
sOut = sOut & "&SplineTolerance=0.01"
sOut = sOut & "&TangentLayerColor=255;0;0" 'Beispiel Farbeinstellung (RGB)
sOut = sOut & "&InvisibleLayers=IV_ArcCenter" 'hier aufgelistete Layer (getrennt durch ";"), werden nicht exportiert

'Datei bereits vorhanden?
Dim sFilename As String
sFilename = sPfad & sDatName  'ohne Dateiendung!
If Not ("" = Dir(sFilename & ".dxf")) Then
    'Datei existiert
    Dim vInput
    vInput = MsgBox(sFilename & ".dxf" & vbCrLf & "Datei existiert bereits!" & vbCrLf _
    & "Überschreiben?", vbYesNoCancel + vbExclamation, "Datei existiert bereits")
    If vbYes = vInput Then
        Kill sFilename & ".dxf"  'existierende Datei löschen
    Else    'Cancel gedrückt oder MsgBox geschlossen (oben rechts)
        MsgBox "Kein DXF erzeugt!", vbOKOnly, "Abbruch durch Benutzer"
        Exit Sub
    End If
End If

' Create the DXF file.
oDataIO.WriteDataToFile sOut, sFilename & ".dxf"

'Schlussmeldung
'MsgBox "Export erfolgt" & vbCrLf & sFilename & ".dxf", vbInformation, "DXF (Flat) Fertig"

'Aufräumen
Set oSheetMetalCompDef = Nothing
Set oFlat = Nothing
Set oDataIO = Nothing

Exit Sub

ErrHnd:
MsgBox "Fehler in Sub 'WriteSheetMetalDXF': " & vbCrLf & vbCrLf & Err.Description, vbCritical, "Err.Number: " & Err.Number
End Sub

---

------------------
Gruß KraBBy

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

---

Hiho!
Ich habe hier den Code zusammen gestellt, der mir die DXF am Richtigen Ort generiert und mir sogar sagt wenns fertig ist  ... Ich habe nur ein Problem und zwar werden in den DXF Dateien die Biegungslinien und Tangen zu den Biegungen angezeigt. Kann mir einer sagen wie ich die abschalten kann?

Die Zeile mit dem :"InvisibleLayers=IV_TANGENT" haut irgendwie nicht richtig hin....

Könnte mir bitte jemand nen Tipp dazu geben?

Hier mein kompletter Code:

Sub dxferzeugen()
' alle Dukomente ermitteln
Dim allDocs As Documents
Set allDocs = ThisApplication.Documents
' Iterate through the contents of the Documents collection.
Dim singleDoc As Document
Dim dxferzeugen As Property
Dim DocFlatPattern As FlatPattern
Dim tmpStr As String
Debug.Print "start 1"

For Each singleDoc In allDocs
    Debug.Print singleDoc.FullDocumentName
    On Error Resume Next
    Set dxferzeugen = singleDoc.PropertySets(4).Item("dxferzeugen")
    If Err Then
    Else
        If dxferzeugen.Value Then
            Debug.Print "start"
                dxfFileName = Left(singleDoc.FullDocumentName, Len(singleDoc.FullDocumentName) - 4) + ".dxf"
       
               
               
                Dim oDataIO As DataIO
                Set oDataIO = singleDoc.ComponentDefinition.DataIO
                Dim sOut As String
                sOut = "FLAT PATTERN DXF?AcadVersion=R12&OuterProfileLayer=CUT&InteriorProfilesLayer=CUT&SplineTolerance Double 0.01 &InvisibleLayers=IV_TANGENT"
                oDataIO.WriteDataToFile sOut, dxfFileName
                singleDoc.Close (True)

            End If
    End If
Next

MsgBox "Macro ist zu Ende"
End Sub

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

---

bei den invisible werden die layer angegeben, die nicht exportiert werden sollen. ich denke also du musst den tangenten erst mal diesen layer geben

sOut = sOut & "&TangentLayer=IV_Tangent"
...

------------------
Gruß KraBBy

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

---

DXF_4.JPG DXF_2.JPG DXF_3.JPG

Hi,

ich arbeite gerade an einer ähnlichen iLogic Regel, die ich mir aus dem Netz zusammenkopiert habe und versuche das alles zu verstehen etc.

Folgende Fragen treten nun auf:

1) Der Dateiname ist immer XYZipt.dxf, hier hätte ich gerne das ipt nicht mit drinnen.
2) Die Eigenschaften mit der das Dxf geschrieben werden sollen wie auf dem Bilder dargestellt geschrieben werden, setze ich aber mehr in sout Zeile wird keins mehr geschrieben.

Hier der Code:

'aktive Datei ist .iam
Dim oAsmDoc As AssemblyDocument
oAsmDoc = ThisApplication.ActiveDocument
oAsmName = Left(oAsmDoc.DisplayName, Len(oAsmDoc.DisplayName) -4)
'ist es eine iam?
If ThisApplication.ActiveDocument.DocumentType <> kAssemblyDocumentObject Then
MessageBox.Show("Please run this rule from the assembly file.", "iLogic")
Exit Sub
End If
'Generiere MessageBox
RUsure = MessageBox.Show ( _
"Für jedes Bleichteil in der Baugruppe und Unterbaugruppe soll ein DXF erstellt werden?" _
& vbLf & "Die Bauteile müssen gespeichert sein!" _
& vbLf & " " _
& vbLf & "Dieser Vorgang kann ein wenig dauern.", "BG - DXF-Genrator",MessageBoxButtons.YesNo)
If RUsure = vbNo Then
Return
Else
End If
oPath = ThisDoc.Path
oDataMedium = ThisApplication.TransientObjects.CreateDataMedium
oContext = ThisApplication.TransientObjects.CreateTranslationContext
oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
oOptions = ThisApplication.TransientObjects.CreateNameValueMap
'Speicherort
oFolder = "C:\Users\nerdmann\Desktop\Export Inventor\"
'Teile werden geprüft
Dim oRefDocs As DocumentsEnumerator
oRefDocs = oAsmDoc.AllReferencedDocuments
Dim oRefDoc As Document
For Each oRefDoc In oRefDocs
iptPathName = Left(oRefDoc.FullDocumentName, Len(oRefDoc.FullDocumentName) - 3) & "ipt"
If(System.IO.File.Exists(iptPathName)) Then
Dim oDrawDoc As PartDocument
oDrawDoc = ThisApplication.Documents.Open(iptPathName, True)
oFileName = Left(oRefDoc.DisplayName, Len(oRefDoc.DisplayName))
Try
'Hier wird der DXF Dateiname generiert, leider immer mit der Bezeichnung ipt.dxf, Warum?
oDataMedium.FileName = oFolder & "\" & oFileName & ".dxf"
Dim oCompDef As SheetMetalComponentDefinition
oCompDef = oDrawDoc.ComponentDefinition
If oCompDef.HasFlatPattern = False Then
oCompDef.Unfold
Else
oCompDef.FlatPattern.Edit
End If
Dim sOut As String
'Hier werden die Eigenschaften des DXFs generiert jedoch bin ich mir hier unsicher?
sOut = "FLAT PATTERN DXF?AcadVersion=2000&OuterProfileLayer=IV_OUTER_PROFILE&InteriorProfilesLayer=IV_INTERIOR_PROFILES&InvisibleLayers=IV_TANGENT;IV_BEND;IV_BEND_DOWN;IV_TOOL_CENTER;IV_TOOL_CENTER_DOWN;IV_ARC_CENTERS;IV_FEATURE_PROFILES;IV_FEATURE_PROFILES_DOWN;IV_ALTREP_FRONT;IV_ALTREP_BACK;IV_ALTREP_FRONT;IV_UMCOMSUMED_SKETCHES;IV_ROLL"
'"&SimplifySplines=True" muss irgendwie rein
'"&SplineTolerance=0.01" muss irgendwie rein
oCompDef.DataIO.WriteDataToFile( sOut, oDataMedium.FileName)
oCompDef.FlatPattern.ExitEdit
Catch
End Try
oDrawDoc.Close
Else
End If
Next

[Diese Nachricht wurde von AzCad am 08. Mai. 2017 editiert.]

[Diese Nachricht wurde von AzCad am 08. Mai. 2017 editiert.]

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

---

Also was deine Dateiendung betrifft kannst du dich aus meinem Code bedienen. Der jetzt übrigens wunderbar funktioniert. An dieser Stelle nochmal ein großes Dankeschön an alle aus diesem Beitrag für die tolle Hilfe.
)))

Hier mein Code:
Sub dxferzeugen()
' alle Dukomente ermitteln
Dim allDocs As Documents
Set allDocs = ThisApplication.Documents
' Iterate through the contents of the Documents collection.
Dim singleDoc As Document
Dim dxferzeugen As Property
Dim DocFlatPattern As FlatPattern
Dim tmpStr As String
Debug.Print "start 1"

For Each singleDoc In allDocs
    Debug.Print singleDoc.FullDocumentName
    On Error Resume Next
    Set dxferzeugen = singleDoc.PropertySets(4).Item("dxferzeugen")
    If Err Then
    Else
        If dxferzeugen.Value Then
            Debug.Print "start"
                dxfFileName = Left(singleDoc.FullDocumentName, Len(singleDoc.FullDocumentName) - 4) + ".dxf"
       
               
               
                Dim oDataIO As DataIO
                Set oDataIO = singleDoc.ComponentDefinition.DataIO
                Dim sOut As String
                sOut = "FLAT PATTERN DXF?"
                sOut = sOut & "AcadVersion=2004"    '2010, 2007, 2004, 2000, or R12
                sOut = sOut & "&OuterProfileLayer=IV_Outer_Profile"
                sOut = sOut & "&InteriorProfilesLayer=IV_INTERIOR_PROFILES"
                sOut = sOut & "&TangentLayer=IV_Tangent"
                sOut = sOut & "&BendUpLayer=IV_Bend"
                sOut = sOut & "&BendDownLayer=IV_BendDown"
                sOut = sOut & "&ArcCentersLayer=IV_ArcCenter"
                'sOut = sOut & "&SimplifySplines=True"
                'sOut = sOut & "&SplineTolerance=0.01"
                'sOut = sOut & "&TangentLayerColor=255;0;0" 'Beispiel Farbeinstellung (RGB)
                sOut = sOut & "&InvisibleLayers=IV_ArcCenter;IV_TANGENT;IV_BEND;IV_BendDown;IV_ArcCenter;IV_Featrue_Profiles;IV_Feature_Profiles_Down" 'hier aufgelistete Layer (getrennt durch ";"), werden
                oDataIO.WriteDataToFile sOut, dxfFileName
                singleDoc.Close (True)
                Debug.Print sOut
               
            End If
    End If
Next

MsgBox "Macro ist zu Ende"
End Sub

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