Hallo ins Forum,
ich habe mir das Makro von Stefan Berlitz "Masse aller Baugruppenkomponenten auslesen Version 1.0.1" genommen und bin dabei diese ein bisschen zu erweitern.
Ich habe schon mal eine zweite Spalte mit dem Volumen des Teil hinzufügen können.
Alle Spalten auf optimale Breite und das Errechnen des Spezifischen Gewichts klappt auch schon.
Dann hatte ich gesehen das Stefan in seiner API Hilfe die Materialdichte aus dem Teil ausließt. Das hatte ich versucht, zu integrieren. Nur klappt das leider nicht, mangels Wissen. Ich würde auch gerne, anstatt des Dateinamen, die Artikel Nr. aus dem Teil auslesen. Da weiß ich aber auch nicht, wo ich da bei SolidWorks per API hin schauen muss.
Ich wäre sehr dankbar für ein wenig Hilfe.
Makro:
Option Explicit
' Globale Variable
Dim zeile As Integer ' Zeilenzähler für Ausgabe im Blatt
Sub Baugruppengewichte()
' aus aktivem SolidWorks Assembly für alle Komponenten
' Dichte und Masse auslesen. Keine Fehlerabragen etc.
' SolidWorks sollte oben und das zu untersuchende Assembly
' als aktives Dokument geladen sein. Auf Basis des Traverse-Assy
' aus dem API-HELP File von SolidWorks
' 12.09.2000 Stefan Berlitz http://solidworks.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 = "Komponentenname"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Masse in kg"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Volumen in qmm"
Range("E1").Select
ActiveCell.FormulaR1C1 = "Materialdichte"
zeile = 2 ' Zeilenzähler zur Ausgabe in Tabellenblatt
' und jetzt rekursiv durch alle Ebenen
If Not RootComponent Is Nothing Then
TraverseComponent 1, RootComponent
End If
End Sub
Private Function TraverseComponent(Level As Integer, Component As Object)
' rekursive Routine, die alle Komponenten durchläuft
On Error Resume Next
Dim i As Integer
Dim Children As Variant
Dim Child As Object
Dim ChildCount As Integer
Dim ModelDoc As Object
Dim ConfigName As String
Dim MassProp As Variant
Dim ret As Boolean
Dim retval As Boolean
' in Excelblatt den aktuellen level, den Komponentennamen eintragen ...
Range("A" & zeile).Select
ActiveCell.FormulaR1C1 = Level
Range("B" & zeile).Select
ActiveCell.FormulaR1C1 = Component.Name
' und dann für diese Komponente die Masse auslesen
Range("C" & zeile).Select
If Component.IsSuppressed Then
ActiveCell.FormulaR1C1 = "*** Komponente unterdrückt ***"
Else
' dann das ModelDoc der Komponente herausholen
ConfigName = Component.ReferencedConfiguration
Set ModelDoc = Component.GetModelDoc()
If Not ModelDoc Is Nothing Then
' und die MassProperties auslesen
ModelDoc.ShowConfiguration (ConfigName)
MassProp = ModelDoc.GetMassProperties()
' die Reihenfolge der MassProps im Variant ist:
' CenterOfMassX, CenterOfMassY, CenterOfMassZ, Volume, Area, Mass,
' MomXX, MomYY, MomZZ, MomXY, MomZX, MomYZ
' Masse ist die 6. Eigenschaft, also Index 5
ActiveCell.FormulaR1C1 = MassProp(5)
Else
ActiveCell.FormulaR1C1 = "*** Kein ModelDoc, Rootkomponente? ***"
End If
End If
'Volumen aus Model holen
Range("D" & zeile).Select
If Component.IsSuppressed Then
ActiveCell.FormulaR1C1 = "*** Komponente unterdrückt ***"
Else
' dann das ModelDoc der Komponente herausholen
ConfigName = Component.ReferencedConfiguration
Set ModelDoc = Component.GetModelDoc()
If Not ModelDoc Is Nothing Then
' und die MassProperties auslesen
ModelDoc.ShowConfiguration (ConfigName)
MassProp = ModelDoc.GetMassProperties()
' die Reihenfolge der MassProps im Variant ist:
' CenterOfMassX, CenterOfMassY, CenterOfMassZ, Volume, Area, Mass,
' MomXX, MomYY, MomZZ, MomXY, MomZX, MomYZ
' Masse ist die 6. Eigenschaft, also Index 5
ActiveCell.FormulaR1C1 = MassProp(3)
Else
ActiveCell.FormulaR1C1 = "*** Kein ModelDoc, Rootkomponente? ***"
End If
End If
'Spezifische Gewicht
' Range("E" & zeile).Select
' If Component.IsSuppressed Then
' ActiveCell.FormulaR1C1 = "*** Komponente unterdrückt ***"
' Else
' dann das ModelDoc der Komponente herausholen
' ConfigName = Component.ReferencedConfiguration
' Set ModelDoc = Component.GetModelDoc()
' If Not ModelDoc Is Nothing Then
' ModelDoc.ShowConfiguration (ConfigName)
' retval = ModelDoc.SetUserPreferenceDoubleValue(swMaterialPropertyDensity, DichteWert(cmbAuswahl.ListIndex))
' ActiveCell.FormulaR1C1 = retval
' Else
' ActiveCell.FormulaR1C1 = "Kein ModelDoc, Rootkomponente?"
' End If
' End If
'Spezifisches Gewicht errechnen
Range("E" & zeile).Select
ActiveCell.FormulaR1C1 = "=RC[-2]/RC[-1]/1000"
' 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
Columns("A:E").EntireColumn.AutoFit
End Function
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP
Foren auf CAD.de (alle Foren)
| 
