SolidWorks MakroMania - Erzeuger aller Komponenten auflisten

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 36
Erzeuger aller Komponenten auflisten

Download
ZIP, 13 KB

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

Zurück zum Seitenanfang

hr.gif (4491 Byte)

counter Kritik und Anregungen bitte an Stefan Berlitz. Letzte Änderung dieser Seite am Mittwoch, 11. Juli 2007 18:10