Hi,
auf solidworks.de gibt's Codeschnipsel. Das hier war recht gut. Fett gedruckt sind die Zeilen, die ich ergänzt habe.
Du solltest eine Schnittebene erstellen, darauf eine Skizze erzeugen indem du Schnittkurve durch ganzen Körper wählst. Raus aus der Skizze.
Skizze wählen, Makro ausführen, -> Ausgabe des Flächeninhalts
Als Einstieg scheint mir da der richtige Weg.
Einfach copy& paste in Macro ...
'----------------------------------------------
'-------------------------------------------------
' How to get the section properties of the selected items
'
' Problem:
' Through the user interface, is possible to extract the
' section properties from various combinations of
' selected entities. This is accesible through the API
' with:
'
' ModelDocExtension::GetSectionProperties
'
' This API has only one input parameter, an array of entities
' to consider in combination with the current selection set.
' The entity array must only contain the following types of
' objects:
'
' Face2
' Sketch
'
' For planar faces and reference surfaces, this will be a
' Face2 object. A sketch will obviously correspond to a
' Sketch object. However, for a face on a section plane,
' there is currently no API object.
'
' This sample code shows how to correctly use this API
' to allow for faces obtained from section planes.
'
' Preconditions:
' 1) a part, assembly or drawing is open
'
' 2) for an assembly, it must be fully resolved
'
' 3) at least one of the following is selected:
' sketch
' planar model face in any document
' face on a section plane
' crosshatch section face in a section view
' in a drawing or a sketch
'
' Postconditions:
' 1) selection set is maintained (see Notes)
'
' 2) if successful, section properties are output to the debugger
'
' Notes:
' 1) the array of objects passed in to this API are added to
' the selection set
' 2) the outputted values will be the same as those obtained through
' the UI
'
' 3) similarly, the reasons for failure will be the same as those
' in the UI
Option Explicit
Public Enum swSelectType_e
swSelFACES = 2 ' "FACE"
swSelSKETCHES = 9 ' "SKETCH"
swSelREFSURFACES = 27 ' "REFSURFACE"
swSelMANIPULATORS = 79 ' "MANIPULATOR"
End Enum
Sub main()
Const PI As Double = 3.14159
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swModelExt As SldWorks.ModelDocExtension
Dim swSelMgr As SldWorks.SelectionMgr
Dim swFace As SldWorks.face2
Dim swFeat() As SldWorks.Feature
Dim swFaceEnt() As SldWorks.entity
Dim swSketch As SldWorks.sketch
Dim nSelType As Long
Dim swSelObj() As Object
Dim vSelObj As Variant
Dim vSectionProp As Variant
Dim nSelCount As Long
Dim nNumObj As Long
Dim i As Long
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swModelExt = swModel.Extension
Set swSelMgr = swModel.SelectionManager
Debug.Print "File = " & swModel.GetPathName
nSelCount = swSelMgr.GetSelectedObjectCount
For i = 1 To nSelCount
nSelType = swSelMgr.GetSelectedObjectType(i)
Debug.Print " SelType(" & i & ") = " & nSelType
Select Case nSelType
Case swSelFACES, swSelREFSURFACES
nNumObj = nNumObj + 1
ReDim Preserve swSelObj(nNumObj - 1)
ReDim Preserve swFaceEnt(nNumObj - 1)
Set swFace = swSelMgr.GetSelectedObject4(i)
Set swFaceEnt(nNumObj - 1) = swFace
Set swSelObj(nNumObj - 1) = swFace
Case swSelSKETCHES
nNumObj = nNumObj + 1
ReDim Preserve swSelObj(nNumObj - 1)
ReDim Preserve swFeat(nNumObj - 1)
Set swFeat(nNumObj - 1) = swSelMgr.GetSelectedObject4(i)
Set swSketch = swFeat(nNumObj - 1).GetSpecificFeature
Set swSelObj(nNumObj - 1) = swSketch
Debug.Print " " & swFeat(nNumObj - 1).Name
Case swSelMANIPULATORS
' section face in a part/assy when in a section view
' there is no corresponding API object for this
' so we have to leave it selected
End Select
Next i
Debug.Print ""
' deselect faces and sketches otherwise UI selections
' will be added to array parameter. Leave section faces
' selected.
If Not IsEmpty(swFaceEnt) Then
For i = 0 To UBound(swFaceEnt)
swFaceEnt(i).DeSelect
Next i
End If
If Not IsEmpty(swFeat) Then
For i = 0 To UBound(swFeat)
swFeat(i).DeSelect
Next i
End If
vSelObj = swSelObj
' this will add the array of faces/sketchs to the selection set.
' Since the faces/sketches have been deselected, this will,
' in effect, preserve the selection set.
vSectionProp = swModelExt.GetSectionProperties((vSelObj))
' return code from:
'
' ModelDocExtension::GetSectionProperties
'
' 0 = success
' 1 = invalid input
' 2 = selected faces are not in the same or parallel planes
' 3 = unable to compute section properties
Debug.Print " Return code = " & vSectionProp(0)
Debug.Print ""
Debug.Print " Area = " & vSectionProp(1) * 1000000# & " mm^2"
vSectionProp(1) = vSectionProp(1) * 1000000
MsgBox ("Hinweis:" & " " & vSectionProp(1) & "mm²")
Debug.Print " Centroid = (" & vSectionProp(2) * 1000# & ", " & vSectionProp(3) * 1000# & ", " & vSectionProp(4) * 1000# & ") mm"
Debug.Print " Ixx = " & vSectionProp(5) * 1000000000000# & " mm^4"
Debug.Print " Iyy = " & vSectionProp(6) * 1000000000000# & " mm^4"
Debug.Print " Izz = " & vSectionProp(7) * 1000000000000# & " mm^4"
Debug.Print " Ixy = " & vSectionProp(8) * 1000000000000# & " mm^4"
Debug.Print " Izx = " & vSectionProp(9) * 1000000000000# & " mm^4"
Debug.Print " Iyz = " & vSectionProp(10) * 1000000000000# & " mm^4"
Debug.Print " Polar MOI = " & vSectionProp(11) * 1000000000000# & " mm^4"
Debug.Print " Angle princ & part axes = " & vSectionProp(12) * 180# / PI & " deg"
Debug.Print " Ix = " & vSectionProp(13) * 1000000000000# & " mm^4"
Debug.Print " Iy = " & vSectionProp(14) * 1000000000000# & " mm^4"
End Sub
------------------
Gruß, der Teddibaer
Besucht mich doch mal ... 
----------------
Es gibt nichts Gutes, ausser man tut es 
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP
Foren auf CAD.de (alle Foren)
| 
