| | | Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für SOLIDWORKS | | | | SOLIDWORKS PDM Professional im Einsatz bei Wölfle, ein Anwenderbericht
|
Autor
|
Thema: Macro: Alle geöffneten Zeichnung als dxf abspeichern (3202 mal gelesen)
|
brezel123 Mitglied
Beiträge: 5 Registriert: 29.04.2014
|
erstellt am: 29. Apr. 2014 17:42 <-- editieren / zitieren --> Unities abgeben:
Hallo liebe Forenbenutzer, ich hab ein VBA-Programm geschrieben, mit dem ich über eine While-Schleife alle geöffneten Zeichnungen als PDF abspeichern kann. Das Programm möchte ich nun um den DXF-Export erweitern. Reicht es da nicht einfach das aktive Dokument mit dem "saveas"-Befehl und der Dateiendung "dxf" abzuspeichern? Damit werden mir mehrere DXF-Dateien erzeugt, die alle korrekt benannt sind. Wenn ich aber die DXF-Dateien öffne sehe ich, dass es immer nur die selbe Zeichnung ist. Daher wäre meine Frage, ob man einen anderen Befehl als "saveas" für das Erstellen von dxf-Dateien in einer Schleife verwenden muss. Wäre nett, wenn ihr mir weiterhelfen würdet. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Andi Beck Ehrenmitglied V.I.P. h.c. Konstrukteur
Beiträge: 2580 Registriert: 02.10.2006 Firma: SW 2024-3.1 + PDM Prof. Windows 10 Pro 64bit, i9-11900 32 GbRAM, Quadro P2200 Home: SW 2023-5.0 Passungstabelle von Heinz Windows 11 Pro 64bit, i7-12700K, 32 GbRAM, GeForce GTX 1050Ti Samsung C34H892, 3440x1440 Pixel
|
erstellt am: 29. Apr. 2014 22:35 <-- editieren / zitieren --> Unities abgeben: Nur für brezel123
Hallo Forenbenutzer, und herzlich Willkommen hier im Forum. Ich gehe mal davon aus, das du in deiner Schleife eine Zeichnung nach der anderen in den Vordergrund holst und dann speicherst. Du kannst hier auch dein Makro veröffentlichen, damit jemand mal rein schauen kann. Mit der folgenden Routine (nicht vollständig) speichere ich Zeichnungen sowohl in PDF als auch DXF bzw. DWG und TIF. Lediglich der Extender ist geändert. Mehrblättrige Zeichnungen sind kein Thema. ''''''''''''''''''''''''''''''''''' Sub berSfDXFspeichern() Dim res As Long If Not ZeichnungSpeichern Is Nothing Then res = ZeichnungSpeichern.EditRebuild() ' Sicherheitshalber vorab noch ein Neuaufbau der Zeichnung saveFileName = Verzeichnis1 & FileNameRev & ".dwg" ZeichnungSpeichern.SaveAs2 saveFileName, 0, True, False ' der Speichervorgang Call MsgBox(saveFileName, vbSystemModal, "Information") ' Anzeige des kpl. Pfades incl. Dateinamen und Extender End If End Sub ''''''''''''''''''''''''''''''''''''''''' Du kannst dich auch mal bei Stefans Makromania umschauen. http://solidworks.cad.de/mm_boerse02.htm und hier http://solidworks.cad.de/mm_index.htm Damit müsstest du eigentlich mit deinem Makro weiter kommen. Grüße, Andi ------------------ Hast du kein Problem? Such dir eins. ( Und löse es ) Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
brezel123 Mitglied
Beiträge: 5 Registriert: 29.04.2014
|
erstellt am: 29. Apr. 2014 22:56 <-- editieren / zitieren --> Unities abgeben:
Hallo Andi, vielen Dank für deine Antwort. Ich werde morgen das Programm hochladen. Im Prinzip ist mein Programm genauso aufgebaut wie in deinem Beispiel. Allerdings fehlt bei mir diese Zeile: Code: res = ZeichnungSpeichern.EditRebuild() ' Sicherheitshalber vorab noch ein Neuaufbau der Zeichnung
Die Variable "res" gibt mir dann "true" oder "false" zurück oder? Mit Extender meinst du doch die Dateiendung .dwg, .dxf etc. oder? Was mich irritiert ist, dass das Speichern als PDF problemlos funktioniert, nur als DXF nicht. Ich werde es mal mit EditRebuild() probieren. Schönen Abend noch! Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Andi Beck Ehrenmitglied V.I.P. h.c. Konstrukteur
Beiträge: 2580 Registriert: 02.10.2006 Firma: SW 2024-3.1 + PDM Prof. Windows 10 Pro 64bit, i9-11900 32 GbRAM, Quadro P2200 Home: SW 2023-5.0 Passungstabelle von Heinz Windows 11 Pro 64bit, i7-12700K, 32 GbRAM, GeForce GTX 1050Ti Samsung C34H892, 3440x1440 Pixel
|
erstellt am: 30. Apr. 2014 00:46 <-- editieren / zitieren --> Unities abgeben: Nur für brezel123
Zitat: Original erstellt von brezel123: Mit Extender meinst du doch die Dateiendung .dwg, .dxf etc. oder?
Hallo, ja, meine ich. res ist so deklariert. Dim res As Long Grüße, Andi ------------------ Hast du kein Problem? Such dir eins. ( Und löse es ) [Diese Nachricht wurde von Andi Beck am 30. Apr. 2014 editiert.] [Diese Nachricht wurde von Andi Beck am 30. Apr. 2014 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
brezel123 Mitglied
Beiträge: 5 Registriert: 29.04.2014
|
erstellt am: 30. Apr. 2014 00:52 <-- editieren / zitieren --> Unities abgeben:
|
StefanBerlitz Guter-Geist-Moderator IT Admin (CAx)
Beiträge: 8756 Registriert: 02.03.2000 SunZu sagt: Analysiere die Vorteile, die du aus meinem Ratschlag ziehst. Dann gliedere deine Kräfte entsprechend und mache dir außergewöhnliche Taktiken zunutze.
|
erstellt am: 30. Apr. 2014 07:59 <-- editieren / zitieren --> Unities abgeben: Nur für brezel123
Hallo brezel123, der Rückgabewert ist ein Boolean, wie in der von dir gelinkten Beschreibung zu lesen heißt der Rückgabewert True, dass der Rebuild geklappt hat, False eben nicht. Wenn res als Long deklariert wird funktioniert das trotzdem, weil VB/VBA so weit ich das verstanden habe eine implizite Typenumwandlung macht und Boolean ja ohne Schwierigkeiten in ein Long reinpasst. Zitat: Reicht es da nicht einfach das aktive Dokument mit dem "saveas"-Befehl und der Dateiendung "dxf" abzuspeichern? Damit werden mir mehrere DXF-Dateien erzeugt, die alle korrekt benannt sind. Wenn ich aber die DXF-Dateien öffne sehe ich, dass es immer nur die selbe Zeichnung ist.
Ja, das reicht aus. Du machst ja vermutlich irgendwo ein SaveAs("xxx.pdf") direkt dahinter ein SaveAs("xxx.dxf") sollte passen. Wenn du immer dieselbe Zeichnung bekommst wechselst du dafür wohl das ModelDoc nicht, dann dürfte es aber beim PDF auch nicht klappen. Ich argwöhne eher, dass du eine Schleife für alle Zeichnungen hast, in der du das PDF speicherst und darin wiederum eine Schleife, in der du alles nochmal als DXF speicherst, aber das ist ohne den Code nicht zu sehen. Und du musst beim DXF-Export ein bisschen auf die Exporteinstellungen achten, da kann man ja mittlerweile einstellen, ob man nur das aktuelle Blatt, alle Blätter einzeln oder alles in eine Datei bekommt. Ciao, Stefan ------------------ Inoffizielle deutsche SolidWorks Hilfeseite http://solidworks.cad.de Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
brezel123 Mitglied
Beiträge: 5 Registriert: 29.04.2014
|
erstellt am: 30. Apr. 2014 09:27 <-- editieren / zitieren --> Unities abgeben:
Hier ist der Code für das Macro. Eine Schleifen-Verschachtelung habe ich nicht eingebaut. Code: Dim swApp As Object Dim Part As Object Dim boolstatus As Boolean Dim Component As Object Dim saveFileName As String Dim FilePath As String Dim FileNameWithExtension As String Dim filename As String Dim savePath As String Dim res As Boolean Sub main()
Set swApp = Application.SldWorks Set Part = swApp.ActiveDoc 'durch alle offenen Dokumente gehen Set Part = swApp.GetFirstDocument 'a = swApp.GetDocuments() 'value = instance.EnumDocuments2() 'Meldung, wenn keine Datei geöffnet ist If Part Is Nothing Then MsgBox "Kein Dokument offen" Exit Sub End If
'================================================ 'Speicherpfad abfragen (Inputbox) 'standardmäßig ist "C:\Dekstop" eingetragen
savePath = InputBox("Geben Sie den Speicherort ein (C:\Desktop)." & vbCrLf & "Folgende Datenformate werden unterstützt:" & vbCrLf & "PDF" & vbCrLf & "DXF" & vbCrLf & "JPEG", "Automatischer Export von Zeichnungen", "C:\Desktop") Debug.Print savePath If savePath = "" Then Exit Sub End If '================================================ 'Beginn der While-Schleife While Not Part Is Nothing ' swApp.ActiveDoc.ActiveView.FrameState = 1 ' swApp.ActiveDoc.ActiveView.FrameState = 1 ' Part.EditSketch If (swApp.ActiveDoc.GetPathName = "") Then 'Abfrage ob Name vergeben wurde MsgBox ("Bitte zuerst Zeichnung speichern!") Exit Sub End If '================================================ 'Den Dateinamen aus dem Dateipfad extrahieren
FilePath = Part.GetPathName FileNameWithExtension = Dir(FilePath) Debug.Print FileNameWithExtension saveFileName = Left(FileNameWithExtension, Len(FileNameWithExtension) - 7) Debug.Print saveFileName '================================================ 'Zeichnung als PDF abspeichern 'FileNamePDF = saveFileName & ".pdf" 'Debug.Print saveFileNamePDF 'completePathPDF = savePath + "\" + FileNamePDF 'Debug.Print completePathPDF 'Part.SaveAs2 completePathPDF, 0, True, False '================================================ 'Zeichnung als eDrawings abspeichern res = Part.EditRebuild() Debug.Print res FileNameDXF = saveFileName & ".dxf" Debug.Print FileNameDXF completePathDXF = savePath + "\" + FileNameDXF Part.SaveAs2 completePathDXF, 0, True, False '================================================ 'Zeichnung als JPEG abspeichern
'FileNameJPG = saveFileName & ".jpg" 'Debug.Print FileNameJPG 'completePathJPG = savePath + "\" + FileNameJPG 'Part.SaveAs2 completePathJPG, 0, True, False '================================================ 'swApp.CloseDoc (Part.GetPathName)
Set Part = Part.GetNext Wend
End Sub
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Andi Beck Ehrenmitglied V.I.P. h.c. Konstrukteur
Beiträge: 2580 Registriert: 02.10.2006 Firma: SW 2024-3.1 + PDM Prof. Windows 10 Pro 64bit, i9-11900 32 GbRAM, Quadro P2200 Home: SW 2023-5.0 Passungstabelle von Heinz Windows 11 Pro 64bit, i7-12700K, 32 GbRAM, GeForce GTX 1050Ti Samsung C34H892, 3440x1440 Pixel
|
erstellt am: 02. Mai. 2014 09:07 <-- editieren / zitieren --> Unities abgeben: Nur für brezel123
Hallo Brezel, weil es so schön geregnet hat, habe ich es dir ein wenig angepasst und aufgeräumt. Da hat diverses nicht gestimmt. So müsste es gehen. Dim swApp As Object Dim Part As Object Dim savePath As String Dim FilePath As String Dim FileNameWithExtension As String Dim saveFileName As String Dim FileNameDXF As String Dim completePathDXF As String Dim res As Boolean Dim ModelAct As Object
Const swDocDRAWING = 3 Sub main() Set swApp = Application.SldWorks 'das erste Dokument Set Part = swApp.GetFirstDocument 'Meldung, wenn keine Datei geöffnet ist If Part Is Nothing Then MsgBox "Kein Dokument offen" Exit Sub End If 'Speicherpfad abfragen (Inputbox) 'standardmäßig ist "C:\Dekstop" eingetragen savePath = InputBox("Geben Sie den Speicherort ein (C:\Dekstop).", "Automatischer Export von Zeichnungen", "C:\Dekstop") Debug.Print savePath If savePath = "" Then Exit Sub End If 'Beginn der While-Schleife 'durch alle offenen Dokumente gehen While Not Part Is Nothing If (Part.GetType = swDocDRAWING) Then 'wenn eine Zeichnung aktiv If (swApp.ActiveDoc.GetPathName = "") Then 'Abfrage ob Name vergeben wurde MsgBox ("Bitte zuerst Zeichnung speichern!") Exit Sub End If 'Den Dateinamen aus dem Dateipfad extrahieren FilePath = Part.GetPathName Call MsgBox(FilePath, vbSystemModal, "Information") 'Kontrollpunkt FileNameWithExtension = Dir(FilePath) Debug.Print FileNameWithExtension saveFileName = Left(FileNameWithExtension, Len(FileNameWithExtension) - 7) Debug.Print saveFileName Set ModelAct = swApp.ActivateDoc(FilePath) 'Zeichnung hervorholen 'Zeichnung als dxf abspeichern res = Part.EditRebuild() Debug.Print res FileNameDXF = saveFileName & ".dxf" Debug.Print FileNameDXF completePathDXF = savePath + "\" + FileNameDXF Part.SaveAs2 completePathDXF, 0, True, False End If Set Part = Part.GetNext Wend End Sub Grüße, Andi
------------------ Hast du kein Problem? Such dir eins. ( Und löse es ) Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
brezel123 Mitglied
Beiträge: 5 Registriert: 29.04.2014
|
erstellt am: 05. Mai. 2014 09:00 <-- editieren / zitieren --> Unities abgeben:
Hallo Andi, vielen Dank, dass du dir die Zeit genommen hast. Meine Fehler waren wohl, dass ich auch swDocPARTs als DXF ausgeben wollte anstatt nur swDocDRAWINGs und die Zeichnungen nicht "hervorgeholt" habe mit swApp.ActivateDoc(FilePath)!? Momentan wird der Speicherpfad durch die Inputbox abgefragt. Könnte ich dies durch einen OpenFileDialog, wie im Youtube-Video zu sehen ist, ersetzen? http://www.youtube.com/watch?v=nMnQmiZ9H4s Ich meld mich nochmal wenn der Code funktioniert bzw. nicht funktioniert. Grüße
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Andi Beck Ehrenmitglied V.I.P. h.c. Konstrukteur
Beiträge: 2580 Registriert: 02.10.2006 Firma: SW 2024-3.1 + PDM Prof. Windows 10 Pro 64bit, i9-11900 32 GbRAM, Quadro P2200 Home: SW 2023-5.0 Passungstabelle von Heinz Windows 11 Pro 64bit, i7-12700K, 32 GbRAM, GeForce GTX 1050Ti Samsung C34H892, 3440x1440 Pixel
|
erstellt am: 05. Mai. 2014 20:17 <-- editieren / zitieren --> Unities abgeben: Nur für brezel123
|
| Anzeige.:
Anzeige: (Infos zum Werbeplatz >>)
|