|
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 36 Erzeuger aller Komponenten auflisten |
|
Dieses Makro (als Excelmakro erstellt) kam auf die interessante Anfrage, ein Teil in einer großen Baugruppe zu identifizieren, dass mit einer Studentenversion erstellt wurde. Dabei kam ich auf die Idee aus den einzelnen Komponenten jeweils den Ersteller des ersten Features auszulesen in der Hoffnung, dass so über einen nicht geläufigen Usernamen das Teil identifiziert werden kann. Den ganzen Thread mit den Hintergründen gibt es auf http://ww3.cad.de/foren/ubb/Forum2/HTML/011741.shtml zum Nachlesen.
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.
' Globale Variable
Dim zeile As Integer ' Zeilenzähler für Ausgabe im Blatt
Private Sub CommandButton1_Click()
' aus aktivem SolidWorks Assembly für alle Komponenten
' vom ersten Feature den Erzeuger auslesen. Keine Fehlerabragen etc.
' SolidWorks sollte oben und das zu untersuchende Assembly
' als aktives Dokument geladen sein.
'
' 01.12.2006 Stefan Berlitz
' http://solidworks.cad.de
' http://swtools.cad.de
Dim swApp As Object
Dim AssemblyDoc As Object
Dim Configuration As Object
Dim RootComponent As Object
' an SolidWorks anklinken und aktives Assembly holen
Set swApp = CreateObject("SldWorks.Application")
Set AssemblyDoc = swApp.ActiveDoc
' Root-Komponente des Assemblies als Ausgangspunkt festmachen
Set Configuration = AssemblyDoc.GetActiveConfiguration()
Set RootComponent = Configuration.GetRootComponent()
' erst Blatt leeren, dann Spaltenbeschriftung im Excel-Blatt
Cells.Select
Selection.ClearContents
Range("A1").Select
ActiveCell.FormulaR1C1 = "Level"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Ersteller"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Komponente"
zeile = 2 ' Zeilenzähler zur Ausgabe in Tabellenblatt
swApp.CommandInProgress = True
' und jetzt rekursiv durch alle Ebenen
If Not RootComponent Is Nothing Then
TraverseComponent 1, RootComponent
End If
swApp.CommandInProgress = False
End Sub
Private Function TraverseComponent(Level As Integer, Component As Object)
' rekursive Routine, die alle Komponenten durchläuft
Dim i As Integer
Dim Children As Variant
Dim Child As Object
Dim ChildCount As Integer
Dim Feature As Object
Dim FeatureCreatedBy As String
Dim ret As Boolean
' in Excelblatt den aktuellen level, den Komponentennamen eintragen ...
Range("A" & zeile).Select
ActiveCell.FormulaR1C1 = Level
Range("C" & zeile).Select
ActiveCell.FormulaR1C1 = Component.Name
' und dann für diese Komponente die Masse auslesen
Range("B" & zeile).Select
If Component.IsSuppressed Then
ActiveCell.FormulaR1C1 = "*** Komponente unterdrückt ***"
Else
' dann das ModelDoc der Komponente herausholen
FeatureCreatedBy = "unbekannt ???"
Set Feature = Component.FirstFeature
Do While Not Feature Is Nothing
If Feature.IsBase2 = True Then
' wenn es das Basisfeature ist, sonst landen wir ggf.
' dauernd beim Ersteller der Vorlage
FeatureCreatedBy = Feature.CreatedBy
Exit Do
End If
Set Feature = Feature.GetNextFeature
Loop
ActiveCell.FormulaR1C1 = FeatureCreatedBy
End If
' dann für die Ausgabe nächste Zeile vorbelegen
zeile = zeile + 1
' schauen, ob's ein Subassy ist und ggf. über die Kinder rüberschauen
Children = Component.GetChildren
ChildCount = UBound(Children) + 1
For i = 0 To (ChildCount - 1)
Set Child = Children(i)
TraverseComponent Level + 1, Child
Next i
End Function
| Kritik und Anregungen bitte an Stefan Berlitz. Letzte Änderung dieser Seite am Mittwoch, 11. Juli 2007 18:10 |