| Author |
Message |
Guest
|
Posted:
Tue Nov 29, 2005 9:10 pm Post subject:
center of mass revisited |
|
|
Hi,
Is there a way to use the center of mass coordinates to create a point
that will be dynanically updated (new CG) each time that the geometry
of my part or solid bodie would change?
I know this has been posted before but perhaps there have been
enhancements that may change the way this can be done. It would be
great to be able to do this without VB.
Thanks for your help.
MT
|
|
| Back to top |
|
 |
Dale Dunn
Guest
|
Posted:
Wed Nov 30, 2005 1:10 am Post subject:
Re: center of mass revisited |
|
|
Here's the text of a macro that inserts a point at the CG, and updates it
every time the macro is run. To have this update on every rebuild, you
would need to re-implement this as a macro feature. There is no way to do
this other than manually or with programming.
Beware word wrap:
' ***********************************************************************
*******
' C:\DOCUME~1\dshoebri\LOCALS~1\Temp\swx284\Macro1.swb - macro
' recorded on 07/12/02 by Dshoebri
' ***********************************************************************
*******
Dim swApp As Object
Dim objDoc As Object
Dim status As Long
Dim CG_3DSketch As Object
Dim objNewPoint As Object
Dim ObjSelectionMgr As Object
Dim objSketchToRename As Object
Dim objCG_Point As Object
Dim objSketch As Object
Dim objSketchPoint As Object
Sub main()
Set swApp = CreateObject("SldWorks.Application")
Set objDoc = swApp.ActiveDoc
MassProperties = objDoc.GetMassProperties2(status)
On Error Resume Next
X_pt = MassProperties(0)
If Err <> 0 Then
X_pt = 0
Y_pt = 0
Z_pt = 0
Else
Y_pt = MassProperties(1)
Z_pt = MassProperties(2)
End If
On Error GoTo 0
CG_3DSketch_Name = "Center-Of-Gravity"
Set CG_3DSketch = objDoc.FeatureByName(CG_3DSketch_Name)
On Error Resume Next
Junk = CG_3DSketch.Name
If Err <> 0 Then
On Error GoTo 0
objDoc.Insert3DSketch
objDoc.CreatePoint2 X_pt, Y_pt, Z_pt
objDoc.Insert3DSketch
Set objNewPoint = objDoc.FeatureByPositionReverse(0)
objDoc.FeatureByPositionReverse(0).Name = CG_3DSketch_Name
Set objNewPoint = objDoc.FeatureByPositionReverse(0)
objDoc.EditRebuild
Else
On Error GoTo 0
objDoc.SelectById CG_3DSketch_Name, "SKETCH", 0, 0, 0
objDoc.EditSketch
Set objSketch = objDoc.GetActiveSketch2
SketchPointArray = objSketch.GetSketchPoints
PointCount = UBound(SketchPointArray) + 1
For i = 0 To (PointCount - 1)
Set objSketchPoint = SketchPointArray(i)
Junk = objSketchPoint.SetCoords(X_pt, Y_pt, Z_pt)
Next i
objDoc.EditRebuild
End If
End Sub |
|
| Back to top |
|
 |
Guest
|
Posted:
Wed Nov 30, 2005 9:10 am Post subject:
Re: center of mass revisited |
|
|
Thanks!
Dale Dunn wrote:
| Quote: | Here's the text of a macro that inserts a point at the CG, and updates it
every time the macro is run. To have this update on every rebuild, you
would need to re-implement this as a macro feature. There is no way to do
this other than manually or with programming.
Beware word wrap:
' ***********************************************************************
*******
' C:\DOCUME~1\dshoebri\LOCALS~1\Temp\swx284\Macro1.swb - macro
' recorded on 07/12/02 by Dshoebri
' ***********************************************************************
*******
Dim swApp As Object
Dim objDoc As Object
Dim status As Long
Dim CG_3DSketch As Object
Dim objNewPoint As Object
Dim ObjSelectionMgr As Object
Dim objSketchToRename As Object
Dim objCG_Point As Object
Dim objSketch As Object
Dim objSketchPoint As Object
Sub main()
Set swApp = CreateObject("SldWorks.Application")
Set objDoc = swApp.ActiveDoc
MassProperties = objDoc.GetMassProperties2(status)
On Error Resume Next
X_pt = MassProperties(0)
If Err <> 0 Then
X_pt = 0
Y_pt = 0
Z_pt = 0
Else
Y_pt = MassProperties(1)
Z_pt = MassProperties(2)
End If
On Error GoTo 0
CG_3DSketch_Name = "Center-Of-Gravity"
Set CG_3DSketch = objDoc.FeatureByName(CG_3DSketch_Name)
On Error Resume Next
Junk = CG_3DSketch.Name
If Err <> 0 Then
On Error GoTo 0
objDoc.Insert3DSketch
objDoc.CreatePoint2 X_pt, Y_pt, Z_pt
objDoc.Insert3DSketch
Set objNewPoint = objDoc.FeatureByPositionReverse(0)
objDoc.FeatureByPositionReverse(0).Name = CG_3DSketch_Name
Set objNewPoint = objDoc.FeatureByPositionReverse(0)
objDoc.EditRebuild
Else
On Error GoTo 0
objDoc.SelectById CG_3DSketch_Name, "SKETCH", 0, 0, 0
objDoc.EditSketch
Set objSketch = objDoc.GetActiveSketch2
SketchPointArray = objSketch.GetSketchPoints
PointCount = UBound(SketchPointArray) + 1
For i = 0 To (PointCount - 1)
Set objSketchPoint = SketchPointArray(i)
Junk = objSketchPoint.SetCoords(X_pt, Y_pt, Z_pt)
Next i
objDoc.EditRebuild
End If
End Sub |
|
|
| Back to top |
|
 |
Wayne Tiffany
Guest
|
Posted:
Wed Nov 30, 2005 5:10 pm Post subject:
Re: center of mass revisited |
|
|
I have one written by someone else that does almost the same thing, only it
doesn't update the existing point - it either puts a new point in the
existing sketch, or if you have renamed that sketch, it adds another sketch.
I can see benefits to both. Maybe merge the two together with options?
WT
"Dale Dunn" <daledunnSCRATCH@jamestool.com> wrote in message
news:Xns971DB930EA214daledunnatjamestoolc@65.24.3.139...
| Quote: | Here's the text of a macro that inserts a point at the CG, and updates it
every time the macro is run. To have this update on every rebuild, you
would need to re-implement this as a macro feature. There is no way to do
this other than manually or with programming.
Beware word wrap:
' ***********************************************************************
*******
' C:\DOCUME~1\dshoebri\LOCALS~1\Temp\swx284\Macro1.swb - macro
' recorded on 07/12/02 by Dshoebri
' ***********************************************************************
*******
Dim swApp As Object
Dim objDoc As Object
Dim status As Long
Dim CG_3DSketch As Object
Dim objNewPoint As Object
Dim ObjSelectionMgr As Object
Dim objSketchToRename As Object
Dim objCG_Point As Object
Dim objSketch As Object
Dim objSketchPoint As Object
Sub main()
Set swApp = CreateObject("SldWorks.Application")
Set objDoc = swApp.ActiveDoc
MassProperties = objDoc.GetMassProperties2(status)
On Error Resume Next
X_pt = MassProperties(0)
If Err <> 0 Then
X_pt = 0
Y_pt = 0
Z_pt = 0
Else
Y_pt = MassProperties(1)
Z_pt = MassProperties(2)
End If
On Error GoTo 0
CG_3DSketch_Name = "Center-Of-Gravity"
Set CG_3DSketch = objDoc.FeatureByName(CG_3DSketch_Name)
On Error Resume Next
Junk = CG_3DSketch.Name
If Err <> 0 Then
On Error GoTo 0
objDoc.Insert3DSketch
objDoc.CreatePoint2 X_pt, Y_pt, Z_pt
objDoc.Insert3DSketch
Set objNewPoint = objDoc.FeatureByPositionReverse(0)
objDoc.FeatureByPositionReverse(0).Name = CG_3DSketch_Name
Set objNewPoint = objDoc.FeatureByPositionReverse(0)
objDoc.EditRebuild
Else
On Error GoTo 0
objDoc.SelectById CG_3DSketch_Name, "SKETCH", 0, 0, 0
objDoc.EditSketch
Set objSketch = objDoc.GetActiveSketch2
SketchPointArray = objSketch.GetSketchPoints
PointCount = UBound(SketchPointArray) + 1
For i = 0 To (PointCount - 1)
Set objSketchPoint = SketchPointArray(i)
Junk = objSketchPoint.SetCoords(X_pt, Y_pt, Z_pt)
Next i
objDoc.EditRebuild
End If
End Sub |
|
|
| Back to top |
|
 |
|
|
|
|