Stefanie hat recht, ohne Modell gehts nicht - die Info über Masse, Volumen, Oberfläche, ... stecken nun mal im Modell.
Anbei unser Beispiel - wie beschrieben zum abrufen des Gewichts.
Wir machen das auch direkt in Zeichnungen - dazu muß das einer bestimmten Ansicht zugrunde liegende Modell ermittelt werden, um die Info von dort zu holen - das kann ja im Hintergrund, unsichtbar auf dem Bildschirm erfolgen.
Zu beachten ist dabei:
1. Das Makro funktioniert nur ab VB 4.0 - als nicht mit dem in SW eingebetteten VB (das ist VB 3.0!) - weil die MassProperties ein Vektor sind und damit kann VB 3.0 nicht umgehen. Wir haben den 5. Wert - retval(5) - genommen, der ist das Gewicht. Für das Volumen brauchst Du scheinbar den 3. Wert - retval(3). Das steht aber in der API-Hilfe, welches Vektorelement welchen Wert enthält.
2. Wir haben IMMER die 1.Ansicht auf einer Zeichnung verwendet, um das Modell zu ermitteln - wenn Du das anders brauchst, mußt Du an den Zeilen mit
Set View = Model.GetFirstView
Set View = View.GetNextView
etwas verändern.
3. Wenn ihr mit Federgewichten arbeitet, mußt Du in dem Makro dafür sorgen, daß die Komponenten alle vollständig geladen werden - sonst klappt's nicht mit den MassProperties
RefModel.ResolveAllLightWeightComponents(True)
4. Wenn eure Einstellungen im Windows so sind, daß keine Endungen angezeigt werden, klappt die Unterscheidung Part/Assembly - so wie unten gezeigt - nicht, da mußt Du Dir was anders ausdenken.
Vielleicht ist es nicht "schön" programmiert, aber wir sind hier im Hauptberuf Konstrukteure - wir sind zufrieden, wenn das Makro fehlerfrei läuft - und das macht es bei uns schon mehrere Jahr lang gut. Es ist allerdings nur ein Ausschnitt aus einem größeren Programm - kann sein, daß deshalb hier nicht alle Variablen/Konstanten definiert sind.
mfg uc
Private Sub barSfGetMasse()
'funktioniert nur mit VB4.0 oder höher
Dim retval As Variant
Dim swApp As Object
Dim Model As Object
Dim ConfigName As String
Dim View As Object
Set swApp = CreateObject("SldWorks.Application")
swApp.visible = True
Set Model = swApp.ActiveDoc
If Model Is Nothing Then
MsgBox ("Keine Datei geöffnet")
Exit Sub
End If
If (Model.gettype() = swDocDRAWING) Then
Dim ModName As String
Dim RefModel As Object
Dim visible As Boolean
Set View = Model.GetFirstView
Set View = View.GetNextView
ConfigName = View.ReferencedConfiguration
ModName = View.GetReferencedModelName()
If InStr(1, ModName, ".sldprt", 1) Then
Set RefModel = swApp.OpenDoc(ModName, swDocPART)
End If
If InStr(1, ModName, ".sldasm", 1) Then
Set RefModel = swApp.OpenDoc(ModName, swDocASSEMBLY)
End If
retval = RefModel.ShowConfiguration(ConfigName)
visible = RefModel.visible
If (RefModel.gettype() = swDocASSEMBLY) Then
retval = RefModel.ResolveAllLightWeightComponents(True)
End If
retval = RefModel.GetMassProperties()
txtSfGewicht = Format(retval(5), "#0.00")
If Not (visible) Then swApp.CloseDoc RefModel.GetTitle()
swApp.ActivateDoc Model.GetTitle()
Else
If (Model.gettype() = swDocASSEMBLY) Then
retval = Model.ResolveAllLightWeightComponents(True)
End If
retval = Model.GetMassProperties()
txtSfGewicht = Format(retval(5), "#0.00")
If (Model.gettype() = swDocPART) Then
txtSfDichte = Format(retval(5) / retval(3) / 1000, "#0.000")
End If
End If
End Sub
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP