'***********************************************************************************************
'根据给定矩形区域填充文字(即使文字充满矩形框，根据文字内容自动调整文字高度)********************************
' P1和P2 为矩形框的两个对角点,A文字的角度(只接受0、90、270三个角度)
Public Function 文字填充模块(ByVal Txt As String, ByVal P1 As Variant, P2 As Variant, A As Double)
Dim 文字 As AcadText
Dim 文字高度 As Double
Dim 文字长度 As Double
Dim 矩形框长度 As Double
Dim 矩形框高度 As Double
Dim 中点1(2) As Double
Dim 角点1 As Variant, 角点2 As Variant
If Abs(P1(0) - P2(0)) = 0 Or Abs(P1(1) - P2(1)) = 0 Then Exit Function
If A = 0 Then
矩形框长度 = Abs(P1(0) - P2(0))
矩形框高度 = Abs(P1(1) - P2(1))
Else
矩形框长度 = Abs(P1(1) - P2(1))
矩形框高度 = Abs(P1(0) - P2(0))
End If
中点1(0) = (P1(0) + P2(0)) / 2
中点1(1) = (P1(1) + P2(1)) / 2
中点1(2) = (P1(2) + P2(2)) / 2
Set 文字 = ThisDrawing.ModelSpace.AddText(Txt, Point3D(0, 0, 0), 2.5)
文字.GetBoundingBox 角点1, 角点2
文字长度 = Abs(角点1(0) - 角点2(0))
文字高度 = Abs(角点1(1) - 角点2(1))
If 矩形框长度 / 文字长度 <= 矩形框高度 / 文字高度 Then
文字.ScaleEntity 角点1, 矩形框长度 / 文字长度
Else
文字.ScaleEntity 角点1, 矩形框高度 / 文字高度
End If
文字.Alignment = acAlignmentMiddleCenter
文字.Move 文字.TextAlignmentPoint, 中点1
文字.Rotate 中点1, A * Atn(1) * 4 / 180
End Function