Option Explicit
'
' volume and cg of solids.bas - Display volume and center of gravity point of all solids in model.
'
' Author: Kyle Kershaw
' Organization: Engineering Geometry Systems
' Date: 12/3/02
' Copyright (c) 2002, Engineering Geometry Systems
'
' General Description
'
' Returns volume and center of gravity for each solid in the current document. Steps through each
' solid if more than one exist. Creates a point at the center of gravity for each solid.
'
' Need V9.3.0.16 or higher
'
Public Sub VolumeAndCG
'Sub Main

	Dim doc As FMDocument
	Dim solid As FMModel, selected_entities As FMModels
	Dim item As Integer, total_items As Integer
	Dim vol As Double, x As Double, y As Double, z As Double, ptname As String

	Set doc = ActiveDocument			' get the active document
	Set selected_entities = doc.Solids	' get collection of solids

	item = 1
	total_items = selected_entities.Count

	If total_items > 0 Then

		For Each solid In selected_entities

			vol = getVolumeOfSolid(doc,solid)
			getCGOfSolid doc,solid,x,y,z,ptname,item

			MsgBox "Volume and Center of Gravity    " & _
			"(Solid " & Str$(item) & " of " & Str$(total_items) & ")" + vbCrLf + _
			"Solid: " & solid.Name + vbCrLf + _
			"Volume: " & Format(CStr(vol),"0.000") + vbCrLf + _
			"CG @ " & ptname & _
			"  X=" & Format(CStr(x),"0.0000") & _
			"  Y=" & Format(CStr(y),"0.0000") & _
			"  Z=" & Format(CStr(z),"0.0000"),, _
			"FeatureCAM"

			item = item + 1
		Next
	Else
		MsgBox "No Solids found"
	End If

	doc.Select(Empty, False)		'deselect all


End Sub

Private Function getVolumeOfSolid( doc As FMDocument, solid As FMModel ) As Double
	Dim vol As FMModel
	Set vol = doc.AddModel( "volume", "volume(" & solid.Name & ")")	' scl command to get volume
	getVolumeOfSolid = getDoubleFromArgObj(doc, vol)
	vol.Delete
End Function

Private Sub getCGOfSolid( doc As FMDocument, solid As FMModel, ByRef x As Double, _
			ByRef y As Double, ByRef z As Double, ByRef ptname As String, item As Integer)
	Dim Pnt As FMModel
	Dim point_index As String
	point_index = "pt" & CStr(item+1000)
	Set Pnt = doc.AddModel( point_index , "center_gravity(" & solid.Name & ")")
	x = Pnt.X
	y = Pnt.Y
	z = Pnt.Z
	ptname = Pnt.Name
	Pnt.Visible = True
	solid.Select(True)			' select solid and cg point
	Pnt.Select(True, False)
	'doc.SetView eVT_CenterSelected
End Sub
' function returns double from arg_obj
' Make point using arg_obj, get x coord of point, delete point,
Private Function getDoubleFromArgObj(doc As FMDocument, vol As FMModel) As Double
	Dim Pnt As FMModel
	Set Pnt = doc.AddModel( "point" , "pt(" & vol & ",0,0)")' make point
	getDoubleFromArgObj = Pnt.X								' get x
	Pnt.Delete												' delete point
End Function


'
' Add a toolbar button for this macro upon loading of this addin into FeatureCAM.
'
Private Sub AddIn_OnConnect(ByVal flags As FeatureCAM.tagFMAddInFlags)

	Dim bars As FMCmdBars, bar As FMCmdBar, ctrl As FMCmdBarBtn
	Dim bar_name As String, button_name As String

	bar_name = "Utilities"
	button_name = "VolumeAndCG"

	Set bars = Application.CommandBars
	Set bar = bars(bar_name)

	If bar Is Nothing Then
		Set bar = bars.Add(bar_name)
	Else
		bar.Visible = True
	End If

	Set ctrl = bar.Controls(button_name)

	If ctrl Is Nothing Then
		Set ctrl = bar.Controls.Add( ,,button_name)
		ctrl.FaceId = 42
		bar.Visible = True
	End If

End Sub

'
' delete button unless only button then hide bar
'
Private Sub AddIn_OnDisConnect(ByVal flags As FeatureCAM.tagFMAddInFlags)

	Dim bars As FMCmdBars, bar As FMCmdBar, ctrl As FMCmdBarCtrl
	Dim bar_name As String, button_name As String

	bar_name = "Utilities"
	button_name = "VolumeAndCG"

	Set bars = Application.CommandBars
	Set bar = bars(bar_name)

	If Not bar Is Nothing Then
		Set ctrl = bar.Controls(button_name)
		If Not ctrl Is Nothing Then
			If bar.Controls.Count > 1 Then
				ctrl.Delete
			Else
				bar.Visible=False
			End If
		End If
	End If
End Sub