SolidWorks MakroMania - Anonymisieren von Exportteilen

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 38
Anonymisieren von Exportteilen

Download
ZIP, 9 KB

Diese Makro wurde als Antwort auf eine Anfrage im SolidWorks-Brett auf CAD.de erstellt, also einfach mal auf http://ww3.cad.de/foren/ubb/Forum2/HTML/012824.shtml schauen.

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.

' **********************************************************************
' * Makro benennt alle Körper eines Einzelteils um, dabei wird einfach
' * eine laufende Nummer hochgezählt. Anschließend werden noch alle
' * Feature vom Typ Importiert umbenannt, so dass alle "Spuren" der
' * Benennung von Baugruppen, die als Teil gespeichert wurden, weg sind.
' *
' * 27.08.2007 Stefan Berlitz (stefan.berlitz@solidworks.cad.de)
' * http://solidworks.cad.de
' * http://swtools.cad.de
' *
' **********************************************************************

Dim swApp As Object
Dim ModelDoc As Object
Dim vBodies As Variant
Dim vBody As Variant
Dim Body As Object

Dim Feature As Object
Dim FeatCount As Long

Dim counter As Long
Dim i As Long

Dim BodyType(5) As String

' Konstante aus swconst.bas
Public Const swDocPART = 1
Public Const swAllBodies = -1
Public Const swSolidBody = 0
Public Const swSheetBody = 1
Public Const swWireBody = 2
Public Const swMinimumBody = 3
Public Const swGeneralBody = 4
Public Const swEmptyBody = 5

Public Const swTnBaseBody = "BaseBody"


Sub main()

    ' an SolidWorks anhängen
    Set swApp = CreateObject("SldWorks.Application")

    ' prüfen, ob überhaupt ein Dokument offen ist ...
    Set ModelDoc = swApp.ActiveDoc
    If ModelDoc Is Nothing Then
        MsgBox "Kein Dokument offen"
        Exit Sub
    End If
    ' ... und ob das auch ein Einzelteil ist
    If (ModelDoc.GetType <> swDocPART) Then
        MsgBox "Nur für Einzelteile sinnvoll"
        Exit Sub
    End If

    ' einen Loop über alle Körper, diese dann einfach nacheinander
    ' hochzählen, als Grundname wird der Körpertyp angegeben
    counter = 0

    BodyType(swSolidBody) = "Volumenkörper"
    BodyType(swSheetBody) = "Oberflächenkörper"
    BodyType(swWireBody) = "Drahtkörper"
    BodyType(swMinimumBody) = "Minimumkörper"
    BodyType(swGeneralBody) = "AllgemeinerKörper"
    BodyType(swEmptyBody) = "Leerkörper"

    ' dann einen Loop über alle Körper und die umbenennen
    vBodies = ModelDoc.GetBodies2(swAllBodies, False)
    For Each vBody In vBodies
        counter = counter + 1
        Set Body = vBody
        Body.Name = BodyType(Body.GetType) & counter
    Next

    ' und dasseleb Spielchen für die Features
    Set Feature = ModelDoc.FirstFeature
    While Not Feature Is Nothing

        ' wenn es ein importierter Klotz ist umbenennen
        If Feature.GetTypeName = swTnBaseBody Then
            Feature.Name = swTnBaseBody & counter
            counter = counter + 1
        End If

        ' und auf zum nächsten Feature
        Set Feature = Feature.GetNextFeature
    Wend

    ' und regenerieren, damit alles richtig angezeigt wird
    ModelDoc.EditRebuild

End Sub

Zurück zum Seitenanfang

hr.gif (4491 Byte)

counter Kritik und Anregungen bitte an Stefan Berlitz. Letzte Änderung dieser Seite am Freitag, 08. August 2008 12:25