| |
| Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für SOLIDWORKS |
| |
| SolidCAM auf der HERMLE HAUSAUSSTELLUNG 2024 |
Autor
|
Thema: SolidWorks Makro (1508 mal gelesen)
|
Ex-Mitglied
|
erstellt am: 02. Okt. 2019 15:47 <-- editieren / zitieren -->
Hallo zusammen, ich möchte gerne ein einfaches Makro schreiben "Modell speichern" Bei folgenden Punkten bräuchte ich Hilfe: Ausblenden der Skizzen Ausblenden der Ebenen Klar gibt es die Anzeigeoption, aber soweit ich weiß werden nicht konkret die Ebenen bzw. Skizzen ausgeblendet sondern nur die Erscheinung nicht mehr gezeigt. Also meine Kollegen würden die Ebenen, Skizzen trotzdem sehen wenn sie die Datei öffnen. Kennt wer einen Trick dafür? Gruß, Hadi |
bk.sc Ehrenmitglied V.I.P. h.c. Konstrukteur Sondermaschinenbau
Beiträge: 2776 Registriert: 18.07.2012 -Solid Works 2019 SP5 -Pro Engineer WF 3
|
erstellt am: 02. Okt. 2019 16:19 <-- editieren / zitieren --> Unities abgeben:
|
Ex-Mitglied
|
erstellt am: 03. Okt. 2019 09:51 <-- editieren / zitieren -->
Danke für den Link! Das erledigt es einwandfrei. Entschuldige, dass es ein neuer Thread geworden ist. Bei einem anderen Makro hätte ich auch ein Problem. Ich bin dem programmieren leider nicht mächtig, deswegen nutze ich bisher immer die Aufnehmen Funktion wo man nciht viel mit dem Code zu tun hat. Makro funktioniert bisher so weit - Auf Blatt 1 springen (4x auf voriges Blatt springen - ausgelegt auf max. 5 Blätter) - läuft - in Blatt zoomen - läuft - Baustruktur schließen (funktioniert nicht) - Neuaufbau der Ansichten (funktioniert nicht) - abspeichern (funktioniert nicht) ohne großes Wissen scheint es mir, dass SWX die Befehle gar nicht aufnimmt. Hier einmal der Code. Ich kann leider wenig entziffern. Dim swApp As Object Dim Part As Object Dim boolstatus As Boolean Dim longstatus As Long, longwarnings As Long Sub main() Set swApp = Application.SldWorks Set Part = swApp.ActiveDoc Dim myModelView As Object Set myModelView = Part.ActiveView myModelView.FrameState = swWindowState_e.swWindowMaximized Part.SheetPrevious ' Zoom To Fit Part.ViewZoomtofit2 Part.ClearSelection2 True Part.SheetPrevious ' Zoom To Fit Part.ViewZoomtofit2 Part.SheetPrevious ' Zoom To Fit Part.ViewZoomtofit2 Part.SheetPrevious ' Zoom To Fit Part.ViewZoomtofit2 ' Zoom To Sheet Part.Extension.ViewZoomtoSheet ' Zoom To Fit Part.ViewZoomtofit2 End Sub
|
Winni-two Mitglied Ing. Maschb.
Beiträge: 154 Registriert: 12.03.2010 SW 2021 SP5 Intel Xenon W2135 @3.7GHz Win 10 64 bit Graka: Nvidia Quadro P4000 32 GB Ram
|
erstellt am: 03. Okt. 2019 10:04 <-- editieren / zitieren --> Unities abgeben:
|
Ex-Mitglied
|
erstellt am: 03. Okt. 2019 10:28 <-- editieren / zitieren -->
Ebenen, Skizzen ausblenden im Teil. Das Makro aus dem Link den Bernd geschickt hat funktioniert einwandfrei. Der zweite Post ist über ein anderes Makro womit ich Probleme habe. Das was ich damit bezwecken möchte habe ich hereingeschrieben. - Zwei unterschiedliche Makros. Sollte ich dafür vielleicht einen neuen Thread öffnen? |
Winni-two Mitglied Ing. Maschb.
Beiträge: 154 Registriert: 12.03.2010 SW 2021 SP5 Intel Xenon W2135 @3.7GHz Win 10 64 bit Graka: Nvidia Quadro P4000 32 GB Ram
|
erstellt am: 03. Okt. 2019 11:16 <-- editieren / zitieren --> Unities abgeben:
|
Ex-Mitglied
|
erstellt am: 03. Okt. 2019 13:03 <-- editieren / zitieren -->
Danke danke! Wenn es jetzt noch speichert wäre das das I-Tüpfelchen! Darf ich einmal spekulieren? Bzw. würdest du ergänzen was da passiert? Sub main() ? Set swApp = Application.SldWorks Set Model = swApp.ActiveDoc Erfassen, zählen der Blätter? Set swSheet = Model.GetCurrentSheet SheetNames = Model.GetSheetNames AnzahlBl = Model.GetSheetCount Gehe zu Blatt 1 und zoom? For j = AnzahlBl - 1 To 0 Step -1 Model.ActivateSheet (SheetNames(j)) Model.ViewZoomtofit2 Next j Modellaufbau und schließen vom Baum? Model.ForceRebuild3 (False) SendKeys "{ESC}" SendKeys "+{C}" End Sub |
Winni-two Mitglied Ing. Maschb.
Beiträge: 154 Registriert: 12.03.2010 SW 2021 SP5 Intel Xenon W2135 @3.7GHz Win 10 64 bit Graka: Nvidia Quadro P4000 32 GB Ram
|
erstellt am: 03. Okt. 2019 13:24 <-- editieren / zitieren --> Unities abgeben:
|
Ex-Mitglied
|
erstellt am: 03. Okt. 2019 13:32 <-- editieren / zitieren -->
Danke, bist Held des Tages |
Ex-Mitglied
|
erstellt am: 03. Okt. 2019 14:42 <-- editieren / zitieren -->
Eine Sache noch... das Makro schaltet den Numblock aus??? ^^ |
Winni-two Mitglied Ing. Maschb.
Beiträge: 154 Registriert: 12.03.2010 SW 2021 SP5 Intel Xenon W2135 @3.7GHz Win 10 64 bit Graka: Nvidia Quadro P4000 32 GB Ram
|
erstellt am: 03. Okt. 2019 14:50 <-- editieren / zitieren --> Unities abgeben:
+ Numlock: Dim swApp As Object Dim Model As Object Dim AnzahlBl As Long Dim swSheet As SldWorks.Sheet Dim SheetNames As Variant Dim j As Long Dim boolstatus As Boolean Dim lErrors As Long Dim lWarnings As Long Sub main() Set swApp = Application.SldWorks Set Model = swApp.ActiveDoc If Model Is Nothing Then MsgBox ("Kein Modell geöffnet") End End If If Model.GetType <> 3 Then 'Zeichnung MsgBox ("Nur für Zeichnungen sinnvoll") End End If Set swSheet = Model.GetCurrentSheet SheetNames = Model.GetSheetNames AnzahlBl = Model.GetSheetCount
For j = AnzahlBl - 1 To 0 Step -1 Model.ActivateSheet (SheetNames(j)) Model.ViewZoomtofit2 Next j
Model.ForceRebuild3 (False) SendKeys "{ESC}", True SendKeys "+{C}", True SendKeys "{NUMLOCK}", True boolstatus = Model.Save3(swSaveAsOptions_Silent, lErrors, lWarnings) If boolstatus = False Then MsgBox "Zeichnung wurde nicht gespeichert" End Sub
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Ex-Mitglied
|
erstellt am: 03. Okt. 2019 15:06 <-- editieren / zitieren -->
Da funktioniert es nicht mehr. Bleibt bei speichern oder so hängen. Ich habe es jetzt so aus den Steinen zusammengebastelt, dann funkts. Dim swApp As Object Dim Model As Object Dim AnzahlBl As Long Dim swSheet As SldWorks.Sheet Dim SheetNames As Variant Dim j As Long Sub main() Set swApp = Application.SldWorks Set Model = swApp.ActiveDoc Set swSheet = Model.GetCurrentSheet SheetNames = Model.GetSheetNames AnzahlBl = Model.GetSheetCount
For j = AnzahlBl - 1 To 0 Step -1 Model.ActivateSheet (SheetNames(j)) Model.ViewZoomtofit2 Next j
Model.ForceRebuild3 (False) SendKeys "{ESC}" SendKeys "+{C}" SendKeys "+{NUMLOCK}", True
Dim boolstatus As Boolean Dim lErrors As Long Dim lWarnings As Long boolstatus = Model.Save3(swSaveAsOptions_Silent, lErrors, lWarnings) End Sub
|
| Konstruktionsingenieur (m/w/d) | Als weltweit führendes Unternehmen für Engineering und IT- Dienstleistungen ist die SII Deutschland GmbH auf die Entwicklung und den Support von komplexen Systemen spezialisiert ? von der Konzeptidee bis zur Zulassung. Unsere Teams sind der Schlüssel zu unserem Erfolg. Ihnen verdanken wir, dass unsere Kunden uns vertrauen ? vom ?hidden Champion? bis zum ?großen Player? der Industrie. Wir ... | Anzeige ansehen | Konstruktion, Visualisierung |
|
CAD-Maler Mitglied Konstrukteur / CAD-Admin / Mädchen für alles
Beiträge: 720 Registriert: 17.01.2007 SWX 2019 SP5 AutoCAD 2019 Win 10 pro 64 bit Intel(R) Xeon(R) CPU E5-1650 v4 @ 3.60GHz 64GB RAM Nvidia Quadro M5000 SWx EPDM
|
erstellt am: 07. Okt. 2019 09:24 <-- editieren / zitieren --> Unities abgeben:
Was hat mich damals dieses Sch*?$%§ Sendkeys an Nerven gekostet... Das Problem ist, dass jeder (!) Sendkeys-Aufruf eine zufällige Wahrscheinlichkeit hat, den Numlock aus- oder auch wieder einzuschalten. Will heißen, weder die Anzahl der Sendkeys-Befehle im Code noch die Anzahl der Makro-Ausführungen insgesamt haben einen Einfluß, ob am Ende das Lämpchen leuchtet. Zum Glück geht das nicht nur mir so. Wie dem auch sei, dieser Code funktioniert bei mir und meinen Kollegen mittlerweile zuverlässig. Viel Spaß damit. Anm.: Ich hab 2x SendKeys drin. Gruß, Jens Code: Dim swApp As SldWorks.SldWorks Dim Part As SldWorks.ModelDoc2Dim keys(0 To 255) As Byte Dim o As OSVERSIONINFO Dim ReadOnlyState As Boolean Dim bNumLockState As Boolean '********************************************************************************** 'Deklarationen für NUM-Lock '********************************************************************************** ' Declare Type for API call: Private Type OSVERSIONINFO dwOSVersionInfoSize As Long dwMajorVersion As Long dwMinorVersion As Long dwBuildNumber As Long dwPlatformId As Long szCSDVersion As String * 128 ' Maintenance string for PSS usage End Type ' API declarations: Private Declare PtrSafe Function GetVersionEx Lib "Kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long Private Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwflags As Long, ByVal dwExtraInfo As Long) Private Declare PtrSafe Function GetKeyboardState Lib "user32" (pbKeyState As Byte) As Long Private Declare PtrSafe Function SetKeyboardState Lib "user32" (lppbKeyState As Byte) As Long ' Constant declarations: Const VK_NUMLOCK = &H90 Const VK_SCROLL = &H91 Const VK_CAPITAL = &H14 Const KEYEVENTF_EXTENDEDKEY = &H1 Const KEYEVENTF_KEYUP = &H2 Const VER_PLATFORM_WIN32_NT = 2 Const VER_PLATFORM_WIN32_WINDOWS = 1 Sub main() Set swApp = Application.SldWorks Set Part = swApp.ActiveDoc bNumLockState = IsNumLockOn() 'Hier Makro-Code mit Sendkeys '*********************************************************************** 'NUM-Lock wieder einschalten '*********************************************************************** If IsNumLockOn() <> bNumLockState Then o.dwOSVersionInfoSize = Len(o) GetVersionEx o GetKeyboardState keys(0) If o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then '=====Win95 keys(VK_NUMLOCK) = Abs(Not keys(VK_NUMLOCK)) SetKeyboardState keys(0) ElseIf o.dwPlatformId = VER_PLATFORM_WIN32_NT Then '=====WinNT 'Simulate Key Press keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0 'Simulate Key Release keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY _ Or KEYEVENTF_KEYUP, 0 End If End If End Sub Function IsNumLockOn() As Boolean o.dwOSVersionInfoSize = Len(o) GetVersionEx o GetKeyboardState keys(0) IsNumLockOn = keys(VK_NUMLOCK) End Function
------------------ CSWE =) Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |