Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  Inventor
  IPT export zu DXF (2D)

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
  
Auf dem Weg zur digitalen Auftragsmappe. , ein Anwenderbericht
Autor Thema:  IPT export zu DXF (2D) (1157 / mal gelesen)
Bienenkopf
Mitglied
Maschinenbau Ingenieur


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

Beiträge: 212
Registriert: 04.11.2005

Inventor Professional 2022

erstellt am: 19. Mai. 2022 10: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

Hallo zusammen,

wir haben hier auf der Arbeit einen großen Batzen Profile (IPT-Format).
Alle haben nur eine Skizze in der selben Ebene und eine Extrusion (1000mm) zur Massenkalkulation.
Jetzt ist der Wunsch, sämtliche Profile als 2D DXF Dateien zu generieren (also die Querschnittsfläche).

Der Weg bisher:
IDW erstellen, IPT einladen, als DXF exportieren.

Jetzt sind das aber eine ganze Menge an Dateien und der Weg ist dafür recht aufwendig. Gibt es einen Kniff mit dem ich das mehr oder weniger automatisch abwickeln kann?

Grüße

------------------
MfG Pablo                        
lesen gefährdet die Dummheit

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: 2630
Registriert: 15.11.2006

Windows 10 x64, AIP 2020-2025

erstellt am: 19. Mai. 2022 10:53    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 Bienenkopf 10 Unities + Antwort hilfreich

Hallo

Rechte Maustaste auf die Stirnfläche des Profils in der IPT und "Fläche exportieren als...". Spart zumindest den Umweg über eine IDW.

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

RKW Solutions GmbH
www.RKW-Solutions.com

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

Bienenkopf
Mitglied
Maschinenbau Ingenieur


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

Beiträge: 212
Registriert: 04.11.2005

Inventor Professional 2022

erstellt am: 19. Mai. 2022 11: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

Hallo rkauskh,

danke schon mal für den Tipp. Spart schon mal ordenlich Zeit. Eine automatisierte Lösung wäre natürlich noch einen tick schicker 

------------------
MfG Pablo                        
lesen gefährdet die Dummheit

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: 721
Registriert: 19.09.2007

Inventor Professional 2020
WinX

erstellt am: 19. Mai. 2022 12:18    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 Bienenkopf 10 Unities + Antwort hilfreich

Wie hoch automatisiert solls denn sein?
Wie weit kommst Du mit dem Erstellen / Anpassen eines VBA-Makros?

Als Ausgangspunkt vielleicht das:
Export face as DXF from API
Bildung des Dateinamens wäre wohl als nächstes zu lösen...

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

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

Bienenkopf
Mitglied
Maschinenbau Ingenieur


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

Beiträge: 212
Registriert: 04.11.2005

Inventor Professional 2022

erstellt am: 30. Mai. 2022 10:56    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

Hallo KraBBy,

in der Programmierung bin ich jetzt nicht wirklich der Experte. Habe mir den Link mal angesehen und kurz probiert das Problem der "set"-Anweisungen zu beheben. Dann ist da noch deine angesprochene Herrausforderung mit der Namensgebung und natürlich würde ich nicht jede Datei öffen wollen und die Regel ausführen wollen.

Ich denke Mal, dass der Aufwand da jetzt einen extra Code zu programmieren oder aufwendig anzupassen zu groß ist. Ich wollte nur mal erfragen, ob es da vllt. etwas fertiges gibt und/oder jmd. schon mal mit konfrontiert war.

Danke trotzdem! Ich werde das wohl händisch machen   

------------------
MfG Pablo                        
lesen gefährdet die Dummheit

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: 721
Registriert: 19.09.2007

Inventor Professional 2020
WinX

erstellt am: 30. Mai. 2022 13:04    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 Bienenkopf 10 Unities + Antwort hilfreich

Du musst ja nicht gleich aufgeben. Hier findet sich schon ein "Dummer" (damit meine ich in erster Linie mich selbst), der etwas Zeit investiert.

Eine kleine Lösung, dich ich mir vorstellen kann:
- Bauteil öffnen (oder es sind viele geöffnet)
- Knopf drücken, um Makro zu starten
- Fläche picken
+ das Makro speichert die gewählte Fläche als dxf
+ Dateiname und Ablageort nach Deinen Wünschen
+ Makro schließt die geöffnete Datei (wenn Dir das sinnvoll erscheint)

Wenn also die vielen Bauteile geöffnet wären (von Hand), ginge das schnell durch. Deshalb das mit dem Schließen der Datei nach dem Export.

Für den Dateinamen und Ablageort brauche ich aber Deinen Input. Dateiname: wie die ipt? Oder auch aus einem oder mehreren iProperties zusammengesetzt?
Speicherort: wie die ipt? oder ein zentrales Verzeichnis?
Könnte es Probleme geben mit doppelten Dateinamen? Muss ich prüfen, ob schon eine gleichnamige dxf vorhanden ist?

------------------
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: 721
Registriert: 19.09.2007

Inventor Professional 2020
WinX

erstellt am: 30. Mai. 2022 14: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 Bienenkopf 10 Unities + Antwort hilfreich

hier das beschriebene in Form eines VBA-Makros. Dateiname wird von der ipt verwendet.

Code in die Default.ivb kopieren
"Optionen" ggf. anpassen
Befehl für ExportFace2DXF auf die Benutzeroberfläche legen und/oder ein Tastenkürzel festlegen.
Damit wird das Makro einfach zugänglich.

Code:

' "Optionen":
Const bAblagePfadZentral As Boolean = True
    'True: alle DXF werden im gleichen Verz. gespeichert
    'False: DXF wird in Pfad gespeichert, wie die geöffnete ipt
Const sAblagePfadZentral As String = "C:\temp\"
    'hier Pfad einstellen, \ am Ende!
    'hier landen die DXF, wenn bAblagePfadZentral = True (sonst bedeutungslos)
    'Verzeichnis muss existieren!
Const bDateiAmEndeSchliessen As Boolean = False
    'True: nach dem Export wird das aktive Dokument geschlossen (ohne Nachfrage bzgl. Speichern)
    'False: Datei bleibt geöffnet
Const bSchlussmeldungAnzeigen As Boolean = True
    'True: am Ende wird eine "Fertig"-Meldung angezeigt
    'False: keine Meldung

Dim gsFertigMsg As String

Option Explicit

Public Sub ExportFace2DXF()
' Aufruf für das Sub unten
' hier steckt die Bildung des Dateinamen
'
' KraBBy 2022-05

    Dim oDoc As Document
    Set oDoc = ThisApplication.ActiveDocument
   
    'richtiger Dateityp geoeffnet?
    If Not TypeOf oDoc Is PartDocument Then
        MsgBox "Makro nur für Bauteile!", vbInformation + vbOKOnly, "Makro abgebrochen"
        Exit Sub
    End If
   
    Dim oPrtDoc As PartDocument
    Set oPrtDoc = oDoc
   
   
    'Pfad
    Dim sPfad As String
    If bAblagePfadZentral Then  'Schalter siehe ganz oben im Modul
        sPfad = sAblagePfadZentral
    Else 'Speicherort der ipt verwenden
        sPfad = getPathName(oPrtDoc.FullFileName)
    End If
    If "" = sPfad Then
        MsgBox "Pfad ist leer." & vbCrLf & "Datei noch nicht gespeichert?", vbQuestion + vbOKOnly, "Makro abgebrochen"
        Exit Sub
    End If
   
    'Text fuer Schlussmeldung vorbereiten
    gsFertigMsg = "Im Verzeichnis " & vbCrLf & sPfad & vbCrLf _
                    & "wurde erstellt:" & vbCrLf & vbCrLf
   
    'Dateiname
    Dim sDateiName As String
    sDateiName = GetFileName(oPrtDoc.FullFileName)
    ' (Dateiendung kommt spaeter)
    If "" = sDateiName Then
        MsgBox "Dateiname ist leer." & vbCrLf & "Datei noch nicht gespeichert?", vbQuestion + vbOKOnly, "Makro abgebrochen"
        Exit Sub
    End If
   
   
    'Aufruf von Sub unten mit der eigentlichen Arbeit
    Call ExportFaceToDXF(sPfad, sDateiName, oPrtDoc)
   
       
    If bSchlussmeldungAnzeigen Then
        MsgBox gsFertigMsg, vbOKOnly, "Fertig"
    Else 'nix tun
    End If
   
    If bDateiAmEndeSchliessen Then
        Call oPrtDoc.Close(SkipSave:=True)
    Else 'nix tun
    End If
   
    'Aufraeumen
    Set oDoc = Nothing
    Set oPrtDoc = Nothing
   
End Sub

Private Sub ExportFaceToDXF(Optional sPfad As String, Optional sDatName As String, Optional oDoc As Document)
' User wählt eine Fläche aus, diese wird als dxf exportiert
' enstspricht dem Befehl "Fläche exportieren als..."
' keine Möglichkeit (bekannt) Layer etc. anzugeben
'


    If "" = sPfad Then
        sPfad = "C:\Temp\"
        sDatName = "temptest"
    End If
   
    If oDoc Is Nothing Then  'wenn referenz nicht übergeben wird (weil optional)
        Set oDoc = ThisApplication.ActiveDocument
    End If
   
    'Dateiname inkl. Pfad zusammensetzen
    Dim sFile As String
    sFile = sPfad & sDatName 'ohne Dateiendung!!!
   
    'Prüfen, ob Datei bereits existiert
    Dim ret
    If Test_FileExists(sFile & ".dxf") Then
        ret = MsgBox("Datei existiert bereits. Überschreiben?" & vbCrLf _
            & sFile & ".dxf", vbYesNoCancel, "ExportFaceToDXF")
        If vbYes = ret Then
            '(bei vbYes muss nichts weiter gemacht werden -> Funktion überschreibt best. Datei)
        ElseIf vbNo = ret Then
            Dim iCount As Integer: iCount = 0
            Do
                sFile = sFile & "_"    '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(sFile & ".dxf")
        Else    'Cancel gedrückt oder MsgBox geschlossen (oben rechts)
            MsgBox "Abbruch durch Benutzer" & vbCrLf & "Kein DXF erzeugt!", vbOKOnly, "ExportFaceToDXF abgebrochen"
            Exit Sub
        End If
    End If
   
    sFile = sFile & ".dxf"  'jetzt mit Dateiendung

On Error GoTo ErrHnd

' eigentlicher Programm-Ablauf

    'Dim oDoc As PartDocument
    'Set oDoc = ThisApplication.ActiveDocument
   
    Dim oBaseFace As Face
    Set oBaseFace = ThisApplication.CommandManager.Pick(kPartFacePlanarFilter, "Pick a face")
   
    If oBaseFace Is Nothing Then
        MsgBox "Abbruch durch Benutzer", vbInformation, "nichts gewählt"
        Exit Sub
    End If
    oDoc.SelectSet.Select oBaseFace
   
    Dim oCtrlDef As ButtonDefinition
    Set oCtrlDef = ThisApplication.CommandManager.ControlDefinitions.Item("GeomToDXFCommand")
   
    ThisApplication.CommandManager.PostPrivateEvent kFileNameEvent, sFile
    ' sollte sich die Datei nicht überschr. lassen tritt eine IV-Fehlermeldung auf ~"Fehler beim DXF-Export" - im Grunde so OK
       
    oCtrlDef.Execute
   
    gsFertigMsg = gsFertigMsg & sDatName & ".dxf" & vbCrLf

   
    'Aufräumen
    Set oBaseFace = Nothing
    Set oCtrlDef = Nothing
   
    Exit Sub

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

' ----- Hilfsfunktionen:

Public Function Test_FileExists(sFile As String) As Boolean
' existiert Datei?
' Rückgabewert True:  Datei existiert
On Error GoTo err_handler
    Dim fs As Object
    Set fs = CreateObject("Scripting.FileSystemObject")
    If fs.FileExists(sFile) Then
        'MsgBox "Datei existiert nicht", vbInformation, "Fehler in 'FileExists'"
        Test_FileExists = True
    Else
        Test_FileExists = False
    End If
    Set fs = Nothing
    Exit Function
err_handler:
    MsgBox Err.Number & vbCrLf & Err.Description, vbCritical, "Fehler im Funktion 'FileExists'"
End Function


Public Function GetFileName(sDatei_m_Pfad_u_Endung As String) As String
'liefert den Dateinamen ohne Pfad und Dateiendung
'ausgehend vom vollständigen Dateinamen (inkl. Pfad und Endung)
'rein text-basiert. keine Prüfung, ob Dateiexistiert oä.
' Pfad muss nicht enthalten sein
' der Dateiname darf mehrere Punkte enthalten (es wird nur der Text samt dem letzten Punkt entfernt)
'
' Sonderfälle:
' Eingabe ""  -> Rückgabe ""
' kein \ enthalten -> es wird die Dateiendung entfernt
' kein . enthalten -> es wird am Ende nichts entfernt
' kein . nach dem letzten \ aber vorher -> liefert alles nach dem letzten \
'

    GetFileName = ""    'Default-Rückgabewert
    If sDatei_m_Pfad_u_Endung = "" Then Exit Function
   
    Dim s As String
    s = sDatei_m_Pfad_u_Endung 'nur damit nicht der lange VarName mitgeschleppt werden muss
   
    Dim lSlash As Long
    lSlash = InStrRev(s, "\")  'Index von dem letzten BackSlash
    'sollte keiner vorhanden sein, ist das im weiteren kein Problem (lSlash=0, später je +1)
   
    Dim lDot As Long
    lDot = InStrRev(s, ".")    'index vom letzten Punkt
   
    Dim sReturn As String  'wird am Ende zurückgegeben
    If lDot = 0 Then
    'kein Punkt enthalten!
        sReturn = Mid$(s, lSlash + 1)  'am Ende nichts entfernen
    ElseIf lDot < lSlash Then
    'Punkt VOR dem letzten Backslash (also im Pfad)
        sReturn = Mid$(s, lSlash + 1)  'am Ende nichts entfernen
    Else
    'Standardfall: Punkt enthalten, nach dem letzten Backslash
   
        sReturn = Mid$(s, lSlash + 1, lDot - lSlash - 1)
        '+1: Slash soll nicht enthalten sein
        '-1: Punkt soll nicht enthalten sein
    End If
   
    GetFileName = sReturn  'Rückgabewert der Function
   
End Function


Public Function getPathName(sDatei_m_Pfad_u_Endung As String) As String
'liefert den Dateinamen ohne Pfad und Dateiendung
'ausgehend vom vollständigen Dateinamen (inkl. Pfad und ggf. Endung)
'rein text-basiert. keine Prüfung, ob Datei oder Pfad existiert oä.
'
' Sonderfälle:
' Eingabe ""  -> Rückgabe ""
' kein \ enthalten -> Rückgabe ""
' wird bereits ein Pfad angegeben mit \ am Ende, wird dieser unverändert zurückgegeben
'

    getPathName = ""    'Default-Rückgabewert
    If sDatei_m_Pfad_u_Endung = "" Then Exit Function
   
    Dim lSlash As Long
    lSlash = InStrRev(sDatei_m_Pfad_u_Endung, "\")  'Index von dem letzten BackSlash
    If 0 = lSlash Then Exit Function
   
    Dim sReturn As String  'wird am Ende zurückgegeben
   
    sReturn = Left$(sDatei_m_Pfad_u_Endung, lSlash)
    'Slash am Ende ist enthalten!
   
    getPathName = sReturn
   
End Function


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

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

Bienenkopf
Mitglied
Maschinenbau Ingenieur


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

Beiträge: 212
Registriert: 04.11.2005

Inventor Professional 2022

erstellt am: 31. Mai. 2022 14:35    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

Hallo KraBBy,

was soll ich sagen... Du bist echt unglaublich. Der Code ist der Hammer und funktioniert einwandfrei. Du hast mir schon vor 1-2 Jahren sehr geholfen. Ich finde deine Hilfsbereitschaft wirklich toll. Vielen Dank dafür!

------------------
MfG Pablo                        
lesen gefährdet die Dummheit

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)2024 CAD.de | Impressum | Datenschutz