'#Reference {00020905-0000-0000-C000-000000000046}#8.1#0#C:\Program Files\Microsoft Office\Office\MSWORD9.OLB#Microsoft Word 9.0 Object Library
Option Explicit

Sub main()
	LatheToolDetail()
End Sub

Type ToolStruct
	Name	As String
	turret	As Integer
End Type



Sub LatheToolDetail
	Dim doc As FMDocument
	Set doc = Application.ActiveDocument

	If Not (doc.Setups.ActiveSetup.Type = eST_Turning) Then
		MsgBox "Lathe tool detail sheet is for turning setups only " + vbLf + _
			"Current setup is not turning." + vbLf + _
			"Exiting Lathe tool detail routine",,"Lathe tool detail"
		Exit Sub
	End If

	Dim toolmap 	As FMToolMap
	Dim map 		As FMToolMap2
	Dim versionTooOld

	versionTooOld = False
	Set map = doc.ToolMaps.Item(1)
	If(Not map Is Nothing) Then
 		If Not ( TypeName(map) = "IFMToolMap2") Then versionTooOld = True
 	Else
		versionTooOld = True
	End If

	If(versionTooOld) Then
		MsgBox("Must run FeatureCAM version v17.4.1.01 or later to use this macro.")
	End If

	'Create MSWord Document
	Dim MSWord As Word.Application
	Set MSWord = CreateObject("Word.Application")
	MSWord.Visible = True

    Dim Wdoc As Word.Document
    Set Wdoc = MSWord.Documents.Add
    MSWord.Selection.WholeStory
    MSWord.Selection.Delete

    MSWord.ActiveWindow.View.TableGridlines = True	    		' turn on table gridlines

    Dim OpSheet As Word.Table
    Set OpSheet = Wdoc.Tables.Add(MSWord.Selection.Range, 1, 1)

    'Fill in Table Header

	Dim Row As Word.Row

	Set Row = OpSheet.Rows(1)
	Row.Cells(1).Width 							= MSWord.InchesToPoints(5.7)
    Row.Cells(1).Range.text 					= "Lathe Tool Details"
    Row.Cells(1).Range.Font.Size 				= 16
    Row.Cells(1).Range.ParagraphFormat.Alignment= wdAlignParagraphCenter
    Row.Cells(1).Range.Bold 					= True

    Set Row = OpSheet.Rows.Add
    Row.Cells(1).Range.text = "Date: " & Date

    Set Row = OpSheet.Rows.Add
	Row.Cells( 1).Width = MSWord.InchesToPoints(3  )
	Row.Cells.Add.Width = MSWord.InchesToPoints(2.7)
	Row.Cells(1).Range.text = "Part file: " & doc.Name
    Row.Cells(2).Range.text = "NC Program Name: " & doc.Setups.ActiveSetup.PartName
    Row.Range.Bold = True

	Dim setup 	As FMSetup, 	feature As FMFeature,		ColFlag As Boolean
	Dim oper 	As FMOperation,	t_group As tagFMToolGroup, 	t_dia 	As Double, 			t_num 		As Long
	Dim Tdrill 	As FMTwistDrill,Sdrill 	As FMSpotDrill, 	ltool 	As FMLatheTool, 	Ream 		As FMReam
	Dim Emill 	As FMEndMill, 	Csink 	As FMCounterSink, 	Ttap 	As FMTap, 			Cbore 		As FMCounterBore
	Dim Bbar 	As FMBoringBar, Chmill 	As FMChamferMill, 	Rmill 	As FMRoundingMill, 	Fmill 		As FMFaceMill
	Dim Smill 	As FMSideMill, 	Tmill 	As FMThreadMill, 	PlungeR As FMPlungeMill, 	thrdtool 	As FMThreadTool

	ColFlag = False
	Dim toolArray()   	As ToolStruct

	ReDim toolArray(0) As ToolStruct

	For Each setup In doc.Setups
		'	Setup Header
		Set Row = OpSheet.Rows.Add
		If ColFlag Then
			Row.Cells(4).Merge(Row.Cells(1))
		Else
			Row.Cells(2).Merge(Row.Cells(1))
		End If
		ColFlag = True
		Row.Cells(1).Range.text = "Setup: " & setup.Name
	    Row.Range.Bold = True

		Set Row = OpSheet.Rows.Add
		Row.Cells( 1).Width = MSWord.InchesToPoints(3  )
		Row.Cells.Add.Width = MSWord.InchesToPoints(0.7)
		Row.Cells.Add.Width = MSWord.InchesToPoints(1  )
		Row.Cells.Add.Width = MSWord.InchesToPoints(1  )

	    Row.Cells(1).Range.text = "Tool name"
	    Row.Cells(2).Range.text = "Slot#"
	    Row.Cells(3).Range.text = "Insert angle"
	    Row.Cells(4).Range.text = "Tip radius"
	    Row.Range.Bold = True

		For Each feature In setup.Features
			For Each oper In feature.Operations
				If Not (oper.Tool Is Nothing ) Then
					'Check for duplicate tool entries
					Dim ts			As ToolStruct
					Dim toolName 	As String
					Dim turret		As Integer
					Dim tool 		As String
					Dim newTool 	As Boolean

					newTool = True
					toolName= CStr(oper.Tool.Name)
					turret 	= oper.Attribute(eAID_TurnTurret)

					For Each ts In toolArray
						If Not IsNull(ts) Then
							If (ts.Name = toolName And ts.turret = turret) Then
								newTool = False
								Exit For
							End If
						End If
					Next
					If(newTool) Then
						'	Add tool to toolArray
						toolArray(UBound(toolArray)).Name 	= toolName
						toolArray(UBound(toolArray)).turret	= oper.Attribute(eAID_TurnTurret)

						ReDim Preserve toolArray(UBound(toolArray ) + 1) As ToolStruct

						'Add row for field values
						Set Row = OpSheet.Rows.Add
						Row.Cells(1).Range.text = toolName

						'	ToolMap
						For Each map In doc.ToolMaps
							If (map.Tool = oper.Tool And map.turret = oper.Attribute(eAID_TurnTurret)) Then
								Row.Cells(2).Range.text = CStr(map.ToolNumber)
								Exit For
							End If
						Next

						If (TypeName(oper.Tool) 	= "IFMLatheTool") Then
							Set ltool = oper.Tool
							If (ltool.Type = eTTT_ODTurning)    Or (ltool.Type =eTTT_IDTurning) Then
								Row.Cells(3).Range.text = Format(CStr(ltool.InsertTipAngle),"#0.0###")
							ElseIf (ltool.Type = eTTT_IDGroove) Or (ltool.Type = eTTT_ODGroove) Or (ltool.Type =eTTT_Cutoff) Then
								Row.Cells(3).Range.text = Format(CStr(ltool.InsertWidth), 	"#0.0###")
							End If
							Row.Cells(4).Range.text = Format(CStr(ltool.InsertTipRadius), 	"#0.0###")

						ElseIf (TypeName(oper.Tool) = "IFMTwistDrill") 	Then
							Set Tdrill = oper.Tool
							Row.Cells(3).Range.text = "NA"
							Row.Cells(4).Range.text = Format(CStr(Tdrill.Diameter), 		"#0.0###") & "D"

						ElseIf (TypeName(oper.Tool) = "IFMThreadTool") 	Then
							Set thrdtool = oper.Tool
							Row.Cells(3).Range.text = Format(CStr(thrdtool.InsertTipAngle), "#0.0###")
							Row.Cells(4).Range.text = Format(CStr(thrdtool.InsertTipRadius),"#0.0###")

						ElseIf (TypeName(oper.Tool) = "IFMSpotDrill") 	Then
							Set Sdrill = oper.Tool
							Row.Cells(3).Range.text = "NA"
							Row.Cells(4).Range.text = Format(CStr(Sdrill.Diameter), 		"#0.0###") & "D"

						ElseIf (TypeName(oper.Tool) = "IFMReam") 		Then
							Set Ream = oper.Tool
							Row.Cells(3).Range.text = "NA"
							Row.Cells(4).Range.text = Format(CStr(Ream.Diameter), 			"#0.0###") & "D"

						ElseIf (TypeName(oper.Tool) = "IFMTap") 		Then
							Set Ttap = oper.Tool
							Row.Cells(3).Range.text = Format(CStr(Ttap.thread), 			"#0.0###")
							Row.Cells(4).Range.text = Format(CStr(Ttap.Diameter), 			"#0.0###") & "D"

						ElseIf (TypeName(oper.Tool) = "IFMCounterSink") Then
							Set Csink = oper.Tool
							Row.Cells(3).Range.text = Format(CStr(Csink.angle), 			"#0.0###")
							Row.Cells(4).Range.text = Format(CStr(Csink.BodyDiameter), 		"#0.0###") & "D"

						Else
							Row.Cells(3).Range.text = " - - - "
							Row.Cells(4).Range.text = " - - - "

						End If
					End If
				End If
			Next
		Next
	Next

    With OpSheet.Borders	' turn on borders of the table
        .InsideLineStyle  = wdLineStyleSingle
        .OutsideLineStyle = wdLineStyleDouble
    End With


End Sub
Private Sub AddIn_OnConnect(ByVal flags As FeatureCAM.tagFMAddInFlags)
' 					  Bar name     Button name        Button face ID

	MakeButtonAndBar "Utilities", "LatheToolDetail", 42

End Sub
Private Sub AddIn_OnDisConnect(ByVal flags As FeatureCAM.tagFMAddInFlags)

	HideDeleteBarButton "Utilities", "LatheToolDetail"

End Sub
Private Sub MakeButtonAndBar(ByVal bar_name As String, ByVal button_name As String, _
								 ByVal button_id As Integer)

	Dim bars As FMCmdBars, bar As FMCmdBar, ctrl As FMCmdBarBtn
	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 = button_id
		bar.Visible = True
	End If

End Sub
Private Sub HideDeleteBarButton(ByVal bar_name As String, ByVal button_name As String)

	Dim bars As FMCmdBars, bar As FMCmdBar, ctrl As FMCmdBarCtrl

	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