| | | Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte | | | | PNY WIRD VON NVIDIA ZUM HÄNDLER DES JAHRES GEWÄHLT, eine Pressemitteilung
|
Autor
|
Thema: Automatisch DXF aus Baugruppe (2180 / mal gelesen)
|
gunni0815 Mitglied Maschinenbau Techniker
Beiträge: 42 Registriert: 23.04.2014 Win 7, Inventor 2018
|
erstellt am: 07. Apr. 2017 16:37 <-- editieren / zitieren --> Unities abgeben:
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 |
Volker E Mitglied Konstrukteur
Beiträge: 164 Registriert: 20.08.2012 Win 7 64 bit, Inventor 2015 Sp2 64 bit Intel Xeon CPU E5-1607 3,00 GHz 32GB RAM Nvidia Quadro 4000 Space Explorer
|
erstellt am: 10. Apr. 2017 09:04 <-- editieren / zitieren --> Unities abgeben: Nur für gunni0815
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 |
gunni0815 Mitglied Maschinenbau Techniker
Beiträge: 42 Registriert: 23.04.2014
|
erstellt am: 10. Apr. 2017 21:27 <-- editieren / zitieren --> Unities abgeben:
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 |
KraBBy Mitglied Maschinenbau-Ingenieur
Beiträge: 720 Registriert: 19.09.2007 Inventor Professional 2020 WinX
|
erstellt am: 11. Apr. 2017 12:21 <-- editieren / zitieren --> Unities abgeben: Nur für gunni0815
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 SubPublic 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 |
gunni0815 Mitglied Maschinenbau Techniker
Beiträge: 42 Registriert: 23.04.2014
|
erstellt am: 28. Apr. 2017 14:41 <-- editieren / zitieren --> Unities abgeben:
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 |
KraBBy Mitglied Maschinenbau-Ingenieur
Beiträge: 720 Registriert: 19.09.2007 Inventor Professional 2020 WinX
|
erstellt am: 29. Apr. 2017 16:14 <-- editieren / zitieren --> Unities abgeben: Nur für gunni0815
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 |
AzCad Mitglied Dipl.-Ing. Maschinenbau
Beiträge: 2 Registriert: 06.08.2009
|
erstellt am: 08. Mai. 2017 14:21 <-- editieren / zitieren --> Unities abgeben: Nur für gunni0815
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 |
gunni0815 Mitglied Maschinenbau Techniker
Beiträge: 42 Registriert: 23.04.2014 Win 7, Inventor 2018
|
erstellt am: 17. Mai. 2017 09:37 <-- editieren / zitieren --> Unities abgeben:
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 |
| Anzeige.:
Anzeige: (Infos zum Werbeplatz >>)
|