'#Reference {420B2830-E718-11CF-893D-00A0C9054228}#1.0#0#C:\WINDOWS\system32\scrrun.dll#Microsoft Scripting Runtime
Option Explicit

' generate an operations sheet for the entire part.
Public Sub setupSheet
	' declare our variables to refer to our document, a feature, and an operation
	Dim doc As FMDocument
	Dim feat As FMFeature
	Dim oper As FMOperation
    Dim fs As Scripting.FileSystemObject, f As Scripting.TextStream

	Set fs = New FileSystemObject
    Set f = fs.OpenTextFile("C:\setupSheet.html", ForWriting, True)

	' get the active document from the Application object
	Set doc = ActiveDocument

	Dim s As String

	f.WriteLine "<table border=""1"" cellpadding=""2"" cellspacing=""0"">"

	f.WriteLine "<tr><td colspan=""6"">" & _
		HTMLBold( HTMLBig( HTMLCenter( "FeatureCAM Setup Sheet For " & doc.Name ) ) ) & _
		"</td></tr>"
	f.WriteLine "<tr><td colspan=""6"">" & _
		HTMLBold( HTMLBig( HTMLCenter( "Date " & Date ) ) ) & _
		"</td></tr>"

	s = ""
	s = s & addColumn( "Operation", True )
	s = s & addColumn( "Feature", True )
	s = s & addColumn( "Speed", True )
	s = s & addColumn( "Feed", True )
	s = s & addColumn( "Tool", True )

	f.WriteLine HTMLRow( s )

	' loop through all of the operations
	For Each oper In doc.Operations
		s = ""
		s = s & addColumn( oper.Name )
		s = s & addColumn( oper.Feature.Name )
		If ( oper.Tool Is Nothing ) Then
			s = s & addColumn( "0.0" )
			s = s & addColumn( "0.0" )
			s = s & addColumn( "NO TOOL" )
		Else
			s = s & addColumn( Format$( oper.Speed, "#" ) )
			s = s & addColumn( Format$( oper.Feed, "0.000" ) )
			s = s & addColumn( oper.Tool.Name )
		End If
		f.WriteLine HTMLRow( s )
	Next

	f.WriteLine "</table>"

    Set f = Nothing
    Set fs = Nothing

    Dim Web As Object
    Set Web = CreateObject("InternetExplorer.Application")
    Web.Visible = True
    Web.Navigate "c:\setupsheet.html"
End Sub

' generate a tool list for the entire part.
Public Sub toolSheet
	' declare our variables to refer to our document, a feature, and an operation
	Dim doc As FMDocument
    Dim fs As Scripting.FileSystemObject, f As Scripting.TextStream
    Dim tool As FMTool
    Dim toolmap As FMToolMap

	Set fs = New FileSystemObject
    Set f = fs.OpenTextFile("C:\toolSheet.html", ForWriting, True)

	' get the active document from the Application object
	Set doc = ActiveDocument

	Dim s As String

	f.WriteLine "<table border=""1"" cellpadding=""2"" cellspacing=""0"">"

	f.WriteLine "<tr><td colspan=""6"">" & _
		HTMLBold( HTMLBig( HTMLCenter( "FeatureCAM Setup Sheet For " & doc.Name ) ) ) & _
		"</td></tr>"
	f.WriteLine "<tr><td colspan=""6"">" & _
		HTMLBold( HTMLBig( HTMLCenter( "Date " & Date ) ) ) & _
		"</td></tr>"

	s = ""
	s = s & addColumn( "Tool", True )
	s = s & addColumn( HTMLCenter( "Slot" ), True )
	s = s & addColumn( HTMLCenter( "Diameter" ), True )
	s = s & addColumn( HTMLCenter( "Length" ), True )
	s = s & addColumn( HTMLCenter( "D Offset Reg" ), True )
	s = s & addColumn( HTMLCenter( "L Offset Reg" ), True )

	f.WriteLine HTMLRow( s )

	' loop through all of the operations
	For Each toolmap In doc.ToolMaps
		s = ""
		s = s & addColumn( toolmap.Tool.Name )
		s = s & addColumn( HTMLCenter( CStr( toolmap.ToolNumber ) ) )
		s = s & addColumn( HTMLCenter( gimmeDiameter( toolmap.Tool ) ) )
		s = s & addColumn( HTMLCenter( gimmeLength( toolmap.Tool ) ) )
		s = s & addColumn( HTMLCenter( gimmeDOffset( toolmap ) ) )
		s = s & addColumn( HTMLCenter( gimmeLOffset( toolmap ) ) )
		f.WriteLine HTMLRow( s )
	Next

	f.WriteLine "</table>"

    Set f = Nothing
    Set fs = Nothing

    Dim Web as Object
    Set Web = CreateObject("InternetExplorer.Application")
    Web.Visible = TRUE
    Web.Navigate "c:\toolsheet.html"
End Sub

' each tool type has a different way of referring to the diameter.
' this function handles that situation.
Private Function gimmeDiameter( tool As FMTool ) As String
	On Error Resume Next
	Dim d As Double
	d = tool.diameter
	If Err Then
		Err.Clear
		If tool.ToolGroup = eTG_ChamferMill Then
			gimmeDiameter = Format( tool.InnerDiameter, "0.000" ) & "/" & _
				Format( tool.OuterDiameter, "0.000" )
		ElseIf tool.ToolGroup = eTG_CounterSink Then
			gimmeDiameter = Format( tool.BodyDiameter, "0.000" ) & "/" & Format( tool.angle, "0.0" ) & "&deg;"
		Else
			gimmeDiameter = "&#151;"
		End If
	Else
		gimmeDiameter = Format( d, "0.000" )
	End If
End Function

' each tool type has a different way of referring to the length.
' this function handles that situation.
Private Function gimmeLength( tool As FMTool ) As String
	Dim strLen As String
	If tool.ToolGroup = eTG_EndMill Or _
		tool.ToolGroup = eTG_PlungeRough Or _
		tool.ToolGroup = eTG_ThreadMill Then
		strLen = Format( tool.CutterLength, "0.000" )
	ElseIf tool.ToolGroup = eTG_TwistDrill Or _
		tool.ToolGroup = eTG_Tap Or _
		tool.ToolGroup = eTG_SpotDrill Or _
		tool.ToolGroup = eTG_CounterBore Then
		strLen = Format( tool.Length, "0.000" )
	ElseIf tool.ToolGroup = eTG_FaceMill Then
		strLen = Format( tool.Height, "0.000" )
	Else
		' we're not done yet... more code left to write here...
		strLen = "&#151;"
	End If
	gimmeLength = strLen
End Function

Private Function gimmeDOffset( toolmap As FMToolMap ) As String
	If toolmap.DiameterOffsetRegister = -1 Then
		gimmeDOffset = "Same"
	Else
		gimmeDOffset = CStr( toolmap.DiameterOffsetRegister )
	End If
End Function

Private Function gimmeLOffset( toolmap As FMToolMap ) As String
	If toolmap.LengthOffsetRegister = -1 Then
		gimmeLOffset = "Same"
	Else
		gimmeLOffset = CStr( toolmap.LengthOffsetRegister )
	End If
End Function

' add a column to an HTML table.
Private Function addColumn( s As String, Optional ByVal bold As Boolean ) As String
	If bold Then
		addColumn = "<td><b>" & s & "</b></td>" & vbNewLine
	Else
		addColumn = "<td>" & s & "</td>" & vbNewLine
	End If
End Function

' add a row to an HTML table.
Private Function HTMLRow( s As String ) As String
	HTMLRow = "<tr>" & s & "</tr>"
End Function

' center the text
Private Function HTMLCenter( s As String ) As String
	HTMLCenter = "<p align=""center"">" & s & "</p>"
End Function

' bold the text
Private Function HTMLBold( s As String ) As String
	HTMLBold = "<b>" & s & "</b>"
End Function

' make the text big
Private Function HTMLBig( s As String ) As String
	HTMLBig = "<big>" & s & "</big>"
End Function