'
' FindShortestExposedLength.bas
'	For every operation, search through the entire tool database looking for the
'	tool with the shortest exposed length that does not cause a tool holder gouge.
' 
' Author: Paul T. Shilton
' Organization: Engineering Geometry Systems
' Date: 3/15/02
' Copyright (c) 2002, Engineering Geometry Systems
'
' REQUIRED FeatureCAM VERSION: 9.4.0.04
'
' General Description
'
' The program iterates through all of the operations in the part document.  For
' every operation, it iterates through all of the tools for that operation that are
' mostly the same as the tool that you have already established for that operation.
' "mostly the same" is defined by the routine MostlySameTool(), below.
' The macro runs the simulation on each of these tools trying to find the one with the
' shortest exposed length that machines without causing a tool holder gouge.
' 
' The macro may run for a very long time.  You can stop it by pressing the toolbar button
' again.  (I'm talking about the toolbar button that you've assigned to the macro).  When
' you press this button, the currently running simulation will run to completetion, and
' then the macro will exit.
'
' Future Work
'
' - when the user cancels, the macro returns "SUCCESS!".  the macro should say "user
'   cancelled".

Option Explicit

Dim Doc As FMDocument
Dim GougeOperName As String
Dim MySimID As String
Dim PB As FMProgressBar
Dim OriginalToolCrib As String

Private Sub Application_SimulationGougeDetected( Doc As FeatureCAM.MFGDocument, _
												ByVal operation_name As String, _
												ByVal StartedFromAPI As Boolean, _
												ByVal SimID As Variant, _
												Action As FeatureCAM.tagFMSimGougeType)
	If( Not IsEmpty(SimID) And SimID = MySimID ) Then
		GougeOperName = operation_name
		Action = eSGT_ExitSim
	End If
End Sub


Private Function IndexOfOper( ByVal oper As FMOperation, _
							  ByVal opers As FMOperations ) As Integer
	Dim op As FMOperation
	Dim count As Integer

	count = 0
	For Each op In opers
		count = count + 1
		If op = oper Then ' the default property is used here, specifically the Name property
			IndexOfOper = count
			Exit Function
		End If
	Next op
End Function

Public Sub AssignTools
	Dim opers As FMOperations

	Set Doc = ActiveDocument
	Set opers = Doc.Operations

	Set PB = Application.ShowProgressBar
	PB.Range = opers.Count * 2
 	PB.DialogTitle = PB.DialogTitle + " - AssignTools"
 	PB.CancelAskText = "Stop macro 'AssignTools'?"

	' create a temp tool crib and populate it with the compatible tool list for each operation.
	' remove all holder assignments for the tools
	' set the document to use the temp tool crib.
	OriginalToolCrib = Doc.ActiveToolCrib
	MakeTempToolCrib

	' assign the shortest holder to each tool.
	' give each tool a temp name "(h1)________" to identify it as the shortest holder
	If Not AssignShortestHolderToAllTools Then

		' set the tool override for each operation to use the shortest tool
		AssignShortestTool

	 	If Not CheckSimForGougeWithHoldersOff Then


			CheckSimForGouge

			' if sim finished without gouging, save the file with the current tool overrides
			If GougeOperName = "" Then
				Dim newName As String
				Dim index As Integer

				CreatePartToolCrib

				MsgBox "Optimization complete!  Tools have been found that simulate with no gouges!"
			End If
		End If
	End If

	RemoveTempToolCrib

	PB.Finished
	Set Doc = Nothing
End Sub

Private Function DiameterOfTool( ByVal tool As FMTool ) As Double
	If TypeName( tool ) = "IFMCounterSink" Then
		DiameterOfTool = tool.BodyDiameter
	ElseIf TypeName( tool ) = "IFMChamferMill" Then
		DiameterOfTool = tool.InnerDiameter
	Else
		DiameterOfTool = tool.Diameter
	End If
End Function

'
' MostlySameTool compares two tools and says TRUE if they:
'
' 1. are the same tool type
' 2. have the same diameter
' 3. if they are endmills, have the same end radius
'
Private Function MostlySameTool( ByVal originalTool As FMTool, ByVal candidateTool As FMTool ) As Boolean
	If TypeName( originalTool ) = TypeName( candidateTool ) And DiameterOfTool( originalTool ) = DiameterOfTool( candidateTool ) Then
		If TypeName( originalTool ) = "IFMEndMill" Then
			If originalTool.EndRadius = candidateTool.EndRadius Then
				MostlySameTool = True
			Else
				MostlySameTool = False
			End If
		Else
			MostlySameTool = True
		End If
	Else
		MostlySameTool = False
	End If
End Function

Private Sub AssignShortestTool
	Dim oper As FMOperation
	Dim opers As FMOperations
	Dim tool As FMTool
	Dim tools As FMTools

	Debug.Print "STARTING"

	Set opers = Doc.Operations
	For Each oper In opers
		Dim dia As Double
		Dim shortest_len As Double
		Dim shortest_name As String
		Dim originalTool As FMTool

		Set originalTool = oper.Tool

		shortest_len = originalTool.ExposedLength
		shortest_name = originalTool.Name

		Debug.Print "original tool " & shortest_name

		' find the next longest tool that is mostly the same and assign it as override
		Set tools = oper.CompatibleTools
		For Each tool In tools
			If tool <> originalTool And MostlySameTool( originalTool, tool ) Then
				If tool.ExposedLength < shortest_len Then
					Debug.Print "new tool " & tool.Name
					shortest_len = tool.ExposedLength
					shortest_name = tool.Name
				End If
			End If
		Next tool

		PB.Text = "Initializing operation " & IndexOfOper( oper, Doc.Operations ) & _
		" of " & Doc.Operations.Count & "."
		PB.Increment
  		If PB.IsCanceled Then
   			Exit Sub
  		End If

		' override with the new tool
		oper.OverrideTool( shortest_name, False )
	Next oper
	Doc.InvalidateToolpaths
End Sub

Private Function AssignShortestHolderForToolList( tools As FMTools ) As Boolean

	Dim tool As FMTool
	Dim holders As FMToolHolders
	Dim holder As FMToolHolder
	Dim shortest_len As Double
	Dim shortest_name As String
	Dim new_tool_name As String

	For Each tool In tools
		Set holders = tool.CompatibleHolders
		shortest_len = 10000
		shortest_name = ""
		For Each holder In holders
			If holder.Length < shortest_len Then
				shortest_len = holder.Length
				shortest_name = holder.Name
			End If
		Next holder

		' couldn't find a holder to fit this tool.  print error message and exit.
		If shortest_name = "" Then
			MsgBox "Optimization is complete, but unsuccessful.  Unable to" + _
				"find a holder to fit tool: " + tool.Name
			AssignShortestHolderForToolList = True
			Exit Function
		End If

		tool.Holder = shortest_name
		new_tool_name = "(h1)" + tool.Name
		tool.Name = new_tool_name
	Next tool
	AssignShortestHolderForToolList = False
	Doc.InvalidateToolpaths
End Function
Private Function AssignShortestHolderToAllTools As Boolean
	Dim crib As FMToolCrib

	Set crib = Doc.ActiveToolCrib
	If( AssignShortestHolderForToolList( crib.BoringBars)) Then
		AssignShortestHolderToAllTools = True
	ElseIf( AssignShortestHolderForToolList( crib.ChamferMills)) Then
		AssignShortestHolderToAllTools = True
	ElseIf( AssignShortestHolderForToolList( crib.CounterBores)) Then
		AssignShortestHolderToAllTools = True
	ElseIf( AssignShortestHolderForToolList( crib.CounterSinks)) Then
		AssignShortestHolderToAllTools = True
	ElseIf( AssignShortestHolderForToolList( crib.EndMills)) Then
		AssignShortestHolderToAllTools = True
	ElseIf( AssignShortestHolderForToolList( crib.FaceMills)) Then
		AssignShortestHolderToAllTools = True
	ElseIf( AssignShortestHolderForToolList( crib.PlungeRoughers)) Then
		AssignShortestHolderToAllTools = True
	ElseIf( AssignShortestHolderForToolList( crib.Reamers)) Then
		AssignShortestHolderToAllTools = True
	ElseIf( AssignShortestHolderForToolList( crib.RoundingMills)) Then
		AssignShortestHolderToAllTools = True
	ElseIf( AssignShortestHolderForToolList( crib.SideMills)) Then
		AssignShortestHolderToAllTools = True
	ElseIf( AssignShortestHolderForToolList( crib.SpotDrills)) Then
		AssignShortestHolderToAllTools = True
	ElseIf( AssignShortestHolderForToolList( crib.Taps)) Then
		AssignShortestHolderToAllTools = True
	ElseIf( AssignShortestHolderForToolList( crib.ThreadMills)) Then
		AssignShortestHolderToAllTools = True
	ElseIf( AssignShortestHolderForToolList( crib.TwistDrills)) Then
		AssignShortestHolderToAllTools = True
	Else
		AssignShortestHolderToAllTools = False
	End If
End Function


' return True if there is a gouge
Private Function CheckSimForGougeWithHoldersOff As Boolean
	Dim oper As FMOperation
	Dim tool As FMTool
	Dim tools As FMTools

	PB.Text = "Checking for gouges with holders off..."
	PB.Increment
  	If PB.IsCanceled Then
		CheckSimForGougeWithHoldersOff = True
   		Exit Function
	End If

	Application.SimOptions.ShowHolder = False

	Do
		' clear the gouge operation name and run the 3D sim
		GougeOperName = ""

		MySimID = "SimGougeCheck"
		Doc.ActiveWindow.Sim3DNoUpdate( MySimID )

		' if a gouge was detected
		If GougeOperName <> "" Then
			MsgBox "Found a gouge even with holders off.  Get rid of all such gouges before " & _
			"trying to run this macro."
			CheckSimForGougeWithHoldersOff = True
			Exit Function
		End If
	Loop While GougeOperName <> ""
	CheckSimForGougeWithHoldersOff = False
End Function

' all opers up to GougeOperName are valid.  convert the tools into permanent tool+holder.  if the holder
' flag is (h1), it is a shortest combo and we need to keep the tool around since it is possibly being
' used by other operations that have not yet been simulated.  If the holder flag is (h2), it is a
' temporary tool being used to test just that operation and we need to delete it.
Private Sub CreatePermanentToolsForValidOpers
	Dim oper As FMOperation
	Dim tool As FMTool
	Dim new_tool As FMTool
	Dim holder_flag As String, tool_name As String

	For Each oper In Doc.Operations
		If oper.Name = GougeOperName Then Exit For

		Set tool = oper.Tool
		holder_flag = Left( tool.Name, 4)
		If( holder_flag = "(h1)" Or holder_flag = "(h2)" ) Then
			tool_name = tool.Holder + " - " + Mid( tool.Name, 5)
			Set new_tool = tool.CopyTool( tool_name)
			oper.OverrideTool( new_tool, False)
		End If

		If( holder_flag = "(h2)") Then
			Doc.ActiveToolCrib().DeleteTool( tool)
		End If
	Next oper
End Sub

Private Sub CheckSimForGouge
	Dim oper As FMOperation
	Dim tool As FMTool
	Dim tools As FMTools
	Dim operNameForHolderList As String
	Dim sortedHolderList() As String
	Dim sortedHolderListLen As Long

	PB.Text = "Simulating first time..."
	PB.Increment
  	If PB.IsCanceled Then
   		Exit Sub
	End If

	Application.SimOptions.ShowHolder = True
	operNameForHolderList = ""

	Do
		' clear the gouge operation name and run the 3D sim
		GougeOperName = ""

		MySimID = "SimGougeCheck"
		Doc.InvalidateToolpaths
		Doc.ActiveWindow.SimToolpath( False )
		Doc.ActiveWindow.Sim3DNoUpdate( MySimID )

		' if a gouge was detected
		If GougeOperName <> "" Then
			Dim gougedTool As FMTool
			Dim shortest_len As Double
			Dim shortest_name As String, next_holder_name As String
			Dim gouged_holder_len As Double, shortest_holder_len As Double
			Dim gougedHolderName As String
			Dim holders As FMToolHolders
			Dim holder As FMToolHolder
			Dim operIndex As Integer
			Dim holder_flag As String, tool_name As String
			Dim nextHslot As Long
			Dim firstHolder As Boolean

			' convert tools for operations that have run successfully since the last gouge
			' to permanent tool+holder
			CreatePermanentToolsForValidOpers

			Set oper = Doc.Operations( GougeOperName )
			Set gougedTool = oper.Tool
			holder_flag = Left( gougedTool.Name, 4)
			tool_name = Mid( gougedTool.Name, 5)

			' update the progress bar
			operIndex = IndexOfOper( oper, Doc.Operations )
			PB.Text = "Attempting to fix operation " & oper.Name & _
			" (" & operIndex & " of " & _
			Doc.Operations.Count & ")."
			PB.Position = Doc.Operations.Count + operIndex

			gouged_holder_len = 0
			gougedHolderName = ""
			If( gougedTool.Holder <> "") Then
				gouged_holder_len = Doc.ActiveToolCrib().ToolHolders( gougedTool.Holder).Length
				gougedHolderName = gougedTool.Holder
			End If

			' if new tool, create sorted holder list
			firstHolder = False
			If( holder_flag = "(h1)" Or GougeOperName <> operNameForHolderList) Then
				Dim moreToAdd As Boolean
				Dim chkLen As Double

				firstHolder = True
				Set holders = gougedTool.CompatibleHolders
				sortedHolderListLen = holders.Count
				ReDim sortedHolderList( sortedHolderListLen+1)
				operNameForHolderList = GougeOperName

				nextHslot = 1
				moreToAdd = True
				Set holders = gougedTool.CompatibleHolders

				' initial holder is shortest, start with that as initial len
				chkLen = gouged_holder_len

				While( moreToAdd)
					' add all holders that are the same length as chkLen, skip the initial gouged holder
					For Each holder In holders
						If( holder.Length = chkLen And holder.Name <> gougedHolderName) Then
							sortedHolderList( nextHslot) = holder.Name
							nextHslot = nextHslot + 1
						End If
					Next holder

					' find the next longer holder
					shortest_holder_len = 10000
					moreToAdd = False
					For Each holder In holders
						If( holder.Length < shortest_holder_len And holder.Length > chkLen) Then
							shortest_holder_len = holder.Length
							moreToAdd = True
						End If
					Next holder

					If( moreToAdd ) Then
						chkLen = shortest_holder_len
					End If
				Wend
			End If


			' find the next holder
			next_holder_name = ""
			If( firstHolder) Then
				next_holder_name = sortedHolderList(1)
			Else
				For nextHslot = 1 To sortedHolderListLen
					If( gougedHolderName = sortedHolderList(nextHslot) And nextHslot < sortedHolderListLen-1) Then
						next_holder_name = sortedHolderList(nextHslot+1)
						Exit For
					End If
				Next nextHslot
			End If

			If( next_holder_name <> "") Then
				If( holder_flag = "(h1)" ) Then
					' if we gouged with the shortest tool and shortest holder, create a copy of the
					' tool and set it to use the next longer holder.  set the oper to use this "(h2)" tool
					Dim new_tool As FMTool
					tool_name = "(h2)" + Mid( gougedTool.Name, 5)
					Set new_tool = gougedTool.CopyTool( tool_name)
					new_tool.Holder = next_holder_name
					oper.OverrideTool( new_tool, False)
				Else
					' we gouged with the tmp "(h2)" tool.  set it to use the next longer holder
					gougedTool.Holder = next_holder_name
				End If
			Else
				shortest_len = 10000
				shortest_name = ""

				' find the next longest tool with the same diameter and assign it as override.
				' only consider tools that have the shortest combo flag set "(h1)"
				Set tools = oper.CompatibleTools
				For Each tool In tools
					If Left( tool.Name, 4) = "(h1)" Then
						If MostlySameTool( gougedTool, tool ) Then
							If tool.ExposedLength < shortest_len And _
								tool.ExposedLength > gougedTool.ExposedLength Then
								shortest_len = tool.ExposedLength
								shortest_name = tool.Name
							End If
						End If
					End If
				Next tool

				' couldn't find another valid tool that is mostly the same.  print error message and exit.
				If shortest_name = "" Then
					MsgBox "Optimization is complete, but unsuccessful.  All possible " + _
						"tool combinations have been tried, but operation " + _
						GougeOperName + " still gouges with longest tool in crib!!!"
					Exit Sub
				End If

				' override with the new tool and loop back to run 3d sim again
				oper.OverrideTool( shortest_name, False )

				' if we gouged with a tool using a temp holder, delete the tool
				If( holder_flag = "(h2)") Then
					Doc.ActiveToolCrib().DeleteTool( gougedTool)
				End If
			End If
		End If
	Loop While GougeOperName <> ""

	' successfully cut part.  convert the tools for the last successful operations
	' to permanent tool+holder
	If( GougeOperName = "") Then
		CreatePermanentToolsForValidOpers
		Doc.InvalidateToolpaths
		Doc.SimToolpath( False)
	End If
End Sub

Private Sub MakeTempToolCrib
	Dim crib As FMToolCrib
	Dim oper As FMOperation
	Dim tools As FMTools
	Dim tool As FMTool

	Set crib = Doc.ToolCribs("FindShortestLenTempCrib")
	If( Not crib Is Nothing) Then crib.Delete
	Set crib = Doc.ToolCribs.AddToolCrib( "FindShortestLenTempCrib")
	If( crib Is Nothing) Then
		MsgBox "Error creating temp tool crib 'FindShortestLenTempCrib'"
		Exit All
	End If

	For Each oper In Doc.Operations
		Set tools = oper.CompatibleTools
		crib.AddTools( tools)
	Next oper

	crib.SaveCrib
	Doc.ActiveToolCrib = crib
End Sub

Private Sub RemoveTempToolCrib
	Dim crib As FMToolCrib
	Doc.ActiveToolCrib = OriginalToolCrib
	Set crib = Doc.ToolCribs("FindShortestLenTempCrib")
	crib.Delete
End Sub
Private Sub CreatePartToolCrib
	Dim crib As FMToolCrib
	Dim crib_name As String

	crib_name = Doc.Name + "_ShortestLenCrib"
	Set crib = Doc.ToolCribs(crib_name)
	If( crib Is Nothing) Then
		Set crib = Doc.ToolCribs().AddToolCrib ( crib_name)
	End If
	crib.AddTools( Doc.ToolList)
	crib.SaveCrib
	Doc.ActiveToolCrib = crib_name
	OriginalToolCrib = crib_name
End Sub

Public Sub RemoveAllToolOverrides
	Dim oper As FMOperation
	For Each oper In ActiveDocument.Operations
		' remove override
		oper.OverrideTool( "", False)
	Next oper
	ActiveDocument.InvalidateToolpaths
End Sub