Подписать полилинию текстом

          Public Sub DrawRoadLine()
          Dim vpick As Variant
          Dim dCoords() As Double
          Dim I As Long
          Dim oPoly As AcadLWPolyline
          Dim optClose As Boolean
          I = 0
          On Error Resume Next
          vpick = ThisDrawing.Utility.GetPoint(, vbCr & "Pick starting point: ")
If Err = 0 Then
    ReDim dCoords(1)
    dCoords(I) = vpick(0): dCoords(I + 1) = vpick(1)
    Do Until Err.Number <> 0
        I = I + 2
        vpick = ThisDrawing.Utility.GetPoint(vpick, vbCr & "... and next point: ")
        ReDim Preserve dCoords(UBound(dCoords) + 2)
        dCoords(I) = vpick(0): dCoords(I + 1) = vpick(1)
        If oPoly Is Nothing Then
            Set oPoly = ThisDrawing.ModelSpace.AddLightWeightPolyline(dCoords)
        Else
            oPoly.Coordinates = dCoords
        End If
    Loop
          Dim rdText As AcadText
          Dim basePnt(0 To 2) As Double
          Dim nextPnt(0 To 2) As Double
          Dim txtAng As Double
          Dim PI As Double
          PI = Atn(1) * 4
          On Error Resume Next
          Dim strTemp, strTemp1, strTemp2 As String
          basePnt(0) = dCoords(0): basePnt(1) = dCoords(1): basePnt(2) = 0#
          nextPnt(0) = dCoords(2): nextPnt(1) = dCoords(3): nextPnt(2) = 0#
          strTemp1 = "Trassa E-"
          strTemp2 = "95"
          strTemp = strTemp1 & strTemp2
          Set rdText = ThisDrawing.ModelSpace.AddText(strTemp, basePnt, 0.5)
          txtAng = ThisDrawing.Utility.AngleFromXAxis(basePnt, nextPnt)
          Debug.Print txtAng
          If txtAng > PI * 0.5 And txtAng < PI * 1.5 Then
          txtAng = txtAng + PI
          Else: txtAng = txtAng
          End If
          rdText.Rotation = txtAng
          rdText.Alignment = acAlignmentBottomCenter
          rdText.TextAlignmentPoint = basePnt
          rdText.Update
          End If
          End Sub