| |
| Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte |
| |
| Request a special discount on NVIDIA RTX 5000 Ada Generation GPU !, eine Pressemitteilung
|
Autor
|
Thema: Blechteile automatisch abwickeln und als .dxf exportieren per VBA (2954 / mal gelesen)
|
Jonnok Mitglied Ingenieur
Beiträge: 4 Registriert: 24.06.2018 Windows 10 Pro 10.0.10586 Autodesk Inventor 2017 64bit Build 142
|
erstellt am: 25. Jun. 2018 07:51 <-- editieren / zitieren --> Unities abgeben:
Hallo, ich benötige Hilfe dabei meinen Workflow etwas zu optimieren. Es geht darum in Inventor 2017 die Umrisse von Blechteilen(.ipt) durch ein Script automatisch als .dxf exportieren zu lassen. Unser Lasermensch möchte gerne einfache .dxf haben, um direkt den Laser damit beauftragen zu können. Der bisherige Workflow ist so: -beliebiges Blechteil als .ipt vorhanden (Bild 1) -Abwicklung erstellen (teilweise auch schon vorhanden) (Bild 2) -Fläche markieren und mit rechtsklick "Fläche exportieren als..." (Bild 3) -Name und Speicherort festlegen -Speichern Der Ablauf könnte vermutlich durch irgendein VBA-Script in Inventor abgebildet werden, da nichts davon wirklich klug/kreativ geschehen muss. Der Pfad muss festgelegt werden und der Dateiname kann einfach die "Bauteilnummer" oder "Titel" aus den iProperties sein.
Ich konnte mit einfachen Suchen bisher nichts in die Richtung finden. Für jemanden der sich gut mit VBA auskennt, sollte das ein einfaches Ding sein. Kann mir jemand das grobe Befehlsgerüst aufschreiben, woran ich mich orientieren kann? Im Anhang finden sich drei Screenshots eines Beispielbauteils und der Arbeitsschritte Nice-to-have -alle Blechteile einer Baugruppe mit einem klick exportieren und alte Daten stumpf überschreiben -Blechstärke in Dateiname mit aufnehmen P.S. Im Laufe der Menschheit wurde noch niemanden mit der Anweisung "Benutz die SuFu" oder "guck bei google" geholfen. Sollte ich bei meiner Suche Foreneinträge übersehen haben, bitte einfach den Link zu den jeweiligen Posts dazu schreiben.
Als Etechniker kann ich einiges programmieren, aber VBA ist jeden mal Krebs in den Fingern. Vielen Dank im Vorraus
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Tacker Mitglied TZ, Tech. MB, Softwareentwickler
Beiträge: 175 Registriert: 23.09.2010 IV 2017 Pro i7-7700K 4x4.2GHz 32GB DDR4-2400 GTX 1060 6GB DDR5
|
erstellt am: 25. Jun. 2018 10:42 <-- editieren / zitieren --> Unities abgeben: Nur für Jonnok
|
KraBBy Mitglied Maschinenbau-Ingenieur
Beiträge: 720 Registriert: 19.09.2007 Inventor Professional 2020 WinX
|
erstellt am: 25. Jun. 2018 12:46 <-- editieren / zitieren --> Unities abgeben: Nur für Jonnok
Hier mal der reine Export-Teil, als Vorschlag. das Auslesen der iProperties ist nicht enthalten. Es muss sich um ein Blechteil handeln und die Abwicklung muss existieren. Code: Sub Exp_Abwicklung() ' KraBBy 25.06.2018 Dim oDoc As PartDocument Set oDoc = ThisApplication.ActiveDocument Dim sPath As String, sFileName As String sPath = "C:\temp\" 'mit \ am Ende! sFileName = "test0815" 'ohne DateiEndung! Call WriteSheetMetal_DXF(sPath, sFileName, oDoc) End Sub Private Sub WriteSheetMetal_DXF(sPfad As String, sDatName As String, oDoc As Document) ' bildet den Befehl ab ' Abwicklung -> Kopie speichern unter -> dxf ... ' KraBBy 18.03.2015 ' 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 & "&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 Test_deleteFile sFileName & ".dxf" 'existierende Datei löschen ElseIf vbNo = vInput Then Dim iCount As Integer iCount = 0 Do sFileName = sFileName & "_" 'Dateiname ändern sDatName = sDatName & "_" 'auch hier ändern damit gsFertigMsg passt iCount = iCount + 1 If 5 < iCount Then 'Endlosschleife verhindern MsgBox "Kein DXF erzeugt!" & vbCrLf & "es existieren bereits mehrere Dateien mit diesem Dateinamen (und angehängtem '_')" _ , vbCritical, "jetzt is aber mal gut!" Exit Sub End If Loop Until "" = Dir(sFileName & ".dxf") 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 'WriteSheetMetal_DXF': " & 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 |
Tacker Mitglied TZ, Tech. MB, Softwareentwickler
Beiträge: 175 Registriert: 23.09.2010 IV 2017 Pro i7-7700K 4x4.2GHz 32GB DDR4-2400 GTX 1060 6GB DDR5
|
erstellt am: 25. Jun. 2018 13:08 <-- editieren / zitieren --> Unities abgeben: Nur für Jonnok
KraBBy, du bist echt Wahnsinn Manchmal denk ich mir schon ich verbring zu viel Zeit in den Foren hier, aber du klatscht meist noch am selben Tag einen kompletten Lösungsvorschlag raus Man muss sich regelrecht beeilen wenn man ein paar Unities abstauben will BTW: Keine Kritik, ich finds gut wenn sich Leute für die Gemeinschaft einsetzen. Gruß 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: 25. Jun. 2018 22:24 <-- editieren / zitieren --> Unities abgeben: Nur für Jonnok
@Tacker, OT Das ist deutlich zu viel der Ehre. Das Sub für den Export habe ich schon eine Weile 'in Betrieb'. Hier ist also nur der Aufruf neu geschrieben. Unities sind ja auch noch zu haben, da die gewünschten Funktionen recht umfangreich sind. Also ans Werk! ------------------ Gruß KraBBy Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Jonnok Mitglied Ingenieur
Beiträge: 4 Registriert: 24.06.2018 Windows 10 Pro 10.0.10586 Autodesk Inventor 2017 64bit Build 142
|
erstellt am: 26. Jun. 2018 09:42 <-- editieren / zitieren --> Unities abgeben:
wow, das ist mal eine umfangreiche Antwort. Vielen Dank. Da werde ich mich mal durcharbeiten. Sich Zeile für Zeile durch ein Programm zu arbeiten geht viel besser von der Hand, als sich das alles aus den Fingern zu saugen. Vielen Dank Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Tacker Mitglied TZ, Tech. MB, Softwareentwickler
Beiträge: 175 Registriert: 23.09.2010 IV 2017 Pro i7-7700K 4x4.2GHz 32GB DDR4-2400 GTX 1060 6GB DDR5
|
erstellt am: 26. Jun. 2018 10:26 <-- editieren / zitieren --> Unities abgeben: Nur für Jonnok
Moin So also ich hab mich mal ran gemacht und hab den Vorschlag von KraBBy weiter ausgebaut. Was tut es? Zuerst wird überprüft ob sichtbare Dokumente geöffnet sind. Dann wird geprüft welche Art von Dokument geöffnet ist. Ist ein Bauteil geöffnet wird geprüft ob es ein Blech ist. Falls ja wird es exportiert. Ist das aktive Dokument eine Baugruppe wird durch alle enthaltenen Bauteile iteriert und anschließend genauso verfahren wie mit Bauteilen. Es wird nicht darauf geachtet ob Bauteile mehr als einmal vorkommen, das läuft einfach stumpf durch. Die Materialstärke wird dem angezeigten Namen hinten angefügt (Name & "_" & Thickness) Der Pfad ist aktuell noch "C\Temp\" da bräuchte ich noch Informationen wie der Pfad sich verhalten soll. Sollte das Blechbauteil keine Abwicklung haben wird eine erstellt. → Das kann bei großen Baugruppen sehr lange dauern. Denke auch nicht dass das sehr stabil ist (bei großen Baugruppen) DIVA Einen Sub (Test_deleteFile) musste ich ausklammern, der war nicht vorhanden bei KraBBys Vorschlag. Code:
Public Sub Exp_Abwicklung() If ThisApplication.Documents.VisibleDocuments.Count > 0 Then If ThisApplication.ActiveDocument.DocumentType = kAssemblyDocumentObject Then ' Get the active assembly. Dim oAsmDoc As AssemblyDocument Set oAsmDoc = ThisApplication.ActiveDocument ' Get the assembly component definition. Dim oAsmDef As AssemblyComponentDefinition Set oAsmDef = oAsmDoc.ComponentDefinition ' Get all of the leaf occurrences of the assembly. Dim oLeafOccs As ComponentOccurrencesEnumerator Set oLeafOccs = oAsmDef.Occurrences.AllLeafOccurrences ' Iterate through the occurrences and print the name. Dim oOcc As ComponentOccurrence For Each oOcc In oLeafOccs If oOcc.DefinitionDocumentType = kPartDocumentObject Then If (oDoc.SubType = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}") Then Call Prepare_For_Export(oOcc.Definition.Document) End If End If Debug.Print oOcc.Name Next ElseIf ThisApplication.ActiveDocument.DocumentType = kPartDocumentObject Then If (oDoc.SubType = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}") Then Call Prepare_For_Export(ThisApplication.ActiveDocument) End If End If End If End Sub Private Sub Prepare_For_Export(ByVal oDoc As PartDocument) Dim sPath As String, sFileName As String sPath = "C:\temp\" 'mit \ am Ende! 'sFileName = "test0815" 'ohne DateiEndung! ' 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 Dim oSheetMetalCompDef As SheetMetalComponentDefinition Set oSheetMetalCompDef = oDoc.ComponentDefinition Dim Thickness As String Thickness = CStr(oSheetMetalCompDef.Thickness.Value * 10) & oSheetMetalCompDef.Thickness.Units sFileName = oDoc.DisplayName & "_" & Thickness Call WriteSheetMetal_DXF(sPath, sFileName, oDoc) End Sub Private Sub WriteSheetMetal_DXF(sPfad As String, sDatName As String, oDoc As PartDocument) ' bildet den Befehl ab ' Abwicklung -> Kopie speichern unter -> dxf ... ' KraBBy 18.03.2015 ' Tacker 26.06.2018// Hinzugefügt: Abwicklung erstellen falls nicht vorhanden. Test_deleteFile auskommentiert da nicht vorhanden 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 oSheetMetalCompDef.Unfold 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 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 & "&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 MsgBox ("Sub nicht vorhanden") 'Test_deleteFile sFileName & ".dxf" 'existierende Datei löschen ElseIf vbNo = vInput Then Dim iCount As Integer iCount = 0 Do sFileName = sFileName & "_" 'Dateiname ändern sDatName = sDatName & "_" 'auch hier ändern damit gsFertigMsg passt iCount = iCount + 1 If 5 < iCount Then 'Endlosschleife verhindern MsgBox "Kein DXF erzeugt!" & vbCrLf & "es existieren bereits mehrere Dateien mit diesem Dateinamen (und angehängtem '_')" _ , vbCritical, "jetzt is aber mal gut!" Exit Sub End If Loop Until "" = Dir(sFileName & ".dxf") 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 'WriteSheetMetal_DXF': " & vbCrLf & vbCrLf & Err.Description, vbCritical, "Err.Number: " & Err.Number End Sub
Gruß 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: 26. Jun. 2018 12:00 <-- editieren / zitieren --> Unities abgeben: Nur für Jonnok
Sorry für die fehlende Function "Test_deleteFile". Reiche ich hiermit nach. Im Grunde sollte auch diese Zeile reichen (alternativ): Kill sFileName & ".dxf" Code: Public Function Test_deleteFile(sFile As String) As Boolean ' eine Datei wird gelöscht ' Rückgabewert True: Löschen erfolgreich On Error GoTo err_handler Dim fs As Object Set fs = CreateObject("Scripting.FileSystemObject") If Not (fs.FileExists(sFile)) Then 'MsgBox "Datei existiert nicht", vbInformation, "Fehler in 'deleteFile'" Test_deleteFile = True Exit Function End If fs.DeleteFile sFile 'der eigentliche Lösch-Befehl (alternativ: Kill) If Not (fs.FileExists(sFile)) Then Test_deleteFile = True Else 'Löschen hat nicht funktioniert, Schreibschutz o.ä. Test_deleteFile = False End If Set fs = Nothing Exit Function err_handler: MsgBox Err.Number & vbCrLf & Err.Description, vbCritical, "Fehler im Funktion 'deleteFile'" End Function
------------------ Gruß KraBBy 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: 26. Jun. 2018 12:11 <-- editieren / zitieren --> Unities abgeben: Nur für Jonnok
vermutlich ist auch das Verhalten bei "dxf-Datei bereits vorhanden" nicht unbedingt optimal (oder das gewünschte). In dem Block nach 'Datei bereits vorhanden? wird der Benutzer gefragt was zu tun ist (Überschreiben J/N) Bei Nein wird solange "_" angehängt bis Dateiname frei ist. Evtl. kann man darauf komplett (?) verzichten ------------------ Gruß KraBBy 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: 09. Jul. 2018 12:47 <-- editieren / zitieren --> Unities abgeben: Nur für Jonnok
Zitat: Original erstellt von Jonnok: wow, das ist mal eine umfangreiche Antwort. Vielen Dank. Da werde ich mich mal durcharbeiten. [...]
@Jonnok: wie läufts? Gibt es einen Stand der "für Dich" funktioniert? Dein ~finaler Stand darf gern hier gepostet werden, damit auch andere was davon haben... ------------------ Gruß KraBBy Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
lid-ds Mitglied Konstrukteur
Beiträge: 2 Registriert: 10.10.2022 Inv 2021
|
erstellt am: 10. Okt. 2022 15:59 <-- editieren / zitieren --> Unities abgeben: Nur für Jonnok
|
KraBBy Mitglied Maschinenbau-Ingenieur
Beiträge: 720 Registriert: 19.09.2007 Inventor Professional 2020 WinX
|
erstellt am: 10. Okt. 2022 17:08 <-- editieren / zitieren --> Unities abgeben: Nur für Jonnok
Das kann vermutlich die Bends-Eigenschaft (Auflistung aller Biegungen). Sollte man aber ggf. noch genauer untersuchen / testen (ich habe keine Erfahrungswerte dazu)! Code: Dim oDoc As PartDocument Set oDoc = ThisApplication.ActiveDocument' 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 oBends As BendsEnumerator Set oBends = oSheetMetalCompDef.Bends MsgBox oBends.Count, vbInformation, "Bends.Count"
BTW.: Die Frage wäre in einem eigenen Fred wohl besser aufgehoben gewesen... ------------------ Gruß KraBBy Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
lid-ds Mitglied Konstrukteur
Beiträge: 2 Registriert: 10.10.2022 Inv 2021
|
erstellt am: 11. Okt. 2022 07:43 <-- editieren / zitieren --> Unities abgeben: Nur für Jonnok
|
TLipo Mitglied
Beiträge: 55 Registriert: 11.05.2022
|
erstellt am: 31. Jan. 2023 15:39 <-- editieren / zitieren --> Unities abgeben: Nur für Jonnok
Danke an KraBBy und Tacker. Ich wollte das ganze gerne darum erweitern, dass es nur dxf gibt, wenn die entsprechende ipt sichtbar ist. Mein Ansatz ist vorm erstellen des dxf folgendes einzufügen: Code:
If oOcc.Visible = True Then oDataIO.WriteDataToFile sOut, sFileName & ".dxf" End If
Ich krieg dann aber angezeigt Err.Numer:424 Fehler in der Sub, wo ich obige Ergänzung gemacht hab "Objekt erforderlich" Bin ich komplett auf dem Holzweg? Danke für alle Hilfen! Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
rkauskh Moderator Dipl.-Ing. (FH) Versorgungstechnik
Beiträge: 2580 Registriert: 15.11.2006 Windows 10 x64, AIP 2020-2025
|
erstellt am: 31. Jan. 2023 19:15 <-- editieren / zitieren --> Unities abgeben: Nur für Jonnok
Hallo An der Stelle die du versuchst existiert oOcc nicht. Setz es in die oberste Sub. Nur dort existiert oOcc. Code:
For Each oOcc In oLeafOccs If oOcc.DefinitionDocumentType = kPartDocumentObject Then If (oDoc.SubType = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}") Then If oOcc.Visible = True Then Call Prepare_For_Export(oOcc.Definition.Document) End If End If End If Debug.Print oOcc.Name Next
------------------ MfG Ralf RKW Solutions GmbH www.RKW-Solutions.com Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |