SolidWorks MakroMania - Masseeigenschaften aus Ansicht

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

nächstes >

Nummer 21
Masseeigenschaften aus Ansicht

ZIP, 24 KB

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.

Das Makro holt zu allen Ansichten einer Zeichnung das passende Modell mit korrekter Konfiguration und ermittelt dessen Masseeigenschaften. Dieses Makro habe ich als Beispiel für einen englischen Artikel entwickelt, um verschiedenen Techniken zu zeigen, deswegen sich auch alle Kommentare und der Begleitartikel in Englisch. Ich hoffe das demnächst zu übersetzen und als neues Kapitel im API Tutorial anzubieten, aber bis dahin kann damit vielleicht schon jemand etwas anfangen. 

' **********************************************************************
' * Macro gets the mass for all models in the views of an active
' * drawing; it is aware of different configurations
' *
' * 31.01.2003 Stefan Berlitz
' *
' *
' *
' * Possible enhancements / ToDo:
' *
' * RapidDraft drawings may models have not loaded yet, then with
' * this macro the model window comes up; have to close it if this
' * happens or preload the model
' *
' * Automatic convert the output of mass according to units set in model
' *
' * If same model/configuration in different views output only once
' *
' * Do the loop for all sheets if multisheet drawing
' *
' * More sophisticated output (textbox or similar) for copy/paste
' *
' **********************************************************************

Dim swApp As Object

Dim DrawingDoc As Object
Dim ModelDoc As Object
Dim Config As Object

Dim View As Object
Dim ViewName As String
Dim ViewCount As Long
Dim ConfigName As String
Dim RefModelName As String

Dim MassProp As Variant
Dim Mass As Double

Dim errors As Long
Dim warnings As Long

Dim message As String
Dim ref As String

Const swDocNONE = 0      '  Used to be TYPE_NONE
Const swDocPart = 1       '  Used to be TYPE_PART
Const swDocASSEMBLY = 2      '  Used to be TYPE_ASSEMBLY
Const swDocDRAWING = 3       '  Used to be TYPE_DRAWING
Const swDocSDM = 4       '  Solid data manager.

' ATTENTION: prior to SolidWorks 2003 the starting procedure function
' (usually Sub main) MUST (MUST!!!!) be the last procedure in the last
' included modul (= not the last one in project, they are sorted in
' alphabetic order, but the last modul you included) to work properly
' when you run the macro directly from Tools/Macros/Run
' Therefor all other functions must be included before Sub main

Function SWXTypeOfFile(filename As String) As Long
    ' function will determine the filetype used by OpenDoc
    ' by analysing the filename extension; the SolidWorks
    ' constants have to be imported with swconst.bas or declared

    Select Case UCase(Right(filename, 6))
    Case "SLDPRT"
        SWXTypeOfFile = swDocPart
    Case "SLDASM"
        SWXTypeOfFile = swDocASSEMBLY
    Case "SLDDRW"
        SWXTypeOfFile = swDocDRAWING
    Case Else
        SWXTypeOfFile = swDocNONE
    End Select

End Function

Sub main()
    ' get the SolidWorks Object
    Set swApp = CreateObject("SldWorks.Application")

    ' reset the message string
    message = ""

    ' get active document, should be a drawing
    Set DrawingDoc = swApp.ActiveDoc
    ' if no active document, exit; it is userfriendly to
    ' pop up an error message ;-)
    If DrawingDoc Is Nothing Then
        MsgBox "Nothing opened, so what should I look at, stupid?"
        Exit Sub
    End If
    ' check if a drawing is active
    If (DrawingDoc.GetType <> swDocDRAWING) Then
        MsgBox "Only useful with drawing"
        Exit Sub
    End If
    ' now iterate over the drawing views; the first view is
    ' always the sheet itself and there is never a model in
    ' it, but it's easier to check every view the same way
    Set View = DrawingDoc.GetFirstView

    ' as long as there is a valid view
    While Not View Is Nothing
        ' get the name of the view
        ViewName = View.Name
        ' get the name of the referenced model; if the view is empty
        ' we will get an empty string
        RefModelName = View.GetReferencedModelName

        If RefModelName = "" Then
            ' empty view = no referenced model = no configuration = no mass properties
            ref = ViewName & ": empty view"
            ConfigName = ""
            Mass = 0
            ' prepare the message string, concatenate the info string
            ref = View.Name & "-> " & RefModelName
            ' no we are heading for the mass properties for the model
            ' in this view. Since the model may have different configurations
            ' we must look for this specific configuration in the model
            ' so let's get the name of the referenced configuration
            ConfigName = View.ReferencedConfiguration

            ' now we need the modeldoc itself; DON'T use ActivateDoc(name)
            ' as it will do what it says: activate the document so it will
            ' bring up the window with this model.
            ' instead, we can use OpenDoc, and this will be very fast, since
            ' the model is already opened in SolidWorks, but not visible. So we
            ' should get the ModelDoc pointer almost instantly
            ' I choose the good old OpenDoc call, it is VERY obsolet, but
            ' easier then the actual version OpenDoc6; for those who want to
            ' see how it would look with OpenDoc6 I have implemented it but
            ' comment it out
            ' Set ModelDoc = swApp.OpenDoc6(RefModelName, SWXTypeOfFile(RefModelName), 0, ConfigName, errors, warnings)
            ' The SWXTypeOfFile is a own function to figure out what type of
            ' document is a specific file; there is no API call which provides
            ' this very basic info, so we have to check the filename extension
            ' for this and hopefully the user havn't renamed the extension in explorer
            Set ModelDoc = swApp.OpenDoc(RefModelName, SWXTypeOfFile(RefModelName))
            ' now we have the Modeldoc object, fine. But the MassProperties
            ' depends on the configuration, so we have to activate the configuration
            ' referenced in the view, for another config might be active.
            errors = ModelDoc.ShowConfiguration2(ConfigName)
            ' we should check for the error, but I'm lazy and I know, that it
            ' will succeed. :-))

            ' Now we can get the mass properties. The function will return
            ' a array of 12 doubles packed as safearray ... bummer, what the heck ...
            ' It's that easy: declare as Variant, use as array of doubles :-))
            MassProp = ModelDoc.GetMassProperties
            'CenterOfMassX = MassProp(0)
            'CenterOfMassY = MassProp(1)
            'CenterOfMassZ = MassProp(2)
            'Volume = MassProp(3)
            'Area = MassProp(4)
            'Mass = MassProp(5)
            'MomXX = MassProp(6)
            'MomYY = MassProp(7)
            'MomZZ = MassProp(8)
            'MomXY = MassProp(9)
            'MomZX = MassProp(10)
            'MomYZ = MassProp(11)
            Mass = MassProp(5)

            ' all values from API are in SI units (kilogram or meters), so if you
            ' want to have other units (or the units of model) you have to convert them

        End If
        ' now we have our values; format them in a nice matter ...
        message = message & Chr$(13) & Chr$(10) & _
                  ref & " (" & _
                  ConfigName & ") Mass=" & _

        ' ... and go for the next view
        Set View = View.GetNextView
    ' now that we have gathered the information for all views present it to the user
    Call MsgBox(message)

End Sub

Zurück zum Seitenanfang

hr.gif (4491 Byte)

counter Kritik und Anregungen bitte an Stefan Berlitz. Letzte Änderung dieser Seite am Donnerstag, 01. Februar 2007 17:40