'#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 LatheToolDetail
'Sub Main
	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, 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

	Dim t_total As Long
	t_total = doc.ToolMaps.Count

	Dim List$()
	ReDim List$(4,t_total)

	Dim i As Long
	i=0

	For Each toolmap In doc.ToolMaps
		For Each oper In doc.Operations
			If Not (oper.Tool Is Nothing) Then
				If (toolmap.Tool = oper.Tool)  Then
					List(1,i) = toolmap.Tool
					List(2,i) = CStr(toolmap.ToolNumber)

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

					ElseIf (TypeName(oper.Tool) = "IFMTwistDrill") Then
						Set Tdrill = oper.Tool
						List(3,i) = Tdrill.Material
						List(4,i) = Format(CStr(Tdrill.Diameter), "#0.0###")

					ElseIf (TypeName(oper.Tool) = "IFMThreadTool") Then
						Set thrdtool = oper.Tool
						List(3,i) = Format(CStr(thrdtool.InsertTipAngle), "#0.0###")
						List(4,i) = Format(CStr(thrdtool.InsertTipRadius), "#0.0###")

					ElseIf (TypeName(oper.Tool) = "IFMSpotDrill") Then
						Set Sdrill = oper.Tool
						List(3,i) = Sdrill.Material
						List(4,i) = Format(CStr(Sdrill.Diameter), "#0.0###")

					ElseIf (TypeName(oper.Tool) = "IFMReam") Then
						Set Ream = oper.Tool
						List(3,i) = Ream.Material
						List(4,i) = Format(CStr(Ream.Diameter), "#0.0###")

					ElseIf (TypeName(oper.Tool) = "IFMTap") Then
						Set Ttap = oper.Tool
						List(3,i) = Format(CStr(Ttap.Diameter), "#0.0###")
						List(4,i) = Format(CStr(Ttap.thread), "#0.0###")

					ElseIf (TypeName(oper.Tool) = "IFMCounterSink") Then
						Set Csink = oper.Tool
						List(3,i) = Format(CStr(Csink.angle), "#0.0###")
						List(4,i) = Format(CStr(Csink.BodyDiameter), "#0.0###")

					End If
					Exit For
				End If
			End If
		Next
		i=i+1
	Next

	Dim MSWord As Word.Application
	'Set MSWord = New 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, t_total+4, 4)
    OpSheet.Columns(1).Width = MSWord.InchesToPoints(3)
    OpSheet.Columns(2).Width = MSWord.InchesToPoints(.7)
    OpSheet.Columns(3).Width = MSWord.InchesToPoints(1)
    OpSheet.Columns(4).Width = MSWord.InchesToPoints(1)

	Dim firstrow As Integer
    firstrow = 1

    OpSheet.Rows(firstrow).Cells.Merge	' merge the first row
    OpSheet.Rows(firstrow).Range.text = "Lathe Tool Details"	' set a title
    OpSheet.Rows(firstrow).Range.Font.Size = 16
    OpSheet.Rows(firstrow).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
    OpSheet.Rows(firstrow).Range.Bold = True
    firstrow = firstrow + 1

	Call OpSheet.Cell(firstrow, 4).Merge(OpSheet.Cell(firstrow, 2))
	OpSheet.Cell(firstrow, 1).Range.text = "Part file: " & doc.Name
    OpSheet.Cell(firstrow, 2).Range.text = "NC Program Name: " & doc.Setups.ActiveSetup.PartName
    OpSheet.Rows(firstrow).Range.Bold = True
    firstrow = firstrow + 1

	Call OpSheet.Cell(firstrow, 4).Merge(OpSheet.Cell(firstrow, 2))
	OpSheet.Cell(firstrow, 1).Range.text = "Setup: " & doc.ActiveSetup
    OpSheet.Cell(firstrow, 2).Range.text = "Date: " & Date
    OpSheet.Rows(firstrow).Range.Bold = True
	firstrow = firstrow + 1

    OpSheet.Cell(firstrow, 1).Range.text = "Tool name"
    OpSheet.Cell(firstrow, 2).Range.text = "Slot#"
    OpSheet.Cell(firstrow, 3).Range.text = "Insert"
    OpSheet.Cell(firstrow, 4).Range.text = "Tip radius"
    OpSheet.Rows(firstrow).Range.Bold = True
    firstrow = firstrow + 1

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

    For i = 0 To t_total-1
    	OpSheet.Cell(firstrow + i, 1 ) = List(1,i)
		OpSheet.Cell(firstrow + i, 2 ) = List(2,i)
		OpSheet.Cell(firstrow + i, 3 ) = List(3,i)
		OpSheet.Cell(firstrow + i, 4 ) = List(4,i)
    Next

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