Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry
Imports System.Math
Public Class GILSclass1
    <CommandMethod("TOS")> _
Public Sub TdOffset()
        Dim Db As Database = HostApplicationServices.WorkingDatabase
        Dim Ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
        Dim Tr As Transaction = Db.TransactionManager.StartTransaction
        Try
            Dim EntSelOpt As PromptEntityOptions = New PromptEntityOptions("" & Microsoft.VisualBasic.Chr(10) & "Select 3dPolyLine: ")
            EntSelOpt.SetRejectMessage("" & Microsoft.VisualBasic.Chr(10) & "Only Selected 3d PolyLine!")
            EntSelOpt.AddAllowedClass(GetType(Polyline3d), True)
            Dim EntSelRes As PromptEntityResult = Ed.GetEntity(EntSelOpt)
            If EntSelRes.Status <> PromptStatus.OK Then Return

            Dim DrOpt As PromptPointOptions = New PromptPointOptions("" & Microsoft.VisualBasic.Chr(10) & "Specify Offset Direction: ")
            Dim Dres As PromptPointResult = Ed.GetPoint(DrOpt)

            Dim DrDst As PromptDoubleOptions = New PromptDoubleOptions("" & Microsoft.VisualBasic.Chr(10) & "Input Offset Distance: ")
            Dim Ddst As PromptDoubleResult = Ed.GetDouble(DrDst)

            Dim Z_Sig As PromptDoubleOptions = New PromptDoubleOptions("" & Microsoft.VisualBasic.Chr(10) & "Input Z Value: ")
            Dim Z_res As PromptDoubleResult = Ed.GetDouble(Z_Sig)

            Dim Ent As Polyline3d = CType(Tr.GetObject(EntSelRes.ObjectId, OpenMode.ForRead), Polyline3d)
            Dim c As Curve = DirectCast(Ent, Curve)
            Dim sp As Double = c.StartParam
            Dim ep As Double = c.EndParam

            Dim ssp As Point3d = c.GetPointAtParameter(sp)
            Dim eep As Point3d = c.GetPointAtParameter(ep)

            Dim Vspdr As Double = V(Dres.Value, ssp)

            Dim bt As BlockTable = Tr.GetObject(Db.BlockTableId, OpenMode.ForRead)
            Dim btr As BlockTableRecord = Tr.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
            Dim pts As Point3dCollection = New Point3dCollection
            Dim FnPt As Point3d
            Dim fts As Point3dCollection = New Point3dCollection

            Dim qqq As Vector3d = New Vector3d
            Dim ppp As Vector3d = New Vector3d
            ppp.CrossProduct(qqq)

            Dim n As Integer = 0
            For p As Double = sp To ep Step 1.0
                n = n + 1
                Dim pt As Point3d = c.GetPointAtParameter(p)
                Dim gt As Point3d = New Point3d(pt.X, pt.Y, pt.Z + Z_res.Value)
                Dim Vptnt As Double
                Dim nt As Point3d
                If p <> ep Then
                    nt = c.GetPointAtParameter(p + 1.0)
                    Vptnt = V(nt, pt)
                ElseIf p = ep Then
                End If
                Dim SndPt1 As Point3d
                Dim SndPt2 As Point3d
                Dim Vfn As Double
                Select Case (Vspdr > 0 Or Vspdr = 0) AndAlso Vspdr < Atan(1) * 4
                    Case True
                        Vfn = Vptnt + 2 * Atan(1)
                        SndPt1 = PolarPoint(Dst(pt, nt).Item(0), Vfn, Ddst.Value)
                        SndPt2 = PolarPoint(Dst(pt, nt).Item(1), Vfn, Ddst.Value)
                    Case False
                        Vfn = Vptnt - 2 * Atan(1)
                        SndPt1 = PolarPoint(Dst(gt, nt).Item(0), Vfn, Ddst.Value)
                        SndPt2 = PolarPoint(Dst(gt, nt).Item(1), Vfn, Ddst.Value)
                End Select
                pts.Add(SndPt1)
                pts.Add(SndPt2)
                If p <> sp AndAlso p <> ep Then
                    FnPt = API(pts.Item(2 * n - 4), pts.Item(2 * n - 3), pts.Item(2 * n - 2), pts.Item(2 * n - 1))
                    Dim FnlPt As Point3d = New Point3d(FnPt.X, FnPt.Y, gt.Z)
                    fts.Add(FnlPt)
                ElseIf p = sp Then
                    FnPt = PolarPoint(pt, Vfn, Ddst.Value)
                    Dim fnlpt As Point3d = New Point3d(SndPt1.X, SndPt1.Y, gt.Z)
                    fts.Add(fnlpt)
                ElseIf p = ep Then
                    Select Case (Vspdr > 0 Or Vspdr = 0) AndAlso Vspdr < Atan(1) * 4
                        Case True
                            Vfn = Vptnt + 2 * Atan(1)
                        Case False
                            Vfn = Vptnt - 2 * Atan(1)
                    End Select
                    FnPt = PolarPoint(pt, Vfn, Ddst.Value)
                    Dim fnlpt As Point3d = New Point3d(SndPt1.X, SndPt1.Y, gt.Z)
                    fts.Add(fnlpt)
                End If

            Next

            Dim my3dpoly As Polyline3d = New Polyline3d(Poly3dType.SimplePoly, fts, False)

            btr.AppendEntity(my3dpoly)
            Tr.AddNewlyCreatedDBObject(my3dpoly, True)
            Tr.Commit()
        Catch

        Finally
            Tr.Dispose()
        End Try
    End Sub
    Friend Function PolarPoint(ByVal BasePoint As Point3d, ByVal angle As Double, ByVal distance As Double) As Point3d
        Dim x As Double = distance * Cos(angle)
        Dim y As Double = distance * Sin(angle)
        Return New Point3d(BasePoint.X + x, BasePoint.Y + y, BasePoint.Z)
    End Function
    Friend Function API(ByVal p1 As Point3d, ByVal p2 As Point3d, ByVal p3 As Point3d, ByVal p4 As Point3d) As Point3d
        Dim angAp As Double = Atan((p2.Y - p1.Y) / (p2.X - p1.X))
        Dim angBt As Double = Atan((p4.Y - p3.Y) / (p4.X - p3.X))
        Dim ar1 As Double = (((p3.Y - p1.Y) * Cos(angBt) - (p3.X - p1.X) * Sin(angBt)) / Sin(angAp - angBt))
        Dim ar2 As Double = (((p3.Y - p1.Y) * Cos(angAp) - (p3.X - p1.X) * Sin(angAp)) / Sin(angAp - angBt))
        Dim x As Double = p1.X + ar1 * Cos(angAp)
        Dim y As Double = p1.Y + ar1 * Sin(angAp)
        Return New Point3d(x, y, 0)
    End Function
    Friend Function BPI(ByVal p1 As Point3d, ByVal p2 As Point3d, ByVal p3 As Point3d, ByVal p4 As Point3d) As Point3d
        Dim angAp As Double = Atan((p2.Y - p1.Y) / (p2.X - p1.X))
        Dim angBt As Double = Atan((p4.Y - p3.Y) / (p4.X - p3.X))
        Dim ar1 As Double = (((p3.Y - p1.Y) * Cos(angBt) - (p3.X - p1.X) * Sin(angBt)) / Sin(angAp - angBt))
        Dim ar2 As Double = (((p3.Y - p1.Y) * Cos(angAp) - (p3.X - p1.X) * Sin(angAp)) / Sin(angAp - angBt))
        Dim x As Double = p1.X + ar1 * Cos(angAp)
        Dim y As Double = p1.Y + ar1 * Sin(angAp)
        Return New Point3d(x, y, 0)
    End Function
    Friend Function V(ByVal p1 As Point3d, ByVal p2 As Point3d) As Double
        Dim ang As Double = Atan((p2.Y - p1.Y) / (p2.X - p1.X))
        Return ang
    End Function
    Friend Function Dst(ByVal p1 As Point3d, ByVal p2 As Point3d) As Point3dCollection
        Dim ds As Double = Sqrt((p2.X - p1.X) ^ 2 + (p2.Y - p1.Y) ^ 2)
        Dim va As Double = V(p1, p2)
        Dim s1 As Point3d = PolarPoint(p1, va, ds / 3)
        Dim s2 As Point3d = PolarPoint(p1, va, ds * 2 / 3)
        Dim ggc As Point3dCollection = New Point3dCollection
        ggc.Add(s1)
        ggc.Add(s2)
        Return ggc
    End Function

End Class