Как найти координаты вершин прямоугольника по координатам его диагонали и углу?

Sub aa()
Dim pACD As AcadDocument
Dim pRect As New TRectangle
Dim pAngle As Double
Dim pT1, pT2
    Set pACD = ThisDrawing
    pAngle = Pi * 30 / 180
    PrintMessage vbCrLf & "Пусть будет угол " & 30 & " градусов."
    PrintMessage vbCrLf & "Первая точка "
    pT1 = pACD.Utility.GetPoint
    PrintMessage vbCrLf & "Вторая точка "
    pT2 = pACD.Utility.GetPoint(pT1)
    pRect.InitTTA pT1, pT2, pAngle
    pRect.CreateLWPolyLine pACD.ModelSpace
End Sub

'Class TRectangle
Option Explicit
Private mTS(1) As Double, mTE(1) As Double
Private mT(3, 1) As Double
Private Angle As Double, hw As Double, L As Double
Private mTmin(1) As Double, mTmax(1) As Double
Public Sub InitSEW(Tstart, Tend, Width As Double)
Dim pT As Variant
    mTS(0) = Tstart(0): mTS(1) = Tstart(1)
    mTE(0) = Tend(0): mTE(1) = Tend(1)
    Angle = AngleFromXAxis(mTS, mTE)
    hw = Width / 2
    pT = PolarPoint(mTS, Angle - Pi_2, hw)
    mT(0, 0) = pT(0): mT(0, 1) = pT(1)
    pT = PolarPoint(mTE, Angle - Pi_2, hw)
    mT(1, 0) = pT(0): mT(1, 1) = pT(1)
    pT = PolarPoint(mTE, Angle + Pi_2, hw)
    mT(2, 0) = pT(0): mT(2, 1) = pT(1)
    pT = PolarPoint(mTS, Angle + Pi_2, hw)
    mT(3, 0) = pT(0): mT(3, 1) = pT(1)
    SearchMinMaxMultyCol mT, 0, mTmin(0), mTmax(0)
    SearchMinMaxMultyCol mT, 1, mTmin(1), mTmax(1)
End Sub
Public Sub InitTTA(TLeftBottom, TRightTop, Angle As Double)
Dim pT(1) As Double, L As Double, m As Double, d As Double
Dim t1(1) As Double, t2(1) As Double, t3(1) As Double, t4(1) As Double
    PolarPoint TLeftBottom, Angle, 100, pT
    L = pT(0) - TLeftBottom(0): m = pT(1) - TLeftBottom(1)
    d = -(m * (TRightTop(0) - TLeftBottom(0)) _
        - L * (TRightTop(1) - TLeftBottom(1))) _
        / Sqr(L * L + m * m)
    If d < 0 Then
        PolarPoint TLeftBottom, Angle + Pi_2, d, t1
        t4(0) = TLeftBottom(0): t4(1) = TLeftBottom(1)
        PolarPoint TRightTop, Angle - Pi_2, d, t3
        t2(0) = TRightTop(0): t2(1) = TRightTop(1)
    Else
        PolarPoint TLeftBottom, Angle + Pi_2, d, t4
        t1(0) = TLeftBottom(0): t1(1) = TLeftBottom(1)
        PolarPoint TRightTop, Angle - Pi_2, d, t2
        t3(0) = TRightTop(0): t3(1) = TRightTop(1)
    End If
    mT(0, 0) = t1(0): mT(0, 1) = t1(1)
    mT(1, 0) = t2(0): mT(1, 1) = t2(1)
    mT(2, 0) = t3(0): mT(2, 1) = t3(1)
    mT(3, 0) = t4(0): mT(3, 1) = t4(1)
    mTS(0) = (t1(0) + t4(0)) / 2: mTS(1) = (t1(1) + t4(1)) / 2
    mTE(0) = (t2(0) + t3(0)) / 2: mTE(1) = (t2(1) + t3(1)) / 2
    SearchMinMaxMultyCol mT, 0, mTmin(0), mTmax(0)
    SearchMinMaxMultyCol mT, 1, mTmin(1), mTmax(1)
    hw = Distance(t2, t3) / 2
    L = Distance(t1, t2)
End Sub
Public Sub GetBoundingBox(TMin, TMax, Optional DX, Optional DY)
    TMin = mTmin: TMax = mTmax
    If Not IsMissing(DX) Then DX = mTmax(0) - mTmin(0)
    If Not IsMissing(DY) Then DY = mTmax(1) - mTmin(1)
End Sub
Public Function CreateLWPolyLine(acBlock As AcadBlock, Optional CenterLine As Boolean = False) As AcadLWPolyline
Dim pLWP As AcadLWPolyline
Dim pVrtx() As Double
Dim W As Double
    If CenterLine Then
        ReDim pVrtx(0 To 3)
        pVrtx(0) = mTS(0): pVrtx(1) = mTS(1): pVrtx(2) = mTE(0): pVrtx(3) = mTE(1)
        Set pLWP = acBlock.AddLightWeightPolyline(pVrtx)
        W = 2 * hw
        pLWP.SetWidth 0, W, W
    Else
        ReDim pVrtx(0 To 7)
        pVrtx(0) = mT(0, 0): pVrtx(1) = mT(0, 1): pVrtx(2) = mT(1, 0): pVrtx(3) = mT(1, 1)
        pVrtx(4) = mT(2, 0): pVrtx(5) = mT(2, 1): pVrtx(6) = mT(3, 0): pVrtx(7) = mT(3, 1)
        Set pLWP = acBlock.AddLightWeightPolyline(pVrtx)
        pLWP.Closed = True
    End If
    Set CreateLWPolyLine = pLWP
End Function
Public Property Get startPoint() As Variant
    startPoint = mTS
End Property
'Public Property Let StartPoint(ByVal vNewValue As Variant)
'End Property
Public Property Get endPoint() As Variant
    endPoint = mTE
End Property
'Public Property Let EndPoint(ByVal vNewValue As Variant)
'End Property
Public Function BorderPoint(Index As Long) As Variant
    BorderPoint = Array(mT(Index, 0), mT(Index, 1))
End Function
Public Property Get HalfWidth() As Double
    HalfWidth = hw
End Property
'Public Property Let HalfWidth(ByVal vNewValue As Variant)
'End Property

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 Sub SearchMinMaxMultyCol(ByRef ArrayOfNumbers, ncol As Long, _
            ByRef MinVal, ByRef MaxVal)
Dim i As Long, n1 As Long, n2 As Long
    n1 = LBound(ArrayOfNumbers, 1): n2 = UBound(ArrayOfNumbers, 1)
    MinVal = ArrayOfNumbers(n1, ncol): MaxVal = ArrayOfNumbers(n2, ncol)
    For i = n1 + 1 To n2
        If MinVal > ArrayOfNumbers(i, ncol) Then MinVal = ArrayOfNumbers(i, ncol)
        If MaxVal < ArrayOfNumbers(i, ncol) Then MaxVal = ArrayOfNumbers(i, ncol)
    Next i
End Sub
Public Function PolarPoint(ByVal t0 As Variant, ByVal ang As Double, _
            ByVal Dist As Double, Optional Result) As Variant
Dim pVal(2) As Double
    pVal(0) = t0(0) + Cos(ang) * Dist
    pVal(1) = t0(1) + Sin(ang) * Dist
    pVal(2) = 0
    PolarPoint = pVal
    If Not IsMissing(Result) Then
        Result(0) = pVal(0)
        Result(1) = pVal(1)
    End If
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