在矩形的中点创建多行文字

Option Explicit
Public Sub DrawTextInRectangle()
    Dim pnt1 As Variant, pnt2 As Variant
    Dim ctr(0 To 2) As Double, ht As Double
    Dim newText As AcadText
    Dim strText As String
    Dim intTextHeight As Integer
    
    strText = "THIS SPACE FOR RENT"
    
    intTextHeight = 10
    If getPoints1(pnt1, pnt2) = 0 Then
        Rectangle pnt1, pnt2
        ' Now add text at the midpoint of the rectangle...
        ctr(0) = (pnt1(0) + pnt2(0)) / 2
        ctr(1) = (pnt1(1) + pnt2(1)) / 2
        ctr(2) = (pnt1(2) + pnt2(2)) / 2
        ht = Abs(pnt1(1) - pnt2(1)) / 2
        
        Set newText = ThisDrawing.ModelSpace.AddText(UCase(strText), ctr, intTextHeight)
        newText.Alignment = 4
        newText.TextAlignmentPoint = ctr
        newText.StyleName = "Standard"
        newText.Update
    End If
End Sub
' From Frank Oquendo
Private Function Rectangle(Point1, Point2) As AcadLWPolyline
    Dim vertices(0 To 7) As Double, pl As AcadLWPolyline
    vertices(0) = CDbl(Point1(0)): vertices(1) = CDbl(Point1(1))
    vertices(2) = CDbl(Point2(0)): vertices(3) = CDbl(Point1(1))
    vertices(4) = CDbl(Point2(0)): vertices(5) = CDbl(Point2(1))
    vertices(6) = CDbl(Point1(0)): vertices(7) = CDbl(Point2(1))
    Set pl = ThisDrawing.ModelSpace.AddLightWeightPolyline(vertices)
    pl.Closed = True
    Set Rectangle = pl
End Function
Private Function getPoints1(pt1 As Variant, pt2 As Variant) As Integer
' This sub returns two points, or an error flag if cancelled
   On Error Resume Next
   pt1 = ThisDrawing.Utility.GetPoint(, "Specify first corner:")
   If Err Then
      getPoints1 = -1
      Exit Function
   End If
   pt2 = ThisDrawing.Utility.GetCorner(pt1, "Specify opposite corner:")
   If Err Then
      getPoints1 = -1
      Exit Function
   End If
   On Error GoTo 0
End Function