Hot News:

Unser Angebot:

  Foren auf CAD.de (alle Foren)
  Inventor VBA
  Blechteile automatisch abwickeln und als .dxf exportieren per VBA

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
  
Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte
Autor Thema:  Blechteile automatisch abwickeln und als .dxf exportieren per VBA (2705 mal gelesen)
Jonnok
Mitglied
Ingenieur

Sehen Sie sich das Profil von Jonnok an!   Senden Sie eine Private Message an Jonnok  Schreiben Sie einen Gästebucheintrag für Jonnok

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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities


Bild1.png


Bild2.png


Bild3.png

 
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


Sehen Sie sich das Profil von Tacker  an!   Senden Sie eine Private Message an Tacker  Schreiben Sie einen Gästebucheintrag für Tacker

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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Jonnok 10 Unities + Antwort hilfreich

Moin    und willkommen im VBA-Forum

Zum bisherigen Workflow: Das funktioniert aber nur wenn es eine Fläche ist (wenn ich das recht in Erinnerung habe) sobald eine Unterbrechung da ist fehlt was. Wäre Text eingraviert(extrudiert) dann würde bei einem "O" das innere Oval fehlen. Korrigier mich wenn ich da falsch liege.

Bist du bereits auf diese Seite gestoßen?
https://knowledge.autodesk.com/search-result/caas/CloudHelp/cloudhelp/2018/ENU/Inventor-API/files/WriteFlatPatternAsDXF-Sample-htm.html

Sollte das den Anforderungen für ein Bauteil genügen können wir uns an die Baugruppen machen.

Gruß

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

KraBBy
Mitglied
Maschinenbau-Ingenieur


Sehen Sie sich das Profil von KraBBy an!   Senden Sie eine Private Message an KraBBy  Schreiben Sie einen Gästebucheintrag für KraBBy

Beiträge: 601
Registriert: 19.09.2007

Inventor Professional 2020
WinX

erstellt am: 25. Jun. 2018 12:46    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Jonnok 10 Unities + Antwort hilfreich

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


Sehen Sie sich das Profil von Tacker  an!   Senden Sie eine Private Message an Tacker  Schreiben Sie einen Gästebucheintrag für Tacker

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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Jonnok 10 Unities + Antwort hilfreich

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


Sehen Sie sich das Profil von KraBBy an!   Senden Sie eine Private Message an KraBBy  Schreiben Sie einen Gästebucheintrag für KraBBy

Beiträge: 601
Registriert: 19.09.2007

Inventor Professional 2020
WinX

erstellt am: 25. Jun. 2018 22:24    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Jonnok 10 Unities + Antwort hilfreich

@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

Sehen Sie sich das Profil von Jonnok an!   Senden Sie eine Private Message an Jonnok  Schreiben Sie einen Gästebucheintrag für Jonnok

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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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


Sehen Sie sich das Profil von Tacker  an!   Senden Sie eine Private Message an Tacker  Schreiben Sie einen Gästebucheintrag für Tacker

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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Jonnok 10 Unities + Antwort hilfreich

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


Sehen Sie sich das Profil von KraBBy an!   Senden Sie eine Private Message an KraBBy  Schreiben Sie einen Gästebucheintrag für KraBBy

Beiträge: 601
Registriert: 19.09.2007

Inventor Professional 2020
WinX

erstellt am: 26. Jun. 2018 12:00    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Jonnok 10 Unities + Antwort hilfreich

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


Sehen Sie sich das Profil von KraBBy an!   Senden Sie eine Private Message an KraBBy  Schreiben Sie einen Gästebucheintrag für KraBBy

Beiträge: 601
Registriert: 19.09.2007

Inventor Professional 2020
WinX

erstellt am: 26. Jun. 2018 12:11    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Jonnok 10 Unities + Antwort hilfreich

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


Sehen Sie sich das Profil von KraBBy an!   Senden Sie eine Private Message an KraBBy  Schreiben Sie einen Gästebucheintrag für KraBBy

Beiträge: 601
Registriert: 19.09.2007

Inventor Professional 2020
WinX

erstellt am: 09. Jul. 2018 12:47    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Jonnok 10 Unities + Antwort hilfreich

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

Sehen Sie sich das Profil von lid-ds an!   Senden Sie eine Private Message an lid-ds  Schreiben Sie einen Gästebucheintrag für lid-ds

Beiträge: 2
Registriert: 10.10.2022

Inv 2021

erstellt am: 10. Okt. 2022 15:59    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Jonnok 10 Unities + Antwort hilfreich

Hallo Zusammen,
gibt es eine Möglichkeit, die Anzahl der Biegungen per VBA aus der Abwicklung zu ermitteln?

Vielen Dank vorab schonmal für Eure Hilfe.

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

KraBBy
Mitglied
Maschinenbau-Ingenieur


Sehen Sie sich das Profil von KraBBy an!   Senden Sie eine Private Message an KraBBy  Schreiben Sie einen Gästebucheintrag für KraBBy

Beiträge: 601
Registriert: 19.09.2007

Inventor Professional 2020
WinX

erstellt am: 10. Okt. 2022 17:08    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Jonnok 10 Unities + Antwort hilfreich

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

Sehen Sie sich das Profil von lid-ds an!   Senden Sie eine Private Message an lid-ds  Schreiben Sie einen Gästebucheintrag für lid-ds

Beiträge: 2
Registriert: 10.10.2022

Inv 2021

erstellt am: 11. Okt. 2022 07:43    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Jonnok 10 Unities + Antwort hilfreich

Hallo KraBBy,
funktioniert tadellos. Habe es mit mehreren Blech-Ipt getestet.
Super! Vielen Dank!

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

TLipo
Mitglied



Sehen Sie sich das Profil von TLipo an!   Senden Sie eine Private Message an TLipo  Schreiben Sie einen Gästebucheintrag für TLipo

Beiträge: 21
Registriert: 11.05.2022

erstellt am: 31. Jan. 2023 15:39    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Jonnok 10 Unities + Antwort hilfreich

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




Sehen Sie sich das Profil von rkauskh an!   Senden Sie eine Private Message an rkauskh  Schreiben Sie einen Gästebucheintrag für rkauskh

Beiträge: 2166
Registriert: 15.11.2006

Windows 10 x64, AIP 2022

erstellt am: 31. Jan. 2023 19:15    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Jonnok 10 Unities + Antwort hilfreich

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

Anzeige.:

Anzeige: (Infos zum Werbeplatz >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2023 CAD.de | Impressum | Datenschutz