|
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 38 Anonymisieren von Exportteilen |
|
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
| Kritik und Anregungen bitte an Stefan Berlitz. Letzte Änderung dieser Seite am Freitag, 08. August 2008 12:25 |