Center of gravity - macro for SolidWorks
Center of gravity - macro for SolidWorks
(OP)
Hi. I create a macro for Solid Works which identify selected surface and give data about it. Now I want write macro which give information about center of gravity selected surface. If You have any sugestion or time to solve this problem I willbe greatful - Piotrek






RE: Center of gravity - macro for SolidWorks
http://www.solidworktips.com/macro_pages/index.htm
This was the first result of a Google search for "solidworks center of gravity macro"
If you want the "CG" in 3D space of some arbritrary surface (i.e. not a planar face or a solid body) you have a different problem entirely.
RE: Center of gravity - macro for SolidWorks
RE: Center of gravity - macro for SolidWorks
CODE
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Set SelMgr = Part.SelectionManager
Dim vRefPointFeatures As Variant
vRefPointFeatures = Part.FeatureManager.InsertReferencePoint(4, 0, 0.01, 1)
End Sub
RE: Center of gravity - macro for SolidWorks
now i try make a macro which return coordinates of center of selected surface no sketch this point.if You have any idea please weite... thanks...
RE: Center of gravity - macro for SolidWorks
CODE
'***********************************
'Get XYZ coordinates of centroid and load
'them into array "XYZ"
'***********************************
Dim swApp As SldWorks.SldWorks
Dim Part As SldWorks.ModelDoc2
Dim SelMgr As SldWorks.SelectionMgr
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim Feature As SldWorks.Feature
Dim MathPoint As SldWorks.MathPoint
Dim RefPoint As SldWorks.RefPoint
Dim vRefPointFeatureArray As Variant
Dim XYZ As Variant
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Set SelMgr = Part.SelectionManager
If SelMgr.GetSelectedObjectCount2(-1) <> 1 Then
MsgBox "You must select a single face/surface for this macro."
Exit Sub
ElseIf SelMgr.GetSelectedObjectType3(1, -1) <> swSelFACES Then
MsgBox SelMgr.GetSelectedObjectType3(1, -1)
MsgBox "You must select a single face/surface for this macro."
Exit Sub
End If
vRefPointFeatureArray = Part.FeatureManager.InsertReferencePoint(4, 0, 0.01, 1)
Set Feature = vRefPointFeatureArray(0)
Set RefPoint = Feature.GetSpecificFeature2
Set MathPoint = RefPoint.GetRefPoint
XYZ = MathPoint.ArrayData
Set MathPoint = Nothing
Set RefPoint = Nothing
Set Feature = Nothing
Part.Extension.DeleteSelection2 (2)
MsgBox "X: " & XYZ(0) & vbCrLf & "Y: " & XYZ(1) & vbCrLf & "Z: " & XYZ(2)
End Sub
RE: Center of gravity - macro for SolidWorks
RE: Center of gravity - macro for SolidWorks
"This domain name expired on 03/26/2006 and is pending renewal or deletion"
FYI
I come from a small town where the population NEVER changed. Everytime someone got pregnant, someone left town.