AutoCAD VBA文字自动对齐操作

Public Type TextWithPnt
    Index As Long
    TextObj As AcadText
    PntIntX As Double
    PntIntY As Double
    PntLeftX As Double
    PntMidX As Double
    PntRigX As Double
End Type
Public OrgTexts() As TextWithPnt
Public Function CreateSSet(Optional SS As String = "mjtd") As AcadSelectionSet
    On Error Resume Next
    ThisDrawing.SelectionSets(SS).Delete
    Set CreateSSet = ThisDrawing.SelectionSets.Add(SS)
End Function
Public Sub BuildFilter(typeArray, dataArray, ParamArray gCodes())
    Dim fType() As Integer, fData()
    Dim Index As Long, i As Long
    Index = LBound(gCodes) - 1
    For i = LBound(gCodes) To UBound(gCodes) Step 2
        Index = Index + 1
        ReDim Preserve fType(0 To Index)
        ReDim Preserve fData(0 To Index)
        fType(Index) = CInt(gCodes(i))
        fData(Index) = gCodes(i + 1)
    Next
End Sub
Public Function ssExtents(SS As AcadSelectionSet) As Variant
    Dim Points(), C As Long
    Dim Min As Variant, Max As Variant
    Dim i As Long, j As Long
    C = 0
    For i = 0 To SS.count - 1
        SS.Item(i).GetBoundingBox Min, Max
        ReDim Preserve Points(0 To C + 1)
        Points(C) = Min: Points(C + 1) = Max
        C = C + 2
    Next
    ssExtents = Extents(Points)
End Function
Public Function Extents(Points)
    Dim Min As Variant, Max As Variant
    Dim i As Long, j As Long, Pt, RetVal(0 To 1)
    Min = Points(LBound(Points))
    Max = Points(LBound(Points))
    For i = LBound(Points) To UBound(Points)
        Pt = Points(i)
        For j = LBound(Pt) To UBound(Pt)
            If Pt(j) < Min(j) Then Min(j) = Pt(j)
            If Pt(j) > Max(j) Then Max(j) = Pt(j)
        Next
    Next
    RetVal(0) = Min: RetVal(1) = Max
    Extents = RetVal
End Function