'
' DrillRetractGougeCheck.bas - Automatically run through all the operations of a part, using the
'                              simulation to figure out which operations need to lift up to the retract
'                              plane and which ones can stay down low at the plunge clearance
'
' Author: Paul T. Shilton
' Organization: Engineering Geometry Systems
' Date: 8/19/02
' Copyright (c) 2002, Engineering Geometry Systems
'
' Required FeatureCAM Version: 9.2.0.09 (for the FMProgressBar object, and other things)
' Last tested with V9.3.0.14
'
' General Description
'
' The macro may run for a 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.
'
'

Option Explicit

Dim Doc As FMDocument
Dim GougeOperName As String
Dim MySimID 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( SimID = MySimID And StartedFromAPI) Then
		GougeOperName = operation_name
		Action = eSGT_ExitSim
	End If
End Sub

Dim PB As FMProgressBar

Private Function IndexOfOper( ByVal oper_name As String, _
							  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_name Then ' the default property is used here, specifically the Name property
			IndexOfOper = count
			Exit Function
		End If
	Next op
End Function

Public Sub DrillRetractGougeCheck
	Dim opers As FMOperations

	Set Doc = Application.ActiveDocument
	Set opers = Doc.Operations

	Set PB = Application.ShowProgressBar
	PB.Range = opers.Count + 2
 	PB.DialogTitle = PB.DialogTitle + " - SetRetractForHoles"
 	PB.CancelAskText = "Stop macro 'SetRetractForHoles'?"
	MySimID = "DrillRetractGougeCheck"

	CheckRetractPlane

	' Able to run sim without gouging with all holes using rapid plane
	If GougeOperName = "" Then

		SetRetractToPlunge
		PB.Increment

		CheckSimForGouge

		' sim finished without gouging.
		If GougeOperName = "" And Not PB.IsCanceled Then
			Dim newName As String
			Dim index As Integer

			newName = Doc.Name
			index = InStrRev( LCase$( Doc.Name ), ".fm" )
			newName = Left( newName, index-1 )
			newName = newName + "_no_gouge.fm"
			MsgBox "Optimization complete!"
	'		Doc.SaveAs newname
		End If
	End If
	PB.Finished

	Set Doc = Nothing
End Sub

Private Sub CheckRetractPlane
	Dim oper As FMOperation
	Dim opers As FMOperations
	Dim feat_type As Long, oper_type As Long, count As Integer

	PB.Text = "Turning off Retract To Plunge for all holes"

	count = 0
	Set opers = Doc.Operations
	For Each oper In opers
		PB.Position = count
		count = count + 1
		oper.GetOperationType( feat_type, oper_type )
		If feat_type And eAT_Hole Then
			Dim feat As FMFeature
			Set feat = oper.Feature
			feat.SetAttribute (eAID_RetractToClearDrilling, 0, False, False, False)
		End If
	Next oper

	PB.Text = "Simulating to check Z rapid height for adequate clearance"
	PB.Position = 0
	Doc.InvalidateToolpaths

  	If PB.IsCanceled Then
   		Exit Sub
	End If

	' clear the gouge operation name and run the 3D sim
	GougeOperName = ""
	Doc.Sim3D( MySimID )

	If GougeOperName <> "" Then
		Dim z As Double
		Dim zs As String
		z = Doc.Attribute( eAID_ZRapid )
		zs = CStr( z )
		MsgBox( "Z rapid plane is too low (" + zs + ").  Operation " + GougeOperName + " gouges at this height.")
	End If
End Sub

Private Sub SetRetractToPlunge
	Dim oper As FMOperation
	Dim opers As FMOperations
	Dim feat_type As Long, oper_type As Long, count As Integer

	PB.Text = "Turning on Retract To Plunge for all holes"

	count = 0
	Set opers = Doc.Operations
	For Each oper In opers
		PB.Position = count
		count = count + 1
		oper.GetOperationType( feat_type, oper_type )
		If feat_type And eAT_Hole Then
			Dim feat As FMFeature
			Set feat = oper.Feature
			feat.SetAttribute (eAID_RetractToClearDrilling, 0, True, False, False)
		End If
	Next oper
	Doc.InvalidateToolpaths
End Sub

Private Sub CheckSimForGouge
	Dim oper As FMOperation
	Dim tool As FMTool
	Dim tools As FMTools
	Dim LastGougeOperName As String

	PB.Text = "Looking for collisions at Plunge Clearance..."
	PB.Position = 0
	LastGougeOperName = ""

	Do
	  	If PB.IsCanceled Then
	   		Exit Sub
		End If

		' clear the gouge operation name and run the 3D sim
		GougeOperName = ""
		Doc.Sim3D( MySimID )

		' if a gouge was detected
		If GougeOperName <> "" Then

			If LastGougeOperName = GougeOperName Then
				MsgBox "Operation " + GougeOperName + " gouged even with retract set!  Exiting macro."
				Exit Sub
			End If

			LastGougeOperName = GougeOperName

			Dim operIndex As Integer
			operIndex = IndexOfOper( GougeOperName, Doc.Operations )

			Set oper = Doc.Operations( operIndex-1 )
			If( oper Is Nothing) Then
				MsgBox "Unable to find operation before " + GougeOperName
				Exit Sub
			End If

			Dim feat_type As Long, oper_type As Long
			oper.GetOperationType( feat_type, oper_type)
			If (Not feat_type And eAT_Hole) Then
				MsgBox "Operation before " + GougeOperName + " is not a drilling operation."
				Exit Sub
			End If

			PB.Text = "Setting retract on operation " & oper.Name
			PB.Position = operIndex

			oper.SetAttribute eAID_DrillRetract,,True,False,True
		End If
	Loop While GougeOperName <> ""
End Sub