SolidWorks MakroMania - Löschen aller Flächenfarben

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

nächstes >

Nummer 01 Löschen aller Flächenfarben

Download ZIP, 2 KB

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.

Update: aktuelle Version für Mehrkörperteile (Multibodys) finden Sie bei Makro Nr.31

' **********************************************************************
' * 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)
' * 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

' 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 Flächen werden über das Body-Object angesprochen, also erstmal
    ' den Körper des aktiven Modells anwählen.
    Set Body = ModelDoc.Body

    ' 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
    faceCnt = 0

    ' 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
    ' nur noch eine Erfolgsmeldung
    MsgBox (Str(faceCnt) & " Flächen zurückgesetzt")
    End

End Sub

Zurück zum Seitenanfang

Kritik und Anregungen bitte an Stefan Berlitz. Letzte Änderung dieser Seite am Donnerstag, 01. Februar 2007 17:40