| | | Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für SOLIDWORKS | | | | myCAD 2024 Visiativ-Kundentag in Rosenheim, eine Veranstaltung am 29.10.2024
|
Autor
|
Thema: Makro - Solidworks 2018/2019 (3273 / mal gelesen)
|
Rene82 Mitglied
Beiträge: 15 Registriert: 14.05.2019
|
erstellt am: 14. Mai. 2019 10:56 <-- editieren / zitieren --> Unities abgeben:
Hallo Zusammen, ich hoffe ihr könnt mir bei der Erstellung eines Makros helfen! Folgende Funktionalität: Es geht darum das Zeichnungen, egal ob jetzt eine oder mehrere in Solidworks geöffnet sind, per Makro als PDF-Datei an einer definierten Stelle( Pfad) abgelegt werden, dabei aber der Dateinamen sich aus bestimmten benutzerdefinierten Eigenschaften zusammen setzen soll: Beispiel: "Zeichnungsnummer" + "Revision" + _"Benennung" + ".pdf" Den normalen Export als PDF habe ich hinbekommen mit Hilfe des WWW´s. Hier mein bisheriger "Code": Sub main() Dim swApp As SldWorks.SldWorks Dim swModel As SldWorks.ModelDoc2 Dim swExportPDFData As SldWorks.ExportPdfData Dim SWmoddoc As SldWorks.ModelDoc2 Dim strFilename As String Dim swConfigMgr As SldWorks.ConfigurationManager Dim swConfig As SldWorks.Configuration Dim swCustPropMgr As SldWorks.CustomPropertyManager Dim pfad As String pfad = "W:\400_ABCD\410_EFGH\IJKL\200_MNOP\510_QRST\010_UVWX\002_YZ99\" Set swApp = Application.SldWorks Set swModel = swApp.ActiveDoc Set swConfigMgr = swModel.ConfigurationManager Set swConfig = swConfigMgr.ActiveConfiguration Set swCustPropMgr = swConfig.CustomPropertyManager 'Save swModel.Save3 0, 0, 0 'Export to PDF if it is a drawing If swModel.GetType = swDocDRAWING Then strFilename = swModel.GetPathName strFilename = Left(strFilename, Len(strFilename) - 7) & ".pdf" strFilename = pfad & Mid$(strFilename, InStrRev(strFilename, "\") + 1) 'strFilename = Left(strFilename, Len(strFilename) - 6) & "pdf" Set swExportPDFData = swApp.GetExportFileData(1) swModel.Extension.SaveAs strFilename, 0, 0, swExportPDFData, 0, 0 MsgBox (strFilename) End If End Sub Über eure Hilfe bin ich sehr dankbar! Sollte dieser Eintrag an der falschen Stelle des Forums sein, bitte verschiebt diesen in den richtigen Bereich!
Gruß René
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
HenryV Mitglied Konstrukteur, Engineering
Beiträge: 817 Registriert: 18.05.2005 SolidWorks 2022 x64 SP5.0 Dell Precision 5820 Intel Xeon W-2125 4x4GHz NVIDIA Quadro P2000 5GB 32GB RAM 2x Dell U2412M, 24" TFT Windows 10 Enterprise x64 22H2 Microsoft 365 E5 Microsoft Visual Studio Enterprise 2022
|
erstellt am: 15. Mai. 2019 12:04 <-- editieren / zitieren --> Unities abgeben: Nur für Rene82
|
ConZept Mitglied Maschinenbautechniker
Beiträge: 15 Registriert: 19.02.2019 SolidWorks 2018 / SP 4.0 Win7x64 /HP Z440
|
erstellt am: 15. Mai. 2019 20:26 <-- editieren / zitieren --> Unities abgeben: Nur für Rene82
Hallo René! Finde ich gut, dass du dir schon ein wenig Code selbst zusammengeschnipselt hast. Vorab ein kleiner Tipp, wenn du dich des öfteren mit Makros beschäftigen möchtest: Code-Lesbarkeit: Ich persönlich bevorzuge es die einzelnen Teile des strings zu bekommen, um diese im Anschluss in einen string zu vereinen. Wenn du auch ein vorgegebenen string hast (in deinem Beispiel der Speicherpfad), würde ich das schon in der Deklaration mit angeben.
Code: Const sPath as string = "W:\400_ABCD\410_EFGH\IJKL\200_MNOP\510_QRST\010_UVWX\002_YZ99\"
Manchmal kann es auch einfacher sein, den Titel des Dokuments zu holen, anstatt den Speicherpfad zu zerstückeln (je nach Arbeitsweise).
Code:
Dim swApp as SldWorks.SldWorks Dim swModel as ModelDoc2 Dim sTitle as stringSet swApp = Application.SldWorks Set swModel = swApp.ActiveDoc sTitle = swModel.GetTitle
Wenn du weißt, dass das Makro nur in Zeichnungen verwendbar ist, dann würde ich deinen "Check" nach einer offenen Zeichnung ganz an den Anfang stellen.
Code:
Set swApp = Application.SldWorks Set swModel = swApp.ActiveDocIf swModel.GetType <> swDocDRAWING Then End 'Beendet das Makro End if 'Und weiter geht's mit dem Code..
So aber nun zu deiner Frage ;p
Um an die Benutzerdefinierten Eigenschaften zu kommen, musst du den CustomPropertyManager verwenden, den du auch schon deklariert hast.
Code:
Dim IRet as Integer Dim ValOut as String Dim ResolvedValOut as String Dim sProperty as String 'Deine Eigenschaft, wie z.B. Revision Dim WasResolved as BooleanDim swApp as SldWorks.SldWorks Dim swModel as ModelDoc2 Dim swCustPropMgr as SldWorks.CustomPropertyManager Dim swModelExt as SldWorks.ModelDocExtension Set swApp = Application.SldWorks Set swModel = swApp.ActiveDoc Set swModelExt = swModel.Extension Set swCustPropMgr = swModelExt.CustomPropertyManager("") IRet = swCustPropMgr.Get5("Name der Eigenschaft für bspw. Revision", False, ValOut, ResolvedValOut, WasResolved) 'IRet = 1 wenn es die Eigenschaft nicht gibt / IRet = 2 wenn die Eigenschaft existiert sProperty = ValOut 'ValOut gibt den Wert der Benutzerdefinierten Eigenschaft zurück
Das Ganze geht natürlich auch, wenn du Konfigurationsspezifische Eigenschaften haben möchtest, hier darfst du aber erst mal selbst ausprobieren ;-) So kannst du dir dann deine benötigten Eigenschaften holen (Revision, Benennungen etc..) und dir das als Speichernamen zusammenstellen. Hoffe das bringt dich etwas weiter ------------------ Gruß ConZept [Diese Nachricht wurde von ConZept am 15. Mai. 2019 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Rene82 Mitglied
Beiträge: 15 Registriert: 14.05.2019
|
erstellt am: 16. Mai. 2019 16:01 <-- editieren / zitieren --> Unities abgeben:
Hallo ConZept, Hallo Andreas, vielen lieben Dank für eure Unterstützung! DANKE! Ich habe es dank deiner deiner Unterstützung mit deinem "Code" geschafft, ConZept, das er die Werte aus den Benutzerdefinierten Eigenschaften ausliest, aber bin ich noch auf etwas anderes gestoßen: Die benutzerdefinierten Eigenschaften sind im 3D-Model hinterlegt (erstellt mit dem Proberty Tab Builder und Properties.txt, template.asmprp; template.prtprp ) und werden automatisch in das Schriftfeld der Zeichnung eingetragen. Dies bedeutet das die Zeichnung an sich keine benutzerdefinierten Eigenschaften besitzt. Ich habe mir die Mühe gemacht gehabt und der "TestZeichnung" benutzerdefinierte Eigenschaften (template.drwprp) zugewiesen, damit ich die ValOut-Werte bekomme. Diese Werte allerdings in den "Speichernamen" zu werfen, gelingt mir leider nicht, da bin ich einfach ein "little stupid Newbie". Solidworks benötigt für Baugruppe; Einzelteil; Zeichnung immer ein extra template. Ich habe auch noch keine Möglichkeit gefunden das Solidworks automatisch die benutzerderfinierten Eigenschaften aus dem 3D-Model (template.asmprp --> template.dreprp) in die benutzerdefinierten Eigenschaften der Zeichnung übertrag ausser in das Schriftfeld per Verlinkung "$PRPSheet{}". Die Vorlagen (Templates) sind alle vom Inhalt her gleich aufgebaut und benannt. Also kommt somit die Herausforderung hinzu:
Die benutzerdefinierten Eigenschaften aus dem 3D-Model zu nutzen, welche automatisch in das Zeichnungsschriftfeld (Verknüpfung per $PRPSheet{}) eingetragen werden und für das Abspeichern der Zeichnung im PDF-Format mit dem genannten Aufbau genutzt werden (ZnNr+Rev_Bez.pdf) Hier mein Stand:
Sub main() Set swApp = Application.SldWorks Dim swModel As ModelDoc2 Dim swExportPDFData As SldWorks.ExportPdfData Dim SWmoddoc As SldWorks.ModelDoc2 Dim strFilename As String Dim swConfigMgr As SldWorks.ConfigurationManager Dim swConfig As SldWorks.Configuration Dim swCustPropMgr As SldWorks.CustomPropertyManager Dim sTitle As String Const sPath As String = "W:\400_Name1\410_Name2\Name3\Exportdaten\010_Name4\" Set swApp = Application.SldWorks Set swModel = swApp.ActiveDoc sTitle = swModel.GetTitle If swModel.GetType <> swDocDRAWING Then End 'Beendet das Makro End If Dim IRet As Integer Dim IRet2 As Integer Dim IRet3 As Integer Dim ValOut As String Dim ValOut2 As String Dim ValOut3 As String Dim sProperty As String 'Deine Eigenschaft, hier Zeichnungsnummer Dim sProperty2 As String 'Deine Eigenschaft, hier Revision Dim sProperty3 As String 'Deine Eigenschaft, hier Bezeichnung 'Dim Zeichnungsnummer As String 'Dim Revision As String 'Dim Beschreibung As String Dim ResolvedValOut As String Dim ResolvedValOut2 As String Dim ResolvedValOut3 As String Dim WasResolved As Boolean Dim WasResolved2 As Boolean Dim WasResolved3 As Boolean Dim swModelExt As SldWorks.ModelDocExtension Set swApp = Application.SldWorks Set swModel = swApp.ActiveDoc Set swModelExt = swModel.Extension Set swCustPropMgr = swModelExt.CustomPropertyManager("") IRet = swCustPropMgr.Get5("Zeichnungsnummer", False, ValOut, ResolvedValOut, WasResolved) 'IRet = 1 wenn es die Eigenschaft nicht gibt / IRet = 2 wenn die Eigenschaft existiert IRet2 = swCustPropMgr.Get5("Revision", False, ValOut2, ResolvedValOut2, WasResolved2) IRet3 = swCustPropMgr.Get5("Beschreibung", False, ValOut3, ResolvedValOut3, WasResolved3) sProperty = ValOut = "Zeichnungsnummer" 'ValOut gibt den Wert der Benutzerdefinierten Eigenschaft zurück sProperty2 = ValOut2 = "Revision" 'ValOut gibt den Wert der Benutzerdefinierten Eigenschaft zurück sProperty3 = ValOut3 = "Beschreibung" 'ValOut gibt den Wert der Benutzerdefinierten Eigenschaft zurück 'Export to PDF if it is a drawing If swModel.GetType = swDocDRAWING Then strFilename = "_" & ".pdf" Set swExportPDFData = swApp.GetExportFileData(1) swModel.Extension.SaveAs strFilename, 0, 0, swExportPDFData, 0, 0 MsgBox (sPath + strFilename) End If Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
ConZept Mitglied Maschinenbautechniker
Beiträge: 15 Registriert: 19.02.2019 SolidWorks 2018 / SP 4.0 Win7x64 /HP Z440
|
erstellt am: 16. Mai. 2019 20:14 <-- editieren / zitieren --> Unities abgeben: Nur für Rene82
Hallo René, schön das du weiter gekommen bist Das ist meist normal, dass man immer auf weitere Hürden stößt, die es zu überwinden gilt. Du kannst aber auch aus der Zeichnung heraus auf die Eigenschaften des referenzierten Teils/Baugruppe zugreifen. Stichwort hier: ReferencedDocument Damit kannst du aus einer View das ModelDoc2 des referenzierten Dokuments bekommen und weiter bearbeiten. Würde dann quasi so aussehen:
Code:
Dim swApp as SldWorks.SldWorks Dim swModel as ModelDoc2 Dim swDraw as SldWorks.DrawingDoc Dim swView as SldWorks.ViewSet swApp = Application.SldWorks Set swDraw = swApp.ActiveDoc Set swView = swDraw.GetFirstView Set swView = swView.GetNextView 'erste Ansicht auf der Zeichnung Set swModel = swView.ReferencedDocument 'hier hast du dann den ModelDoc2 pointer von dem referenzierten Teil
Dann geht es "normal" weiter um die Eigenschaften auszulesen. Habe auch deinen Code ein wenig "verschönert", wie ich ihn schreiben würde. Einfach um hochgezählte Variablen zu vermeiden: Code:
Dim swApp as SldWorks.SldWorks Dim swModel As ModelDoc2 Dim swModelExt As SldWorks.ModelDocExtension Dim swConfigMgr As SldWorks.ConfigurationManager Dim swConfig As SldWorks.Configuration Dim swCustPropMgr As SldWorks.CustomPropertyManager Dim swExportPDFData As SldWorks.ExportPdfDataDim IRet As Integer Dim strFilename As String Dim sTitle As String Dim ValOut As String Dim sDrawingNo As String 'Zeichnungsnummer Dim sRevision As String 'Revision Dim sDescription As String 'Bezeichnung Dim ResolvedValOut As String Dim WasResolved As Boolean Const sPath As String = "W:\400_Name1\410_Name2\Name3\Exportdaten\010_Name4\" '********************** Properties ***************************** Const pZeichnungsnummer As String = "Zeichnungsnummer" Const pRevision As String = "Revision" Const pBeschreibung As String = "Beschreibung" '*************************************************************** Sub main() Set swApp = Application.SldWorks Set swModel = swApp.ActiveDoc If swModel.GetType <> swDocDRAWING Then MsgBox "Makro kann nur in Zeichnungen ausgeführt werden.", vbCritical End 'Beendet das Makro End If sTitle = swModel.GetTitle Set swModelExt = swModel.Extension Set swCustPropMgr = swModelExt.CustomPropertyManager("") 'Hole die Zeichnungsnummer IRet = swCustPropMgr.Get5(pZeichnungsnummer, False, ValOut, ResolvedValOut, WasResolved) sDrawingNo = ValOut 'Hole die Revision IRet = swCustPropMgr.Get5(pRevision, False, ValOut, ResolvedValOut2, WasResolved2) sRevision = ValOut 'Hole die Beschreibung IRet = swCustPropMgr.Get5(pBeschreibung, False, ValOut, ResolvedValOut3, WasResolved3) sDescription = ValOut 'Export to PDF if it is a drawing 'Hier brauchst du kein check mehr nach der Zeichnung, da dies schon am Anfang steht strFilename = sPath & sDrawingNo & "+" & sRevision & "_" & sDescription & ".pdf" Set swExportPDFData = swApp.GetExportFileData(1) swModel.Extension.SaveAs strFilename, 0, 0, swExportPDFData, 0, 0 MsgBox (sPath + strFilename)
Habe gerade kein VBA zur Verfügung, um zu sehen ob das funktioniert, aber ich hoffe du kriegst die Idee ;-) Viel Erfolg beim ausprobieren mit dem referenzierten Dokument! ------------------ Gruß ConZept Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Rene82 Mitglied
Beiträge: 15 Registriert: 14.05.2019
|
erstellt am: 21. Mai. 2019 09:29 <-- editieren / zitieren --> Unities abgeben:
Hallo Conzept, ich bin sehr froh und dankbar für deine Unterstützung! Habe jetzt die letzten Tage versucht die Eigenschaften aus dem Model, welches ja mit bzw. in der Zeichnung referenziert ist auslesen: das war dein Tip: Set swModel = swView.ReferencedDocument 'hier hast du dann den ModelDoc2 pointer von dem referenzierten Teil Er nimmt bzw. liest es aber nicht aus: 'Hole die Zeichnungsnummer IRet = swCustPropMgr.Get5(pZeichnungsnummer, False, ValOut, ResolvedValOut, WasResolved) sDrawingNo = ValOut Sobald ich allerdings die benutzerdefinierten Eigenschaften über das Template.drwprp per Hand eintrage und dann das Makro laufen lasse, nimmt er aus den Zellen (Zn., Rev., Bez.)die händig eingetragenen Werte. Aber eine Referenzierung zum Model macht er irgendwie nicht. Obwohl er mir hier : "sTitle = swModel.GetTitle das Model" richtig ausgibt. Unter "Set swModel = swView.ReferencedDocument 'hier hast du dann den ModelDoc2 pointer von dem referenzierten Teil" gibt er mir NOTHING zurück. Gruß René Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Spirou85 Mitglied Konstruktuer und CAD-Betreuer
Beiträge: 70 Registriert: 01.12.2014 HP ZBook 15 G5 Intel Xeon 2,9 GHz - 32GB Ram NVIDIA Quadro P2000M Windows 10 Pro 64Bit Version 1809 Build 17763.1098 SWX2020-64Bit-SP1.0 MaxxDB 2020 SP0.06 DraftSight Enterprise 2019 x64 SP3 3DCONNEXION SpaceMouse Enterprise mit CadMouse
|
erstellt am: 21. Mai. 2019 10:22 <-- editieren / zitieren --> Unities abgeben: Nur für Rene82
Hallo René, mit dem Code von Conzept holst Du Die schon die zweite Ansicht, und wenn Du nur eine Ansicht in der Zeichnung hast, dann wird natürlich Nothing zurück gegeben. Statt
Code:
Dim swApp as SldWorks.SldWorks Dim swModel as ModelDoc2 Dim swDraw as SldWorks.DrawingDoc Dim swView as SldWorks.ViewSet swApp = Application.SldWorks Set swDraw = swApp.ActiveDoc Set swView = swDraw.GetFirstView Set swView = swView.GetNextView 'erste Ansicht auf der Zeichnung Set swModel = swView.ReferencedDocument 'hier hast du dann den ModelDoc2 pointer von dem referenzierten Teil
müsste es folgendermaßen lauten: Code:
Dim swApp as SldWorks.SldWorks Dim swModel as ModelDoc2 Dim swDraw as SldWorks.DrawingDoc Dim swView as SldWorks.ViewSet swApp = Application.SldWorks Set swDraw = swApp.ActiveDoc Set swView = swDraw.GetFirstView 'erste Ansicht auf der Zeichnung Set swModel = swView.ReferencedDocument 'hier hast du dann den ModelDoc2 pointer von dem referenzierten Teil
Dann hat man einen Pointer auf die erste Ansicht.
------------------ Viele Grüße aus Brackenheim Lars Pauly Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Rene82 Mitglied
Beiträge: 15 Registriert: 14.05.2019
|
erstellt am: 21. Mai. 2019 12:17 <-- editieren / zitieren --> Unities abgeben:
Hallo Lars, Hallo ConZept, danke für den Hinweis mit "getfirstview"! Aber leider nimmt er nicht das referenzierte Model innerhalb der Zeichnung um die Werte auszulesen! Ich denke das Problem in Bezug auf folgendes ist: Es muss ein Makrobefehl geben der der Zeichnung sagt: "Nimm nicht die Eigenschaften der aktuellen Zeichnung sondern nimm die im Model gefundenen Eigenschaften. Dieses Umschalten von "Benutzereigenschaften verwenden von "Aktuelles Dokument" auf "Modell hier gefunden" --> danach Name der Eigenschaft wählen --> Zeichnungsnummer (<-- siehe beigefügten Screenshot). Über diesen Weg habe ich ja das Schriftfeld "automatisiert". Der Anwender muss somit nur einmal im Model die Benutzerdefinierten Eigenschaften eintragen und nicht mehrmals die selbe "Arbeit" machen, vermindern ja auch die Fehlerrate. Und dieses Umschalten auf "Modeleigenschaften" ist der Knackpunkt, denke ich. Wie schon erwähnt, sobald ich die Eigenschaften per Hand in das template.drwprp eintrage, läuft das Makro auch. Das Makro bezieht sich leider aus irgendeinem Grund nur auf die Eigenschaften des aktuellen "Zeichnungs-"Dokumentes. Grüße René Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Spirou85 Mitglied Konstruktuer und CAD-Betreuer
Beiträge: 70 Registriert: 01.12.2014 HP ZBook 15 G5 Intel Xeon 2,9 GHz - 32GB Ram NVIDIA Quadro P2000M Windows 10 Pro 64Bit Version 1809 Build 17763.1098 SWX2020-64Bit-SP1.0 MaxxDB 2020 SP0.06 DraftSight Enterprise 2019 x64 SP3 3DCONNEXION SpaceMouse Enterprise mit CadMouse
|
erstellt am: 21. Mai. 2019 12:30 <-- editieren / zitieren --> Unities abgeben: Nur für Rene82
|
Rene82 Mitglied
Beiträge: 15 Registriert: 14.05.2019
|
erstellt am: 21. Mai. 2019 12:37 <-- editieren / zitieren --> Unities abgeben:
Hallo Lars, hier bitte: Dies ist der Aufbau den mir ConZept gegeben hat und ich versuche über den Object Browser dann die Befehle herauszusuchen und auszuprobieren, wenn die nicht funktionieren gehe ich zur Ausgangslage erstmal wieder zurück. Sub main() Dim swApp As SldWorks.SldWorks Dim swModel As ModelDoc2 Dim swDraw As SldWorks.DrawingDoc Dim swview As SldWorks.View Dim swModelExt As SldWorks.ModelDocExtension Dim swConfigMgr As SldWorks.ConfigurationManager Dim swConfig As SldWorks.Configuration Dim swCustPropMgr As SldWorks.CustomPropertyManager Dim swExportPDFData As SldWorks.ExportPdfData Dim IRet As Integer Dim strFilename As String Dim sTitle As String Dim ValOut As String Dim sZeichnungsnummer As String 'Zeichnungsnummer Dim sRevision As String 'Revision Dim sBeschreibung As String 'Beschreibung
Dim ResolvedValOut As String Dim WasResolved As Boolean
Dim swModelName As String Const sPfad As String = "W:\400_Name\410_Name1\Name2\Name3\010_Name4\" Set swApp = Application.SldWorks Set swDraw = swApp.ActiveDoc Set swModel = swApp.ActiveDoc
'Set swView = swDraw.GetNextView Set swview = swDraw.GetFirstView 'erste Ansicht auf der Zeichnung Set swModel = swview.ReferencedDocument 'hier hast du dann den ModelDoc2 pointer von dem referenzierten Teil Set swApp = Application.SldWorks Set swModel = swApp.ActiveDoc '********************** Properties ***************************** Const pZeichnungsnummer As String = "Zeichnungsnummer" Const pRevision As String = "Revision" Const pBeschreibung As String = "Beschreibung" '*************************************************************** If swModel.GetType <> swDocDRAWING Then MsgBox "Makro kann nur in Zeichnungen ausgeführt werden.", vbCritical End 'Beendet das Makro End If sTitle = swModel.GetTitle Set swModelExt = swModel.Extension Set swCustPropMgr = swModelExt.CustomPropertyManager("") 'IRet = 1 wenn es die Eigenschaft nicht gibt / IRet = 2 wenn die Eigenschaft existiert 'Hole die Zeichnungsnummer IRet = swCustPropMgr.Get5(pZeichnungsnummer, False, ValOut, ResolvedValOut, WasResolved) sZeichnungsnummer = ValOut 'Hole die Revision IRet = swCustPropMgr.Get5(pRevision, False, ValOut, ResolvedValOut, WasResolved) sRevision = ValOut 'Hole die Beschreibung IRet = swCustPropMgr.Get5(pBeschreibung, False, ValOut, ResolvedValOut, WasResolved) sBeschreibung = ValOut 'Export to PDF if it is a drawing 'Hier brauchst du kein check mehr nach der Zeichnung, da dies schon am Anfang steht strFilename = sPfad & sZeichnungsnummer & " " & sRevision & "_" & sBeschreibung & ".pdf" Set swExportPDFData = swApp.GetExportFileData(1) swModel.Extension.SaveAs strFilename, 0, 0, swExportPDFData, 0, 0 MsgBox (sPath + strFilename) End Sub Gruß René Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
HenryV Mitglied Konstrukteur, Engineering
Beiträge: 817 Registriert: 18.05.2005 SolidWorks 2022 x64 SP5.0 Dell Precision 5820 Intel Xeon W-2125 4x4GHz NVIDIA Quadro P2000 5GB 32GB RAM 2x Dell U2412M, 24" TFT Windows 10 Enterprise x64 22H2 Microsoft 365 E5 Microsoft Visual Studio Enterprise 2022
|
erstellt am: 21. Mai. 2019 12:57 <-- editieren / zitieren --> Unities abgeben: Nur für Rene82
@Spirou85 Da hast du was Falsch verstanden.Mit GetFirstView, bekommst du zwar schon die "erste" Ansicht auf der Zeichnung, aber die erste Ansicht ist das Blatt selber. Erst mit GetNextView bekommst du die erste Ansicht mit einem Modell. Zum selber überprüfen -> Get Drawing View Names and Types Example (VBA)@Rene82 Du hast da ein Durcheinander und machst Sachen doppelt und dreifach. z.B. setzt du swModel = swApp.ActiveDoc <- Zeichnung dann Set swModel = swview.ReferencedDocument <- Referenziertes Modell und zuletzt wieder Set swModel = swApp.ActiveDoc <- Zeichnung Das kann nicht funktionieren. Ich hab den Code einmal angepasst (Die unnötigen Variablendeklarationen hab ich mal drin gelassen).
Code: Sub main() Dim swApp As SldWorks.SldWorks Dim swModel As ModelDoc2 Dim swDraw As SldWorks.DrawingDoc Dim swview As SldWorks.View Dim swModelExt As SldWorks.ModelDocExtension Dim swConfigMgr As SldWorks.ConfigurationManager Dim swConfig As SldWorks.Configuration Dim swCustPropMgr As SldWorks.CustomPropertyManager Dim swExportPDFData As SldWorks.ExportPdfData Dim IRet As Integer Dim strFilename As String Dim sTitle As String Dim ValOut As String Dim sZeichnungsnummer As String 'Zeichnungsnummer Dim sRevision As String 'Revision Dim sBeschreibung As String 'Beschreibung Dim ResolvedValOut As String Dim WasResolved As Boolean Dim swModelName As String Const sPfad As String = "W:\400_Name\410_Name1\Name2\Name3\010_Name4\" Set swApp = Application.SldWorks Set swDraw = swApp.ActiveDoc If swDraw.GetType <> swDocDRAWING Then MsgBox "Makro kann nur in Zeichnungen ausgeführt werden.", vbCritical End 'Beendet das Makro End If Set swview = swDraw.GetFirstView 'erste Ansicht auf der Zeichnung Set swview = swDraw.GetNextView Set swModel = swview.ReferencedDocument 'hier hast du dann den ModelDoc2 pointer von dem referenzierten Teil '********************** Properties ***************************** Const pZeichnungsnummer As String = "Zeichnungsnummer" Const pRevision As String = "Revision" Const pBeschreibung As String = "Beschreibung" '*************************************************************** sTitle = swModel.GetTitle Set swModelExt = swModel.Extension Set swCustPropMgr = swModelExt.CustomPropertyManager("") 'IRet = 1 wenn es die Eigenschaft nicht gibt / IRet = 2 wenn die Eigenschaft existiert 'Hole die Zeichnungsnummer IRet = swCustPropMgr.Get5(pZeichnungsnummer, False, ValOut, ResolvedValOut, WasResolved) sZeichnungsnummer = ValOut 'Hole die Revision IRet = swCustPropMgr.Get5(pRevision, False, ValOut, ResolvedValOut, WasResolved) sRevision = ValOut 'Hole die Beschreibung IRet = swCustPropMgr.Get5(pBeschreibung, False, ValOut, ResolvedValOut, WasResolved) sBeschreibung = ValOut 'Export to PDF if it is a drawing 'Hier brauchst du kein check mehr nach der Zeichnung, da dies schon am Anfang steht strFilename = sPfad & sZeichnungsnummer & " " & sRevision & "_" & sBeschreibung & ".pdf" Set swExportPDFData = swApp.GetExportFileData(1) Set swModel = swDraw swModel.Extension.SaveAs strFilename, 0, 0, swExportPDFData, 0, 0 MsgBox (sPath + strFilename) End Sub
Gruss Andreas ------------------ 21 ist nur die halbe Antwort.
[Diese Nachricht wurde von HenryV am 21. Mai. 2019 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Rene82 Mitglied
Beiträge: 15 Registriert: 14.05.2019
|
erstellt am: 21. Mai. 2019 14:18 <-- editieren / zitieren --> Unities abgeben:
Hallo Andreas, ja ich bin da noch sehr chaotisch unterwegs, aber da ich ein "little Stupid Newbie" verzeih mit bitte noch mein Chaos. Set swview = swDraw.GetFirstView 'erste Ansicht auf der Zeichnung Set swview = swview.GetNextView Durch diese Funktion holt er tatsächlich die Werte aus dem Model, Das Makro läuft durch holt sich auch die Werte aus dem Model, VIELEN DANK HIERFÜR - DANKE DANKE. ABER: Er speichert jetzt keine PDF´s mehr ab! Gibt mir aber als Message es wäre abgespeichert unter der Pfadangabe. Wenn ich im Explorer nach schauen liegen keine erzeugten PDF-Dateien Grüße an Euch René
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
HenryV Mitglied Konstrukteur, Engineering
Beiträge: 817 Registriert: 18.05.2005 SolidWorks 2022 x64 SP5.0 Dell Precision 5820 Intel Xeon W-2125 4x4GHz NVIDIA Quadro P2000 5GB 32GB RAM 2x Dell U2412M, 24" TFT Windows 10 Enterprise x64 22H2 Microsoft 365 E5 Microsoft Visual Studio Enterprise 2022
|
erstellt am: 21. Mai. 2019 14:38 <-- editieren / zitieren --> Unities abgeben: Nur für Rene82
Da ist mir einer durch die Lappen gegangen. Um die Zeichnung als PDF zu speichern, muss man das swDraw wieder dem swModel zuweisen. Code: ... Set swExportPDFData = swApp.GetExportFileData(1) Set swModel = swDraw swModel.Extension.SaveAs strFilename, 0, 0, swExportPDFData, 0, 0 MsgBox (sPath + strFilename) ...
Den Code oben hab ich auch ergänzt. Gruss Andreas ------------------ 21 ist nur die halbe Antwort. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Rene82 Mitglied
Beiträge: 15 Registriert: 14.05.2019
|
erstellt am: 21. Mai. 2019 14:53 <-- editieren / zitieren --> Unities abgeben:
Hallo Andreas, ConZept, Spirou85,Vielen Lieben Dank für die Unterstützung beim Erstellen dieses Makros! - 1000 Dank!! Hier nochmal der komplette Code: Sub main() Dim swApp As SldWorks.SldWorks Dim swModel As ModelDoc2 Dim swDraw As SldWorks.DrawingDoc Dim swview As SldWorks.View Dim swModelExt As SldWorks.ModelDocExtension Dim swConfigMgr As SldWorks.ConfigurationManager Dim swConfig As SldWorks.Configuration Dim swCustPropMgr As SldWorks.CustomPropertyManager Dim swExportPDFData As SldWorks.ExportPdfData Dim IRet As Integer Dim strFilename As String Dim sTitle As String Dim ValOut As String Dim sZeichnungsnummer As String 'Zeichnungsnummer Dim sRevision As String 'Revision Dim sBeschreibung As String 'Beschreibung Dim ResolvedValOut As String Dim WasResolved As Boolean Dim swModelName As String Const sPfad As String = "W:\Name1\Name2\Name3\Name4\Name5\" Set swApp = Application.SldWorks Set swDraw = swApp.ActiveDoc If swDraw.GetType <> swDocDRAWING Then MsgBox "Makro kann nur in Zeichnungen ausgeführt werden.", vbCritical End 'Beendet das Makro End If Set swview = swDraw.GetFirstView 'erste Ansicht auf der Zeichnung Set swview = swview.GetNextView Set swModel = swview.ReferencedDocument 'hier hast du dann den ModelDoc2 pointer von dem referenzierten Teil '********************** Properties ***************************** Const pZeichnungsnummer As String = "Zeichnungsnummer" Const pRevision As String = "Revision" Const pBeschreibung As String = "Beschreibung" '*************************************************************** sTitle = swModel.GetTitle Set swModelExt = swModel.Extension Set swCustPropMgr = swModelExt.CustomPropertyManager("") 'IRet = 1 wenn es die Eigenschaft nicht gibt / IRet = 2 wenn die Eigenschaft existiert 'Hole die Zeichnungsnummer IRet = swCustPropMgr.Get5(pZeichnungsnummer, False, ValOut, ResolvedValOut, WasResolved) sZeichnungsnummer = ValOut 'Hole die Revision IRet = swCustPropMgr.Get5(pRevision, False, ValOut, ResolvedValOut, WasResolved) sRevision = ValOut 'Hole die Beschreibung IRet = swCustPropMgr.Get5(pBeschreibung, False, ValOut, ResolvedValOut, WasResolved) sBeschreibung = ValOut 'Export to PDF if it is a drawing 'Hier brauchst du kein check mehr nach der Zeichnung, da dies schon am Anfang steht strFilename = sPfad & sZeichnungsnummer & "" & sRevision & "_" & sBeschreibung & ".pdf" Set swExportPDFData = swApp.GetExportFileData(1) Set swModel = swDraw swModel.Extension.SaveAs strFilename, 0, 0, swExportPDFData, 0, 0 MsgBox (sPath + strFilename) End Sub ICH DANKE EUCH WIE VERRÜCKT FÜR DIESE SUPER-COOLE-UNTERSTÜTZUNG! Gruß René
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Rene82 Mitglied
Beiträge: 15 Registriert: 14.05.2019
|
erstellt am: 18. Feb. 2020 16:30 <-- editieren / zitieren --> Unities abgeben:
Hallo an Alle, ich bins mal wieder ;-) und hoffe das ich wieder auf eure Hilfe zurückgreifen kann! Folgendes: Ich habe mir mit Hilfe des obigen Makros (PDF-Erzeugung) und des Forums ein weiteres Makro "zusammengebastelt" - anders kann ich es leider nicht sagen. ------------------------------------------------------- Dim swApp As SldWorks.SldWorks Dim swModel As SldWorks.ModelDoc2 Dim swDraw As SldWorks.DrawingDoc Dim swview As SldWorks.View Dim swModelExt As SldWorks.ModelDocExtension Dim swConfigMgr As SldWorks.ConfigurationManager Dim swConfig As SldWorks.Configuration Dim swCustPropMgr As SldWorks.CustomPropertyManager Dim pdfoptions As Long Dim sPathName As String Dim nErrors As Long Dim nWarnings As Long Dim nRetval As Long Dim bShowMap As Boolean Dim bRet As Boolean Dim sFileName As String Dim oConfig As SldWorks.Configuration Dim ConfName As String Dim Index As String Dim Ord As String Dim Antwort As Integer Dim IRet As Integer Dim ValOut As String Dim sTitle As String Dim Step As Long Dim Iges As Long Dim Part As Object Dim boolstatus As Boolean Dim longstatus As Long, longwarnings As Long Dim sZeichnungsnummer As String 'Zeichnungsnummer Dim sRevision As String 'Revision Dim sBeschreibung As String 'Beschreibung Dim sProjekt As String 'Projektname Dim ResolvedValOut As String Dim WasResolved As Boolean Dim swModelName As String Dim iTemp As Integer Dim ModelPathName As String Dim ActiveConfname As String Dim ModelDoc As Object Dim DrwFileName As String Dim DrwFullPath As String Dim DrawingDoc As Object Dim errors As Long Dim warnings As Long Sub main() '********************** Properties ***************************** Const pZeichnungsnummer As String = "Zeichnungsnummer" Const pRevision As String = "Revision" Const pBeschreibung As String = "Beschreibung" Const pProjekt As String = "Projekt" '*************************************************************** Set swApp = Application.SldWorks Set swModel = swApp.ActiveDoc iTemp = swModel.GetType If swModel.GetType <> swDocDRAWING Then ElseIf swModel.GetType <> swDocPART Then ElseIf swModel.GetType <> swDocASSEMBLY Then MsgBox "- SolidWorks Baugruppe, Teil oder Zeichnung öffnen -" End End If Set swApp = Application.SldWorks Set swModel = swApp.ActiveDoc sFileName = sProjekt & "" & sZeichnungsnummer & "" & sRevision & "_" & sBeschreibung
sTitle = swModel.GetTitle Set swModelExt = swModel.Extension Set swCustPropMgr = swModelExt.CustomPropertyManager("") sTitle = swModel.GetTitle Set swModelExt = swModel.Extension Set swCustPropMgr = swModelExt.CustomPropertyManager("") 'Auslesen einer Benutzerdefinierte Eigenschaft 'IRet = swCustPropMgr.Get5(pEigenschaftsname, False, sEigenschaftswert, ResolvedValOut, WasResolved) 'IRet = 1 wenn es die Eigenschaft nicht gibt / IRet = 2 wenn die Eigenschaft existiert 'Hole die Zeichnungsnummer IRet = swCustPropMgr.Get5(pZeichnungsnummer, False, sZeichnungsnummer, ResolvedValOut, WasResolved) 'Hole die Revision IRet = swCustPropMgr.Get5(pRevision, False, sRevision, ResolvedValOut, WasResolved) 'Hole die Beschreibung IRet = swCustPropMgr.Get5(pBeschreibung, False, sBeschreibung, ResolvedValOut, WasResolved) 'Hole die Projektnamen IRet = swCustPropMgr.Get5(pProjekt, False, sProjekt, ResolvedValOut, WasResolved) ' Punkt 1: Ordner erzeugen
Ord = "\\XXX\YYY\02_ZZZ\" & sProjekt & "_" & sZeichnungsnummer & "" & sRevision If Dir(Ord, vbDirectory) <> "" Then MsgBox "Ordner ist schon vorhanden" Else MkDir Ord MsgBox "Ordner " & Ord & " angelegt" End If ' Punkt 2: Step & IGES exportieren Step = swApp.SetUserPreferenceIntegerValue(swStepAP, 214) sFileName = sZeichnungsnummer & "" & sRevision & "_" & sBeschreibung sPathName = Ord & "\" & sFileName & ".step" Debug.Print sPathName bRet = swModel.SaveAs4(sPathName, _ swSaveAsCurrentVersion, _ swSaveAsOptions_Silent, _ nErrors, _ nWarnings) If bRet = False Then nRetval = swApp.SendMsgToUser2("Probleme mit dem Speichern als Step bzw. IgesDatei", swMbWarning, swMbOk) End If Iges = swApp.SetUserPreferenceIntegerValue(swIges, typ144) sFileName = sZeichnungsnummer & "" & sRevision & "_" & sBeschreibung sPathName = Ord & "\" & sFileName & ".igs" Debug.Print sPathName bRet = swModel.SaveAs4(sPathName, _ swSaveAsCurrentVersion, _ swSaveAsOptions_Silent, _ nErrors, _ nWarnings) If bRet = False Then nRetval = swApp.SendMsgToUser2("Probleme mit dem Speichern als Step bzw. IgesDatei", swMbWarning, swMbOk) End If MsgBox "Stepdatei und Iges-Datei erfolgreich gespeichert unter " & Ord & "" Path = Ord Shell "explorer.exe /e, " & Path, vbMaximizedFocus End Sub ------------------------------------------------------- Dieses Makro Funktioniert auch, es werden wahrscheinlich viele unnütze DIM - Einträge oben stehen die ich so nicht benötige.
Mein Ziel ist es diese Makro auch für PDF und DXF zu nutzen aber die zeichnungsdatei (.slddrw) enthält mehrere Blätter und es soll eine "automatische" Erkennung geben das Blatt 1 bis 5 die PDF wird und Blatt 6 - 7 die DXF, in einer anderen Zeichnung kann es nur Blaat1 für PDF sein und Blatt 2 für DXF. Und noch schöner wäre es wenn das Makro automatisch die zeichnung öffnet, wenn das "nur" das Model geöffnet ist. Nach der Erzeugung auch die Zeichnung woeder schließt. Grundlegend ist meine Vorstellung das man gefragt wird welche Blätter zur PDF und welche zur DXF gehören, oder man es an Blattnamen festmacht. PDF1, PDF2,...; DXF1; ... etc. Sobald im Blattnamen PDF steht soll es wissen PDF1 bis PDF5 zur PDF-Erzeugung gehört und DXF1 bis DXF8 zur DXF-Erzeugung gehört. Habt ihr Ideen wie man es umsetzen kann! Ich bin über jede Hilfe froh und Dankbar und ich bin kein Makroschreiber - Ich probiere einfach immer aus ;-) Grüße René Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Rene82 Mitglied
Beiträge: 15 Registriert: 14.05.2019
|
erstellt am: 24. Feb. 2020 17:16 <-- editieren / zitieren --> Unities abgeben:
Hallo Zusammen, hier nochmal verkürzt die Makrofunktionalität die ich nicht ohne eure Hilfe hinbekomme:!!!! Solidworks --> Zeichnung ist geöffnet --> hole Benutzerdefinierte Eigenschaften --> erstelle einen Ordner (Name wird zusammengesetzt)--> speichere alle Blätter mit dem Namen PDF ab in einer Datei und dem erstelltem Ordner --> Jetzt speichere alle Blätter mit dem Namen DXF1 .... DXF2 (etc.) in den selben Ordner ab, verwende dabei DXF Optionen --> Frage EINZELN oder Komplett DXF (mehrere Files oder nur eine DXF-File) --> ABSPEICHERN --> Öffne den Pfad mit den abgespeicherten Daten --> Öffne eine Exceldatei --> ENDE
Dank Stefan Berlitz´s Makro-Schnipsel kann man darüber den Blattnamen auslesen: ------------------------------------------------------------------------------ Sub main() Set SwApp = CreateObject("SldWorks.Application") Set DrawingDoc = SwApp.ActiveDoc DrawingDoc.ActivateSheet ("DXF" & "PDF") If (DrawingDoc.GetType <> swDocDRAWING) Then ' wenn keine Zeichnung aktiv wird das Makro wieder beendet MsgBox "Nur für Zeichnungen geeignet" Exit Sub End If ' die Anzahl der Blätter holen, und dann in der Schleife eines nach ' dem anderen Abspeichern. Dazu ein Handle auf das aktuelle Blatt holen AnzahlBl = DrawingDoc.GetSheetCount Set Sheet = DrawingDoc.GetCurrentSheet ' damit die DXF anschließend im Verzeichnis der Zeichnung gespeichert werden ' muss der Pfad ermittelt werden. Ansonsten werden die DXFs im Verzeichnis ' des Makro gespeichert. Wenn man ein Sammelverzeichnis hat kann man das ' natürlich auch einfach direkt angeben temp = DrawingDoc.GetPathName ' da wir nur den Pfad brauchen alles andere abtrennen For i = Len(temp) To 1 Step -1 If Mid$(temp, i, 1) = "\" Then pfad = Left(temp, i) Exit For End If Next i ' wenn mehr als ein Blatt da ist könnte es sein, dass wir nicht auf ' Blatt 1 sind. In einem Makro müssen wir jetzt einen Trick machen, um ' auf das erste Blatt zurückzukommen. ' Dazu immer wieder ein Blatt zurückspringen und dabei den Blattnamen ' vergleichen; wenn der gleich bleibt haben wir das erste Blatt erreicht. SheetName = Sheet.GetName For i = 1 To AnzahlBl - 1 DrawingDoc.SheetPrevious Set Sheet = DrawingDoc.GetCurrentSheet If (SheetName = Sheet.GetName) Then Exit For End If SheetName = Sheet.GetName Next i ' jetzt sind wir garantiert auf dem ersten Blatt und können jetzt eins ' nach dem anderen Abspeichern msgtxt = "" For i = 1 To AnzahlBl ' nur den Dokumentnamen holen (der in der Titelzeile von SolidWorks ' angezeigt wird) Titel = DrawingDoc.GetTitle MsgBox DrawingDoc.GetPathName ' und die Endung mit dem .slddrw abschneiden, wenn vorhanden If (InStr(Titel, ".sld") > 0) Then Datei = Left(Titel, InStr(Titel, ".sld") - 1) Else Datei = Titel End If ' *** hier steht jetzt in Datei der Name *** If InStr(1, Datei, "DXF") > 0 Then ' dann Blatt1 auslassen MsgBox "Blatt mit DXF im Namen ausgelassen" Else ' *** ' wir wollen alle Blätter als DXF mit den eingestellten Optionen abspeichern ' hier könnte auch z.B. einfach durch Umbenennen der Endung das Blatt als ' DWG (".dwg") oder TIFF (".tif") gespeichert werden. dabei werden aber ' jeweils die aktuellen Exportparameter benutzt, also würden z.B. alle ' TIFFs in derselben Größe abgespeichert. Datei = pfad & Datei & ".dxf" ' dann erfolgt das Speichern, die Parameter sind: ' DrawingDoc.SaveAs2 ( newName, unused, saveAsCopy, silent ) ' wenn alles geklappt hat, wird eine 0 zurückgeliefert, ansonsten ein ' Wert ungleich 0 If (DrawingDoc.SaveAs2(Datei, 0, True, False)) Then MsgBox "FEHLER BEIM SPEICHERN VON " & Datei & Chr$(10) & Chr$(13) msgtxt = msgtxt & "*** FEHLER bei: " & Datei & Chr$(10) & Chr$(13) Else msgtxt = msgtxt & "erfolgreich gespeichert: " & Datei & Chr$(10) & Chr$(13) End If End If ' und wenn noch Blätter kommen dieses aktivieren If AnzahlBl > i Then DrawingDoc.SheetNext End If 'Spring zurück auf das erste Zeichnungsblatt DrawingDoc.SheetPrevious Set Sheet = DrawingDoc.GetCurrentSheet If (SheetName = Sheet.GetName) Then Exit For End If SheetName = Sheet.GetName Next i ' und noch die Zusammenfassung übers Speichern ausgeben MsgBox msgtxt End Sub ------------------------------------------------------------ Grüße der hilfesuchende René [Diese Nachricht wurde von Rene82 am 24. Feb. 2020 editiert.] [Diese Nachricht wurde von Rene82 am 24. Feb. 2020 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
bk.sc Ehrenmitglied V.I.P. h.c. Konstrukteur Sondermaschinenbau
Beiträge: 2795 Registriert: 18.07.2012 -Solid Works 2019 SP5 -Pro Engineer WF 3
|
erstellt am: 25. Feb. 2020 15:28 <-- editieren / zitieren --> Unities abgeben: Nur für Rene82
Hallo Rene, kannst du lieber kurz zusammenfassen was schon geht und woran es genau hapert? Weil dann könnten wir dir wahrscheinlich schneller Beispiele nennen oder dir den richtigen Wink geben. Gruß Bernd ------------------ --- Man muß nicht alles wissen, man muß nur wissen wo es steht --- Staatlich anerkannte Deutschniete Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
| Anzeige.:
Anzeige: (Infos zum Werbeplatz >>)
|