Как вставить новую вершину в полилинию?

Public Sub PrintMessage(MessageString As String, Optional vACD As AcadDocument)
Dim pACD As AcadDocument
Dim pEchoVal As Integer
    If vACD Is Nothing Then Set pACD = ThisDrawing Else Set pACD = vACD
    pEchoVal = pACD.GetVariable("CMDECHO")
    pACD.SetVariable "CMDECHO", 1
    pACD.Utility.Prompt MessageString
    pACD.SetVariable "CMDECHO", pEchoVal
End Sub
'*******************************************
'Эта процедура у меня лежит в модуле Prepare
'поэтому вызывается Prepare.SelSet...
Public Function SelSet(vACD As AcadDocument, vSSName As String, Optional vSelSet As AcadSelectionSet) As AcadSelectionSet
Dim pSS As AcadSelectionSet
    On Error Resume Next
        Set pSS = vACD.SelectionSets.Item(vSSName)
    If Err Then
        Err.Clear
        Set pSS = vACD.SelectionSets.Add(vSSName)
    Else
        pSS.Clear
    End If
    Set vSelSet = pSS
    Set SelSet = pSS
End Function
'*******************************************
'*****Получение массива вершинок*********
'*******************************************
'Эта процедура у меня лежит в модуле JSGet
'поэтому вызывается JSGet.ArrVertexes ...
Public Sub ArrVertexes(vEnt As AcadEntity, vAV() As Double, _
        Optional vNV As Long, Optional vT0, Optional vT1, _
        Optional Closed_LWP_To_Open As Boolean = False)
    '----------------------------------------------------------------------------
    'Получение массива вершинок из геометрии объектов - vAV
    'vNV - верхний индекс массива-количество вершин
    'vT0 - первая точка объекта
    'vT1 - последняя точка
    'Closed_LWP_To_Open - добавление последнего сегмента в массив vT0=vT1
Dim pLin As AcadLine
Dim pArc As AcadArc
Dim pLWP As AcadLWPolyline
Dim pCir As AcadCircle, pTC, pR As Double
Dim nn As Long, i As Long
Dim pTS As Variant
    Select Case TypeName(vEnt)
    Case "IAcadLWPolyline"
        Set pLWP = vEnt
        pTS = pLWP.Coordinates
        vNV = (UBound(pTS) + 1) / 2 - 1
        If Closed_LWP_To_Open And pLWP.Closed Then
            ReDim vAV(0 To vNV + 1, 0 To 4)
            For i = 0 To vNV
                vAV(i, 0) = pTS(i * 2): vAV(i, 1) = pTS(i * 2 + 1)
                pLWP.GetWidth i, vAV(i, 2), vAV(i, 3)
                vAV(i, 4) = pLWP.GetBulge(i)
            Next i
            vAV(vNV + 1, 0) = pTS(0): vAV(vNV + 1, 1) = pTS(1)
'            pLWP.GetWidth i, vAV(i, 2), vAV(i, 3)
'            vAV(i, 4) = pLWP.GetBulge(i)
        Else
            ReDim vAV(0 To vNV, 0 To 4)
            For i = 0 To vNV
                vAV(i, 0) = pTS(i * 2): vAV(i, 1) = pTS(i * 2 + 1)
                pLWP.GetWidth i, vAV(i, 2), vAV(i, 3)
                vAV(i, 4) = pLWP.GetBulge(i)
            Next i
        End If
    Case "IAcadLine"
        Set pLin = vEnt
        vNV = 1
        ReDim vAV(0 To vNV, 0 To 4)
        vAV(0, 0) = pLin.startPoint(0): vAV(0, 1) = pLin.startPoint(1)
        vAV(0, 2) = 0#: vAV(0, 3) = 0#: vAV(0, 4) = 0#
        vAV(1, 0) = pLin.endPoint(0): vAV(1, 1) = pLin.endPoint(1)
        vAV(1, 2) = 0#: vAV(1, 3) = 0#: vAV(1, 4) = 0#
    Case "IAcadArc"
        Set pArc = vEnt
        vNV = 1
        ReDim vAV(0 To vNV, 0 To 4)
        vAV(0, 0) = pArc.startPoint(0): vAV(0, 1) = pArc.startPoint(1)
        vAV(0, 2) = 0#: vAV(0, 3) = 0#
        vAV(1, 0) = pArc.endPoint(0): vAV(1, 1) = pArc.endPoint(1)
        vAV(1, 2) = 0#: vAV(1, 3) = 0#: vAV(1, 4) = 0#
        vAV(0, 4) = KrArcT(Array(vAV(0, 0), vAV(0, 1)), _
                            Array(vAV(1, 0), vAV(1, 1)), _
                            Array(pArc.center(0), pArc.center(1)))
    Case "IAcadCircle"
        Set pCir = vEnt
        pTC = pCir.center
        pR = pCir.Radius
        vNV = 1
        If Closed_LWP_To_Open Then
            ReDim vAV(0 To vNV + 1, 0 To 4)
            vAV(0, 0) = pTC(0) + pR: vAV(0, 1) = pTC(1)
            vAV(0, 2) = 0: vAV(0, 3) = 0: vAV(0, 4) = 1
            vAV(1, 0) = pTC(0) - pR: vAV(1, 1) = pTC(1)
            vAV(1, 2) = 0: vAV(1, 3) = 0: vAV(1, 4) = 1
            vAV(2, 0) = pTC(0) + pR: vAV(2, 1) = pTC(1)
            vAV(2, 2) = 0: vAV(2, 3) = 0: vAV(2, 4) = 0
        Else
            ReDim vAV(0 To vNV, 0 To 4)
            vAV(0, 0) = pTC(0) + pR: vAV(0, 1) = pTC(1)
            vAV(0, 2) = 0: vAV(0, 3) = 0: vAV(0, 4) = 1
            vAV(1, 0) = pTC(0) - pR: vAV(1, 1) = pTC(1)
            vAV(1, 2) = 0: vAV(1, 3) = 0: vAV(1, 4) = 1
        End If
    End Select
    If Not IsMissing(vT0) Then vT0(0) = vAV(0, 0): vT0(1) = vAV(0, 1)
    If Not IsMissing(vT1) Then vT1(0) = vAV(vNV, 0): vT1(1) = vAV(vNV, 1)
End Sub

Public Const Pi = 3.14159265358979
Public Const Pi2 = 6.28318530717959
Public Const Pi_2 = 1.5707963267949
Public Const Pi_3 = 4.71238898038469
Public Const Pi_4 = 0.785398163397448
Public Const Sin_Pi_4 = 0.707106781186548
Public Const Tan_Pi_8 = 0.414213562373095
Public Const Prec = 0.0000001
Public Function DEqual(ByVal v1 As Double, ByVal v2 As Double, ByVal de As Double) As Boolean
    If Math.Abs(v1 - v2) <= de Then
        DEqual = True
    Else
        DEqual = False
    End If
End Function
Public Function PolarPoint(ByVal t0 As Variant, ByVal ang As Double, _
            ByVal Dist As Double, Optional Result) As Variant
Dim vVal(2) As Double
    vVal(0) = t0(0) + Cos(ang) * Dist
    vVal(1) = t0(1) + Sin(ang) * Dist
    vVal(2) = 0
    PolarPoint = vVal
    If Not IsMissing(Result) Then
        Result(0) = vVal(0)
        Result(1) = vVal(1)
    End If
End Function
Public Function AngleTo_0_2pi(ByVal Angle As Double) As Double
    Do
        If Angle < 0 Then
            Angle = Angle + Pi2
        ElseIf Angle < Pi2 Then
            AngleTo_0_2pi = Angle: Exit Function
        Else
            Angle = Angle - Pi2
        End If
    Loop
End Function
Public Function PointLaysOnSegment( _
        ByVal x As Double, ByVal y As Double, _
        ByVal X0 As Double, ByVal Y0 As Double, _
        ByVal X1 As Double, ByVal Y1 As Double, _
        ByVal Blg As Double, _
        Optional vLenSgm As Double, Optional vB1 As Double, Optional vB2 As Double) As Long
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim aseg As Variant, r As Variant, sign As Variant, kr As Double, tc As Variant
Dim sa As Double, ea As Double, ca As Double, ta As Double
Dim pRslt As Long
Dim pt0(1) As Double, pt1(1) As Double, ptx(1) As Double
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'Функция возвращает -1 если искомая точка лежит внутри сегмента.
    'Функция возвращает 1 если искомая точка совпадает с первой вершиной.
    'Функция возвращает 2 если искомая точка совпадает со второй вершиной.
    'Сегмент задаётся начальной точкой X0, Y0, конечной точкой X1, Y1, и кривизной Blg
    'Тестовая точка X, Y
    'При необходимости можно получить длину сегмента vLenSgm,
    'и две кривизны получившихся от разбиения сегментов - vB1, vB2
    pt0(0) = X0: pt0(1) = Y0: pt1(0) = X1: pt1(1) = Y1: ptx(0) = x: ptx(1) = y
    If DEqual(Distance(ptx, pt0), 0, Prec) Then
        pRslt = 1
    ElseIf DEqual(Distance(ptx, pt0), 0, Prec) Then
        pRslt = 2
    Else
        vLenSgm = LenSegmPL(pt0, pt1, Blg, aseg, r, sign, tc)
        If DEqual(Blg * vLenSgm / 2, 0#, Prec) Then
            If X0 < x And x < X1 And Y0 < y And y < Y1 Then
                If DEqual((Y1 - Y0) * (X1 - x), (Y1 - y) * (X1 - X0), Prec) Then pRslt = -1
            ElseIf X0 < x And x < X1 And Y1 < y And y < Y0 Then
                If DEqual((Y1 - Y0) * (X1 - x), (Y1 - y) * (X1 - X0), Prec) Then pRslt = -1
            ElseIf X1 < x And x < X0 And Y1 < y And y < Y0 Then
                If DEqual((Y1 - Y0) * (X1 - x), (Y1 - y) * (X1 - X0), Prec) Then pRslt = -1
            ElseIf X1 < x And x < X0 And Y0 < y And y < Y1 Then
                If DEqual((Y1 - Y0) * (X1 - x), (Y1 - y) * (X1 - X0), Prec) Then pRslt = -1
            ElseIf X0 < x And x < X1 And DEqual(Y0, y, Prec) And DEqual(y, Y1, Prec) Then
                pRslt = -1
            ElseIf Y1 < y And y < Y0 And DEqual(X0, x, Prec) And DEqual(x, X1, Prec) Then
                pRslt = -1
            ElseIf X1 < x And x < X0 And DEqual(Y0, y, Prec) And DEqual(y, Y1, Prec) Then
                pRslt = -1
            ElseIf Y0 < y And y < Y1 And DEqual(X0, x, Prec) And DEqual(x, X1, Prec) Then
                pRslt = -1
            End If
        Else
            If DEqual(Distance(tc, ptx), r, Prec) Then
                sa = AngleFromXAxis(tc, pt0)
                ca = AngleFromXAxis(tc, ptx)
                ea = AngleFromXAxis(tc, pt1)
                If Blg > 0 Then
                    If sa < ea Then
                        If sa < ca And ca < ea Then
                            vB1 = Tan((ca - sa) / 4)
                            vB2 = Tan((ea - ca) / 4)
                            pRslt = -1
                        End If
                    Else
                        If ca < ea Then
                            vB1 = Tan((Pi2 + ca - sa) / 4)
                            vB2 = Tan((ea - ca) / 4)
                            pRslt = -1
                        ElseIf sa < ca Then
                            vB1 = Tan((ca - sa) / 4)
                            vB2 = Tan((Pi2 + ea - ca) / 4)
                            pRslt = -1
                        End If
                    End If
                Else
                    If ea < sa Then
                        If ea < ca And ca < sa Then
                            vB1 = -Tan((sa - ca) / 4)
                            vB2 = -Tan((ca - ea) / 4)
                            pRslt = -1
                        End If
                    Else
                        If ca < sa Then
                            vB1 = -Tan((sa - ca) / 4)
                            vB2 = -Tan((Pi2 - ea + ca) / 4)
                            pRslt = -1
                        ElseIf ea < ca Then
                            vB1 = -Tan((Pi2 + sa - ca) / 4)
                            vB2 = -Tan((ca - ea) / 4)
                            pRslt = -1
                        End If
                    End If
                End If
            End If
        End If
    End If
    PointLaysOnSegment = pRslt
End Function
Public Function LenSegmPL( _
    ByVal t0 As Variant, ByVal t1 As Variant, ByVal kr As Double, _
    Optional ta As Variant, Optional vR As Variant, _
    Optional vS As Variant, Optional vTC As Variant) As Double
Dim t2(1) As Double, t3 As Variant, tc As Variant
Dim t4(1) As Double, t5 As Variant
Dim dd As Double, d As Double, d1 As Double, sign As Integer
Dim Alfa As Double, beta As Double, Gamma As Double, r As Double
    dd = Distance(t0, t1)
    d = dd / 2
    d1 = d * kr
    If Abs(d1) >= Prec Then
        t2(0) = (t0(0) + t1(0)) / 2
        t2(1) = (t0(1) + t1(1)) / 2
        Alfa = AngleFromXAxis(t0, t1)
        d1 = d * (kr * kr - 1) / 2 / kr
        tc = PolarPoint(t2, Alfa - Pi_2, d1)
        r = Distance(t0, tc)
        Gamma = 4 * Atn(kr)
        sign = Sgn(kr)
        If Not IsMissing(ta) Then ta = Gamma
        If Not IsMissing(vR) Then vR = r
        If Not IsMissing(vS) Then vS = sign
        If Not IsMissing(vTC) Then vTC = tc
        LenSegmPL = Abs(Gamma) * r
   Else
        LenSegmPL = dd
        If Not IsMissing(ta) Then ta = Null
        If Not IsMissing(vR) Then vR = Null
        If Not IsMissing(vS) Then vS = Null
        If Not IsMissing(vTC) Then vTC = Null
    End If
End Function
Public Function Distance(ByVal t0 As Variant, ByVal t1 As Variant) As Double
        Distance = Sqr(((t1(0) - t0(0)) ^ 2) + ((t1(1) - t0(1)) ^ 2))
End Function
Public Function OpredCenter(t0 As Variant, t1 As Variant, Blg As Double) As Variant
Dim t2(1) As Double, t3 As Variant, vTC(1) As Double
Dim t4(1) As Double, t5 As Variant
Dim d As Double, d1 As Double
Dim Alfa As Double, beta As Double
    Alfa = AngleFromXAxis(t0, t1)
    d = Sqr((t1(0) - t0(0)) ^ 2 + (t1(1) - t0(1)) ^ 2)
    t2(0) = (t0(0) + t1(0)) / 2: t2(1) = (t0(1) + t1(1)) / 2
    If Abs(Blg) >= Prec Then
        d1 = d * (Blg * Blg - 1) / 4 / Blg
        OpredCenter = PolarPoint(t2, Alfa - Pi_2, d1)
    End If
End Function
Public Function SegmentsUnite(Precision As Double, _
            X1 As Double, Y1 As Double, _
            X2 As Double, Y2 As Double, _
            X3 As Double, Y3 As Double, _
            B1 As Double, B2 As Double, _
            vBResult As Double, Optional vComment As String) As Boolean
    '''''''''''''''''''''''''''''''''''''''''''''
Dim pSlc As Long, pSlc2 As Long
Dim pL1 As Double, pL2 As Double, pD1 As Double, pD2 As Double
Dim pA1 As Double, pA2 As Double
Dim pTC1, pTC2, t0(1) As Double, t1(1) As Double
    pD1 = Sqr((X2 - X1) ^ 2 + (Y2 - Y1) ^ 2)
    pD2 = Sqr((X3 - X2) ^ 2 + (Y3 - Y2) ^ 2)
    If pD1 > Precision Then pSlc = 1
    If pD2 > Precision Then pSlc = pSlc + 2
    If Abs(B1) > Precision Then pSlc = pSlc + 4
    If Abs(B2) > Precision Then pSlc = pSlc + 8
    Select Case pSlc
    Case 0: 'Всё по нулям. Хороший шанс объединить сегменты.
        vBResult = 0
        vComment = ""
        SegmentsUnite = True
    Case 1: 'Первый сегмент не ноль. Хороший шанс объединить сегменты.
        vBResult = 0
        vComment = ""
        SegmentsUnite = True
    Case 2: 'Второй сегмент не ноль. Хороший шанс объединить сегменты
        vBResult = 0
        vComment = ""
        SegmentsUnite = True
    Case 3: 'Оба сегмента ненулевые отрезки. Требуется проверка на коллинеарность..
        If Abs((X3 - X2) * (Y3 - Y1) - (X3 - X1) * (Y3 - Y2)) < Precision Then
            'Отрезки коллинеарны можно объединять.
            vBResult = 0
            vComment = ""
            SegmentsUnite = True
        Else
            'Отрезки неколлинеарны. Нельзя объединять.
            vBResult = 0
            vComment = "Отрезки неколлинеарны. Нельзя объединять."
            SegmentsUnite = False
        End If
    Case 4: 'Первый сегмент – нуль дуга, второй – нуль отрезок.
        If Abs(B1) < 1 Then
            'Габарит дуги в пределах точности. Пренебрегаем ей. Можно объединять.
            vBResult = 0
            vComment = ""
            SegmentsUnite = True
        Else
            'Габарит дуги больше предела точности. Можно объединять за счёт второго сегмента.
            vBResult = B1
            vComment = ""
            SegmentsUnite = True
        End If
    Case 5: 'Первый сегмент - дуга, второй – нуль отрезок. Можно объединять за счёт второго сегмента.
        vBResult = B1
        vComment = ""
        SegmentsUnite = True
    Case 6: 'Первый сегмент – нуль дуга, второй - отрезок.
        If Abs(B1) < 1 Then
            'Габарит дуги в пределах точности. Пренебрегаем ей. Можно объединять.
            vBResult = 0
            vComment = ""
            SegmentsUnite = True
        Else
            'Габарит дуги больше предела точности. Нельзя объединять.
            vBResult = 0
            vComment = "Габарит дуги больше предела точности. Нельзя объединять."
            SegmentsUnite = False
        End If
    Case 7: 'Первый сегмент - дуга, второй - отрезок. Нельзя объединять.
        vBResult = 0
        vComment = " Первый сегмент - дуга, второй - отрезок. Нельзя объединять."
        SegmentsUnite = False
    Case 8: 'Первый – нуль отрезок, второй – нуль дуга.
        If Abs(B2) < 1 Then
            'Габарит дуги в пределах точности. Пренебрегаем ей. Можно объединять.
            vBResult = 0
            vComment = ""
            SegmentsUnite = True
        Else
            ' Габарит дуги больше предела точности. Можно объединять за счёт первого сегмента.
            vBResult = B2
            vComment = ""
            SegmentsUnite = True
        End If
    Case 9: 'Первый – отрезок, второй – нуль дуга.
        If Abs(B2) < 1 Then
            ' Габарит дуги в пределах точности. Пренебрегаем ей. Можно объединять.
            vBResult = 0
            vComment = ""
            SegmentsUnite = True
        Else
            'Габарит дуги больше предела точности. Нельзя объединять.
            vBResult = 0
            vComment = "Габарит дуги больше предела точности. Нельзя объединять."
            SegmentsUnite = False
        End If
    Case 10: 'Первый – нуль отрезок. Второй – дуга. Можно объединять за счёт первого сегмента.
        vBResult = B2
        vComment = ""
        SegmentsUnite = True
    Case 11: 'Первый – отрезок, второй – дуга. Нельзя объединять.
        vBResult = 0
        vComment = "Первый – отрезок, второй – дуга. Нельзя объединять."
        SegmentsUnite = False
    Case 12: 'Первый сегмент – нуль дуга, второй – нуль дуга.
        If Abs(B1) > 1 Then pSlc2 = 1
        If Abs(B2) > 1 Then pSlc2 = pSlc2 + 2
        Select Case pSlc2
        Case 0: 'Обе дуги можно слить в один нуль отрезок.
            vBResult = 0
            vComment = ""
            SegmentsUnite = True
        Case 1: 'Второй пренебрегаем.
            vBResult = B1
            vComment = ""
            SegmentsUnite = True
        Case 2: 'Первой пренебрегаем.
            vBResult = B1
            vComment = ""
            SegmentsUnite = True
        Case 3:
            If Sgn(B1) <> Sgn(B2) Then
                'Нельзя объединять
                vBResult = 0
                vComment = "Малые дуги с разным направлением выпуклости. Нельзя объединять."
                SegmentsUnite = False
            Else
                'Нужно смотреть, как расположены центры дуг.
                t0(0) = X1: t0(1) = Y1
                t1(0) = X2: t1(1) = Y2
                pTC1 = OpredCenter(t0, t1, B1)
                t0(0) = X2: t0(1) = Y2
                t1(0) = X3: t1(1) = Y3
                pTC2 = OpredCenter(t0, t1, B2)
                If Sqr(((pTC2(0) - pTC1(0)) ^ 2) + ((pTC2(1) - pTC1(1)) ^ 2)) < Precision Then
                    'Центры совпадают. Объединять можно.
                    pA1 = 4 * Atn(Abs(B1)): pA2 = 4 * Atn(Abs(B2))
                    vBResult = Sgn(B1) * Tan((pA1 + pA2) / 4)
                    vComment = ""
                    SegmentsUnite = True
                Else
                    'Центры не совпадают. Объединять нельзя.
                    vBResult = 0
                    vComment = "Центры не совпадают. Объединять нельзя."
                    SegmentsUnite = False
                End If
            End If
        End Select
    Case 13: 'Первый – дуга, второй – нуль дуга.
        If Abs(B2) > 1 Then
            If Sgn(B1) <> Sgn(B2) Then
                'Нельзя объединять
                vBResult = 0
                vComment = "Дуги с разным направлением выпуклости. Нельзя объединять."
                SegmentsUnite = False
            Else
                'Нужно смотреть, как расположены центры дуг.
                t0(0) = X1: t0(1) = Y1
                t1(0) = X2: t1(1) = Y2
                pTC1 = OpredCenter(t0, t1, B1)
                t0(0) = X2: t0(1) = Y2
                t1(0) = X3: t1(1) = Y3
                pTC2 = OpredCenter(t0, t1, B2)
                If Sqr(((pTC2(0) - pTC1(0)) ^ 2) + ((pTC2(1) - pTC1(1)) ^ 2)) < Precision Then
                    'Центры совпадают. Объединять можно.
                    pA1 = 4 * Atn(Abs(B1)): pA2 = 4 * Atn(Abs(B2))
                    vBResult = Sgn(B1) * Tan((pA1 + pA2) / 4)
                    vComment = ""
                    SegmentsUnite = True
                Else
                    'Центры не совпадают. Объединять нельзя.
                    vBResult = 0
                    vComment = "Центры не совпадают. Объединять нельзя."
                    SegmentsUnite = False
                End If
            End If
        Else
            'Вторую дугу убираем.
            vBResult = B1
            vComment = ""
            SegmentsUnite = True
        End If
    Case 14: 'Первый – нуль дуга, второй - дуга.
        If Abs(B1) > 1 Then
            If Sgn(B1) <> Sgn(B2) Then
                'Нельзя объединить
                vBResult = 0
                vComment = "Дуги с разным направлением выпуклости. Нельзя объединять."
                SegmentsUnite = False
            Else
                'Нужно смотреть, как расположены центры дуг.
                t0(0) = X1: t0(1) = Y1
                t1(0) = X2: t1(1) = Y2
                pTC1 = OpredCenter(t0, t1, B1)
                t0(0) = X2: t0(1) = Y2
                t1(0) = X3: t1(1) = Y3
                pTC2 = OpredCenter(t0, t1, B2)
                If Sqr(((pTC2(0) - pTC1(0)) ^ 2) + ((pTC2(1) - pTC1(1)) ^ 2)) < Precision Then
                    'Центры совпадают. Объединять можно.
                    pA1 = 4 * Atn(Abs(B1)): pA2 = 4 * Atn(Abs(B2))
                    vBResult = Sgn(B1) * Tan((pA1 + pA2) / 4)
                    vComment = ""
                    SegmentsUnite = True
                Else
                    'Центры не совпадают. Объединять нельзя.
                    vBResult = 0
                    vComment = "Центры не совпадают. Объединять нельзя."
                    SegmentsUnite = False
                End If
            End If
        Else
            'Первую дугу убираем.
            vBResult = B2
            vComment = ""
            SegmentsUnite = True
        End If
    Case 15: 'Две дуги.
        If Sgn(B1) <> Sgn(B2) Then
            'Нельзя объединить
            vBResult = 0
            vComment = "Дуги с разным направлением выпуклости. Нельзя объединять."
            SegmentsUnite = False
        Else
            'Нужно смотреть, как расположены центры дуг.
            t0(0) = X1: t0(1) = Y1
            t1(0) = X2: t1(1) = Y2
            pTC1 = OpredCenter(t0, t1, B1)
            t0(0) = X2: t0(1) = Y2
            t1(0) = X3: t1(1) = Y3
            pTC2 = OpredCenter(t0, t1, B2)
            If Sqr(((pTC2(0) - pTC1(0)) ^ 2) + ((pTC2(1) - pTC1(1)) ^ 2)) < Precision Then
                'Центры совпадают. Объединять можно.
                pA1 = 4 * Atn(Abs(B1)): pA2 = 4 * Atn(Abs(B2))
                vBResult = Sgn(B1) * Tan((pA1 + pA2) / 4)
                vComment = ""
                SegmentsUnite = True
            Else
                'Центры не совпадают. Объединять нельзя.
                vBResult = 0
                vComment = "Центры не совпадают. Объединять нельзя."
                SegmentsUnite = False
            End If
        End If
    End Select
End Function
Public Function AngleFromXAxis(t0 As Variant, t1 As Variant)
Dim x As Double, y As Double
    x = t1(0) - t0(0): y = t1(1) - t0(1)
    If x >= Abs(y) Then
        AngleFromXAxis = Atn(y / x)
    ElseIf -x >= Abs(y) Then
        AngleFromXAxis = Pi + Atn(y / x)
    ElseIf y >= Abs(x) Then
        AngleFromXAxis = Pi_2 + Atn(-x / y)
    Else
        AngleFromXAxis = Pi_3 + Atn(-x / y)
    End If
End Function
Public Sub GrClear(vACD As AcadDocument)
Dim i As Long, ii As Long
Dim pFrom As String, pTo As String, pCmd As String
Dim pEchoVal As Integer
    pEchoVal = vACD.GetVariable("CMDECHO")
    vACD.SetVariable "CMDECHO", 0
        vACD.SendCommand "(redraw) "
    vACD.SetVariable "CMDECHO", pEchoVal
End Sub
Public Sub GrMarkVertexes(vLWP As AcadLWPolyline, Color As Integer)
Dim pACD As AcadDocument
    Set pACD = vLWP.Document
    pACD.SendCommand "(GrMarkVertexes """ & vLWP.Handle & """ " & Color & ") "
End Sub

(defun GrMarkVertexes ( plin color / plinlst pD pX pY pXs pYs pXe pYe i pNV nabor t0 t1 )
;Процедура подсвечивает вершинки полилинии plin цветом color
  (setq
    plinlst (entget (handent plin))
    k0 (cdr (assoc 0 plinlst))
    k8 (cdr (assoc 8 plinlst))
    k62 (cdr (assoc 62 plinlst))
    k67 (cdr (assoc 67 plinlst))
    k70 (cdr (assoc 70 plinlst))
    k90 (cdr (assoc 90 plinlst))
    f70 k70
    pNV k90
    pD (/ (getvar "VIEWSIZE") 100)
    plinlst (member (assoc 10 plinlst) plinlst)
    nn 0 nin k90
  )
  (while
    (< nn nin)
    (setq
      pt0 (cdr (nth (* nn 4) plinlst))
      pX (car pt0)
      pY (cadr pt0)
      pXs (- pX pD)
      pYs (- pY pD)
      pXe (+ pX pD)
      pYe (+ pY pD)
      t0 (list pXs pYs)
      t1 (list pXe pYe)
    )
    (grdraw t0 t1 color)
    (setq t0 (list pXs pYe) t1 (list pXe pYs))
    (grdraw t0 t1 color)
    (setq nn (+ nn 1))
   )
  (prin1)
)
(defun C:VertexAdd (/)(setvar "cmdecho" 0)(command "_-vbarun" "VertexAdd")(princ))
(defun C:VertexDel (/)(setvar "cmdecho" 0)(command "_-vbarun" "VertexDel")(princ))
(defun C:PolySegmentArcToLine (/)(setvar "cmdecho" 0)(command "_-vbarun" "PolySegmentArcToLine")(princ))
(defun C:PolySegmentLineToArc (/)(setvar "cmdecho" 0)(command "_-vbarun" "PolySegmentLineToArc")(princ))