Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  Inventor
  Makro PDF, DXF

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:  Makro PDF, DXF (1569 mal gelesen)

Ex-Mitglied

erstellt am: 24. Jan. 2020 11:17    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat

Hallo zusammen,

ich hätte eine Frage bezüglich Makros:

Ich habe in Inventor die Zeichnung (.idw) geöffnet und unser Makro ist so programmiert, dass diese automatisch als PDF und DXF abgespeichert werden.
Das Problem das aber auftritt ist, das der Zielordner der DXF und PDF leider bei der Zeichnung sitzt.

Bekomm ich die Abspeicherung der PDF und DXF so hin, dass er mir diese am Desktop speichert?

Hier noch das Makro:

Sub drawing()
Dim oapp As Inventor.Application
Set oapp = ThisApplication
Dim odoc As Inventor.DrawingDocument
Dim osource As String
Dim odest As String

If oapp.ActiveDocument Is Nothing Then
    Exit Sub
End If

If oapp.ActiveDocumentType <> kDrawingDocumentObject Then
    Exit Sub
End If

Set odoc = oapp.ActiveDocument
osource = odoc.FullFileName
odest = Left(osource, Len(osource) - 4)


Dim osheet As Inventor.Sheet
Dim counter As String

counter = 1

For Each osheet In odoc.Sheets
osheet.Activate
Call odoc.SaveAs(odest & "Blatt" & counter & ".dxf", True)
Call odoc.SaveAs(odest & "Blatt" & counter & ".pdf", True)
counter = counter + 1
Next

End Sub


Über eine Hilfe wäre ich sehr dankbar.

Etwaige Schreibfehler vorbehalten.  

Meierjo
Mitglied



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

Beiträge: 353
Registriert: 20.08.2003

Windows 10 Prof 64 Bit
Inventor Prof 2021
Vault Basic 2021

erstellt am: 24. Jan. 2020 15: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

Ja, sollte so klappen

Sub drawing()
Dim oapp As Inventor.Application
Set oapp = ThisApplication
Dim odoc As Inventor.DrawingDocument
Dim osource As String
Dim odest As String

If oapp.ActiveDocument Is Nothing Then
    Exit Sub
End If

If oapp.ActiveDocumentType <> kDrawingDocumentObject Then
    Exit Sub
End If

Set odoc = oapp.ActiveDocument
'osource = odoc.FullFileName
osource = Environ("userprofile") & "\Desktop\" & odoc.DisplayName
odest = Left(osource, Len(osource) - 4)


Dim osheet As Inventor.Sheet
Dim counter As String

counter = 1

For Each osheet In odoc.Sheets
osheet.Activate
Call odoc.SaveAs(odest & "Blatt" & counter & ".dxf", True)
Call odoc.SaveAs(odest & "Blatt" & counter & ".pdf", True)
counter = counter + 1
Next

End Sub


Gruss

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


Ex-Mitglied

erstellt am: 27. Jan. 2020 11:43    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat


CAD.jpg

 
Vielen Dank, das klappt gut.

Jetzt wäre für mich noch eine Frage offen:

Mit dem von Ihnen gesendeten Programm speichert es mir die PDF, DXF nicht mit der Dokumentennummer ab (siehe Anhang).
Wie geschieht dies oder was muss umgeschrieben werden?

Da ich leider wenig Ahnung vom programmieren habe, bitte um Hilfe.

Danke im voraus.

Mfg HADI

Charly Setter
Moderator





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

Beiträge: 11977
Registriert: 28.05.2002

Der vernünftige Mensch paßt sich der Welt an;
der unvernünftige besteht auf dem Versuch, die Welt sich anzupassen.<P>Deshalb hängt aller Fortschritt vom unvernünftigen Menschen ab.
(George Bernard Shaw)

erstellt am: 27. Jan. 2020 16:10    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

Zitat:
Original erstellt von :

Wie geschieht dies oder was muss umgeschrieben werden?


Ok, dann schaue Dir erst einmal Dateiname und Bauteilnumer an.... Was fehlt denn da, bzw. wie viele Zeichen fehlen?

Und dann schaue Dir die Zeile an, in der der Dateiname initialisiert wird:

Code:
odest = Left(osource, Len(osource) - 4)

Was da wohl passiert? Ich denke, da werden 4 Zeichen abgeschnitten. Wenn das man nicht die Zeichen sind, die Du vermisst.

Warum das jetzt passiert, und was Du ändern mußt, kannst Du jetzt ja vielleicht selber erkennen  

CU

------------------
Der vernünftige Mensch paßt sich der Welt an;
der unvernünftige besteht auf dem Versuch, die Welt sich anzupassen.

Deshalb hängt aller Fortschritt vom unvernünftigen Menschen ab.
(George Bernard Shaw)

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

Inventor Professional 2020
WinX

erstellt am: 27. Jan. 2020 19: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

das was da abgeschnitten wird (4 Zeichen am Ende) ist die Dateiendung ".idw"

Meierjo verwendet die Eigenschaft .DisplayName. Das ist die Benennung vom obersten Knoten im Modellbrowser und meist der Dateiname (ohne Pfad). Das lässt sich aber überschreiben! Liegt dieser Fall hier vor?

wenn es vorher geklappt hat mit
  Set odoc = oapp.ActiveDocument
  osource = odoc.FullFileName
  odest = Left(osource, Len(osource) - 4)

dann klappt es evtl. auch mit

Code:
Set odoc = oapp.ActiveDocument
osource = odoc.fullFilename
osource = Mid(osource, InStrRev(osource, "\") + 1) 'Pfad entfernen (alles einschl. dem letzten "\")
osource = Environ("userprofile") & "\Desktop\" & osource 'Desktop vorne anhängen
odest = Left(osource, Len(osource) - 4) 'Dateiendung entf.

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

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

Hasentöter42
Mitglied


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

Beiträge: 2
Registriert: 12.10.2022

erstellt am: 12. Okt. 2022 16:16    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

Sub DATA_EXPORT_DXF_PDF()

Dim oapp As Inventor.Application
Set oapp = ThisApplication
Dim odoc As Inventor.DrawingDocument
Dim osource As String
Dim odest As String
Dim ofolder As String
Dim ofileName As String
Dim Respone As String

If oapp.ActiveDocument Is Nothing Then
    Response = MsgBox("No drawing document open", vbYes, "Export")
    Exit Sub
End If

If oapp.ActiveDocumentType <> kDrawingDocumentObject Then
    Response = MsgBox("No drawing document open", vbYes, "Export")
    Exit Sub
End If

Set odoc = oapp.ActiveDocument
osource = odoc.FullFileName
ofolder = Left(osource, Len(osource) - Len(odoc.DisplayName))
ofileName = Left(odoc.DisplayName, Len(odoc.DisplayName) - 4)

Dim osheet As Inventor.Sheet
Dim counter As String

counter = 1

For Each osheet In odoc.Sheets
osheet.Activate
Call odoc.SaveAs(ofolder & ofileName & ".dxf", True)
Call odoc.SaveAs(ofolder & ofileName & ".pdf", True)

counter = counter + 1

Next

Response = MsgBox("dxf & pdf created", vbYes, "Export")

End Sub

Sub DATA_EXPORT_STEP()

Dim oapp As Inventor.Application
Set oapp = ThisApplication
Dim odoc As Inventor.PartDocument
Dim osource As String
Dim odest As String
Dim ofolder As String
Dim ofileName As String

Dim Response As String

If oapp.ActiveDocument Is Nothing Then
    Response = MsgBox("No part document open", vbYes, "Export")
    Exit Sub
End If

If oapp.ActiveDocumentType <> kPartDocumentObject Then
    Response = MsgBox("No part document open", vbYes, "Export")
    Exit Sub
End If


Set odoc = oapp.ActiveDocument
osource = odoc.FullFileName
ofolder = Left(osource, Len(osource) - Len(odoc.DisplayName))
ofileName = Left(odoc.DisplayName, Len(odoc.DisplayName) - 4)
Call odoc.SaveAs(ofolder & ofileName & ".step", True)

Response = MsgBox("step created", vbYes, "Export")

End Sub

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

Hasentöter42
Mitglied


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

Beiträge: 2
Registriert: 12.10.2022

erstellt am: 12. Okt. 2022 16:20    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

Vielen Dank für das sehr gute Makro!

Wir haben es verbessert, dass die erzeugten PDFs und DXF Dateien im originalen Ordnerpfad landen.

Des Weiteren haben wir ein zweites Makro erstellt, welches auf dem 3D Körper eine .STEP Datei erzeugt.

Viel Spaß damit.

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

Inventor Professional 2020
WinX

erstellt am: 12. Okt. 2022 17:33    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

Zitat:
Original erstellt von Hasentöter42:
[...]
Set odoc = oapp.ActiveDocument
osource = odoc.FullFileName
ofolder = Left(osource, Len(osource) - Len(odoc.DisplayName))
[...]


Mir fällt auf dass .FullFileName (dann osource) UND .DisplayName genutzt werden. Das funktioniert nur, wenn zweiter nicht überschrieben ist. Das muss nicht so sein (schrieb ich schon, mein Post oben).

Im Sinne von "passt für mehr Anwender", schlage ich die Verwendung folgender beiden Functions vor

Code:
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 \
'
'KraBBy 08.01.2021

    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



Code:
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
'
'KraBBy 19.01.2021

    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


Der Aufruf könnte dann so aussehen

Code:
oFolder = GetFileName(odoc.FullFileName)
oFileName = getPathName(odoc.FullFileName)

Ansonsten natürlich herzlichen Dank fürs Bereitstellen des Codes!

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

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