Option Strict Off
Option Explicit On
Imports System.Runtime.InteropServices
Imports Microsoft.Win32

Namespace ANSITABLE
    ' solidifying the interface guid
    <Guid("882AE368-A5F5-4091-923A-33B55C5FA040"), _
        InterfaceType(ComInterfaceType.InterfaceIsIDispatch)> _
       Public Interface _ANSITable
        <DispId(1)> Function PZLFunctionArgs() As Integer
        <DispId(2)> Function PZL(ByRef Feature As Object, ByRef Thickness As Double, ByRef Radius As Double, ByRef SweepAngle As Double, ByRef Material As String, ByRef NF As Double) As Double

    End Interface

    ' solidifying the clsID
    <Guid("CC13A2BE-527F-48f5-8C3D-4A626F67C2A8"), ClassInterface(ClassInterfaceType.None), _
    ProgId("ANSITABLE.PZL")> Public Class ANSITABLE
        Implements _ANSITABLE
        '****************************************************************
        '*      PZL OLE Server Class Example for SE-Sheet Metal         *
        '*                                                              *
        '* This example uses a Bend Allowance table to determine the    *
        '* Length of the bend in the flat.                              *
        '*                                                              *
        '* The values are read from an ASCII text file that must        *
        '* reside in the DLL's directory. The filename is table.txt     *
        '*                                                              *
        '* If a table is not defined for the given thickness/radius and *
        '* bend angle then a default formula is used to compute the     *
        '* allowance value                                              *
        '****************************************************************

        Dim m_Tables As New Collection 'Collection of TableDefs.
        'Each TableDef in the collection is a table for specified thickness.
        Dim m_CurrentThickness As Double 'Stores the current thickness of the Sheet Metal Model.
        Dim m_CurrentTable As Object 'Current Thickness table
        'This value may be Nothing if no table defined for the specified thickness

        Public Sub New() 'Called only once when DLL is first loaded by SE-Sheet Metal
            Dim Filename As String
            Dim FileIOError As Short
            Dim ErrMsgString As String = Nothing
            Dim posStart As Short
            Dim posEnd As Short
            Dim numChars As Short
            Dim InputStr As String
            Dim tmpThickness As Double
            Dim tmpTable As Object = Nothing
            Dim Thickness As Double
            Dim Radius As Double
            Dim Angle As Double
            Dim Length As Double
            'Initialize default values
            m_CurrentThickness = 0.0#
            m_CurrentTable = Nothing
            tmpThickness = 0.0#

            'Set error handling for reading the file
            On Error GoTo HandleError

            'Filename = My.Application.Info.DirectoryPath & "\table.txt"
            Filename = My.Application.Info.DirectoryPath
            Length = Filename.Length
            For i = 0 To Length - 1
                If Filename.Substring(Filename.Length - 1 - i, 1) = "\" Then
                    Filename = Filename.Substring(0, Filename.Length - i - 1)
                    Exit For
                End If
            Next
            ' Let's worry about case where user is running in debug
            If Filename.Substring(Filename.Length - 3, 3) = "bin" Then
                Filename = Filename.Substring(0, Filename.Length - 4)
            End If

            Filename = Filename & "\table.txt"

            FileIOError = 0
            'First open the table.txt ASCII file.
            FileOpen(1, Filename, OpenMode.Input)

            'Read the Data from the file and load it into the tables
            Do While Not EOF(1)
                FileIOError = 1
                InputStr = LineInput(1)
                'Check that the line is not a comment or blank
                If Mid(InputStr, 1, 1) <> "#" And InputStr <> "" Then
                    'Line in file is a table entry, get the numbers from the string
                    posStart = 1
                    posEnd = InStr(posStart, InputStr, ",")
                    numChars = posEnd - posStart
                    Thickness = Val(Mid(InputStr, posStart, numChars))

                    posStart = posEnd + 1
                    posEnd = InStr(posStart, InputStr, ",")
                    numChars = posEnd - posStart
                    Radius = Val(Mid(InputStr, posStart, numChars))

                    posStart = posEnd + 1
                    posEnd = InStr(posStart, InputStr, ",")
                    numChars = posEnd - posStart
                    Angle = Val(Mid(InputStr, posStart, numChars))

                    posStart = posEnd + 1
                    numChars = Len(InputStr) - posStart + 1
                    Length = Val(Mid(InputStr, posStart, numChars))

                    If Thickness = tmpThickness Then
                        'Table exists for the thickness, add values to it
                        tmpTable.AddEntry(Radius, Angle, Length)
                    Else
                        'No table exits for the thickness, create it and add the values.
                        tmpTable = New TableDef
                        tmpTable.Thickness = Thickness
                        tmpTable.AddEntry(Radius, Angle, Length)
                        tmpThickness = Thickness
                        m_Tables.Add(tmpTable)
                    End If
                End If
            Loop

HandleError:
            If Err.Number Then
                Err.Clear()
                Select Case FileIOError

                    Case 0
                        ErrMsgString = "There was a problem opening the table.txt file." & Chr(13)
                        ErrMsgString = ErrMsgString & "Make sure that it is in the same directory as the DLL" & Chr(13)
                        ErrMsgString = ErrMsgString & "The default formula in the DLL will be used"
                    Case 1
                        ErrMsgString = "There was a problem reading data from the table.txt file." & Chr(13)
                        ErrMsgString = ErrMsgString & "Check the file and make sure the format is correct." & Chr(13)
                        ErrMsgString = ErrMsgString & "The default formula in the DLL will be used"
                End Select

                MsgBox(ErrMsgString, 48, "Custom Bend Equation")
            End If

            'Clean up
            FileClose(1)
            tmpTable = Nothing
        End Sub

        Protected Overrides Sub Finalize()
            'Delete TableDef objects in m_Tables
            Do While m_Tables.Count() > 0
                m_Tables.Remove(1)
            Loop

            m_CurrentTable = Nothing
        End Sub

        Public Function PZLFunctionArgs() As Integer Implements _ANSITable.PZLFunctionArgs
            PZLFunctionArgs = 0
        End Function

        Public Function PZL(ByRef Feature As Object, ByRef Thickness As Double, ByRef Radius As Double, ByRef SweepAngle As Double, ByRef Material As String, ByRef NF As Double) As Double Implements _ANSITable.PZL
            'This Function is called by SE-Sheet Metal whenever the PZL value is needed

            'The function arguments and units are defined as follows:
            'Feature - The SE-Sheet Metal feature that is being created/updated or flattened.
            'Thickness- Material thickness in meters. Defined in tools options
            'Radius- Bend radius in meters. Defined by the feature.
            'Angle- Sweep angle of the bend in radians. Defined by the feature
            'NF- Neutral factor value (No units). Define in tools options and on the feature.
            'PZL - Return value of this function. Must be in meters.
            '      NOTE: The PZL value that you return to SE-Sheet Metal must be >= 0.000

            Dim k As Double 'Compensation factor used in default formula.
            Dim R As Double 'Bend Radius in inches
            Dim A As Double 'Bend Sweep angle in degrees
            Dim thk As Double 'Material thickness in inches
            Dim TableValue As Double 'Return value from tabledef lookup
            Dim dErrFix As Double

            'Fix for division error bug when calling program from C++
            On Error Resume Next
            dErrFix = 1.0# / 2.0#
            If Err.Number <> 0 Then
                Err.Clear()
            End If

            On Error GoTo Handle_Error

            'Convert input values to inch and degrees using conversion functions (See modmain.bas)
            R = MtoI(Radius)
            thk = MtoI(Thickness)
            A = RtoD(SweepAngle)

            If m_CurrentThickness <> thk Then
                'Set the m_CurrentTable for the specified thickness
                'Note: If no table exists for the thickness we will use default formula
                SetCurrentTable(thk)
            End If

            If TypeName(m_CurrentTable) <> "Nothing" Then
                'Lookup the value if we have a table for this thickness
                'Note: If no entry exists for the given R and A value then -1 is returned and
                '      we will use default formula
                TableValue = m_CurrentTable.GetValueFromTable(R, A)
            Else
                TableValue = -1
            End If

            If TableValue >= 0 Then
                'The value from the table is valid, use it
                PZL = ItoM(TableValue)
                Exit Function
            End If

            'No match in tables or no table for the specified thickness
            'Use the default formula. The one below is for example purposes only
            'Compute correction factor
            If R <= 0.0005 Then 'Check for Zero bend radius.
                'The factor below is for example purposes only. Modify the value or formula
                'as needed to support your required values for zero bend radii.
                k = 1
            ElseIf (Radius / Thickness) > 5 Then
                k = 1
            Else
                k = 0.65 + 0.5 * System.Math.Log(R / m_CurrentThickness) / System.Math.Log(10)
            End If

            PZL = ItoM((R + m_CurrentThickness * k / 2) * PI * A / 180)
            Exit Function

Handle_Error:
            Err.Clear()
            PZL = (Radius + Thickness * 0.33) * SweepAngle

        End Function

        '******************************************************************************
        Private Sub SetCurrentTable(ByRef thk As Double)
            'Select the table using the thickness
            Dim ii As Short

            m_CurrentThickness = thk

            ii = 1
            Do While ii <= m_Tables.Count()
                If m_Tables.Item(ii).ThicknessMatch(m_CurrentThickness) Then
                    'We have a table for the specified thickness, set it to m_CurrentTable
                    m_CurrentTable = m_Tables.Item(ii)
                    Exit Sub
                End If
                ii = ii + 1
            Loop

            'If we reach this point then there it not a table defined for the specified thickness.
            'We will use the default formula to calculate the flat length of the bend. (PZL)
            m_CurrentTable = Nothing
        End Sub
#Region "REGISTRATION"

        ' Code to register/unregister the additional add-in data was derived from Jason Newell (jasonnewell.net)

        ' When Regasm is run on this project, either through IDE or command window, these functions will be called.

        ' Setup the required Solid Edge registry values for an addin that were not automatically
        ' added due to the guid, progid and com visible attributes.
        <ComRegisterFunctionAttribute()> _
        Public Shared Sub RegisterFunction(ByVal t As Type)

            Dim Key As RegistryKey = Registry.ClassesRoot.CreateSubKey("CLSID\{" + t.GUID.ToString() + "}")
            '   {40FC6ED5-2438-11CF-A3DB-080036F12502} = automation object
            If Not (Key Is Nothing) Then
                Key.CreateSubKey("Implemented Categories\" & "{40FC6ED5-2438-11CF-A3DB-080036F12502}")
                Key.Close()
            End If
        End Sub

        ' Remove any registry values specifically added above.
        <ComUnregisterFunctionAttribute()> _
        Public Shared Sub UnregisterFunction(ByVal t As Type)
            Registry.ClassesRoot.DeleteSubKeyTree("CLSID\{" + t.GUID.ToString() + "}")
        End Sub
#End Region

    End Class
End Namespace
