|
SolidWorks MakroMania ist eine Beispielsammlung einiger Makros, die Ihnen eine Vorstellung davon geben soll, was man auch schon mit Makros in SolidWorks alles anstellen kann. Der Code des Makros sollte so gut dokumentiert sein, dass Sie damit ohne weitere Anleitung verstehen, was gemacht wird. |
< voriges |
MakroMania Übersicht |
Nummer 31 Flächenfarben zurücksetzen (Multibodyparts) |
|
Ich übernehme keine Haftung für die korrekte Funktion der Routinen oder irgendwelcher Schäden bei der Anwendung dieser Beispiele. Das gesamte Risiko trägt der Benutzer selbst. - Sorry, muss sein.
Eine ältere Version (nicht für Mehrkörperteile geeignet) finden Sie im Makro Nr.1
' **********************************************************************
' * Makro durchläuft alle Flächen des aktiven Parts und setzt diese
' * zurück auf die Standardfarbe des Teils, löscht also alle speziellen
' * Farbeigenschaften einer Fläche
' *
' * 10.09.2000 Stefan Berlitz (stefan.berlitz@solidworks.cad.de)
' * 15.09.2004 Stefan Berlitz
' * Erweiterung für MultiBody-Parts
' *
' * http://solidworks.cad.de
' * http://swtools.cad.de
' **********************************************************************
' zunächst mal ein paar Deklarartionen die gebraucht werden
Dim SwApp As Object
Dim ModelDoc As Object
Dim Body As Object
Dim Face As Object
Dim FeatureObj As Object
Dim faceCnt As Integer
Dim retval As Integer
Dim dummy As Integer
Dim vBody As Variant
Dim vSingleBody As Variant
Const swSolidBody = 0
' die Konstanten aus swconst.bas, damit nicht mit Zahlen gearbeitet werden muss
Const swDocNONE = 0 ' Used to be TYPE_NONE
Const swDocPART = 1 ' Used to be TYPE_PART
Const swDocASSEMBLY = 2 ' Used to be TYPE_ASSEMBLY
Const swDocDRAWING = 3 ' Used to be TYPE_DRAWING
Const swDocSDM = 4 ' Solid data manager.
Sub Main()
' an SolidWorks Session anklinken und ggf. sichtbar machen
Set SwApp = CreateObject("SldWorks.Application")
SwApp.Visible = True
' Zeiger auf aktives Dokument holen und überprüfen, ob überhaupt eins aktiv ist
Set ModelDoc = SwApp.ActiveDoc
If ModelDoc Is Nothing Then
MsgBox ("Kein Modell geöffnet")
End
End If
' ausserdem funktioniert das so nur mit Parts, also sollte das aktive
' Dokument auch ein Part sein
If ModelDoc.GetType() <> swDocPART Then
MsgBox ("Das Makro funktioniert nur mit Parts")
End
End If
' die Volumenkörper des Modells holen
vBody = ModelDoc.GetBodies2(swSolidBody, False)
If Not IsEmpty(vBody) Then
faceCnt = 0
For Each vSingleBody In vBody
' die Flächen werden über das Body-Object angesprochen, also erstmal
' den Körper des aktiven Modells anwählen.
Set Body = vSingleBody
' die bisherige Selektion löschen (falls was ausgewählt war)
ModelDoc.ClearSelection
' und los geht's ...
' die erste Fläche anspringen und den Zähler auf Null setzen
Set Face = Body.GetFirstFace
' und dann solange die Flächen abarbeiten wie noch welche da sind
While Not Face Is Nothing
' die angesprochene Fläche auswählen
retval = Face.Select(False)
' und zurücksetzen auf "Benutze Part-Eigenschaften"
dummy = ModelDoc.SelectedFaceProperties(0, 0, 0, 0, 0, 0, 0, 1, "")
' und dann die nächste Fläche anspringen
Set Face = Face.GetNextFace
' Zähler für berarbeitete Flächen einen hochzählen
faceCnt = faceCnt + 1
Wend
Next
' nur noch eine Erfolgsmeldung
MsgBox (Str(faceCnt) & " Flächen zurückgesetzt")
Else
MsgBox "Keine Volumenkörper im Modell"
End If
End Sub
| Kritik und Anregungen bitte an Stefan Berlitz. Letzte Änderung dieser Seite am Donnerstag, 01. Februar 2007 17:40 |