文字自动对齐自定义函数

vbcad

Public Sub AcadTextAlignment(o_Elements As Object, strAlignmentMode As String)
'将所选择的文字对齐,(o_Elements 为元素集合,strAlignmentMode 为对齐模式（如：左、中、右）
Dim SavePoint() As Double, SaveWidth
Dim tmpPoint() As Double, tmpWidth
Dim minPoint As Variant, maxPoint As Variant
Dim i As Long, j As Long
Dim nCount As Long
Dim AlignmentMode  As Long, MtxtAlignmentMode As Long
AlignmentMode = -1
MtxtAlignmentMode = -1
Select Case strAlignmentMode
    Case "左"
        AlignmentMode = 0
        MtxtAlignmentMode = 7
    Case "中"
        AlignmentMode = 1
        MtxtAlignmentMode = 8
    Case "右"
        AlignmentMode = 2
        MtxtAlignmentMode = 9
    Case "左上"
        AlignmentMode = 6
        MtxtAlignmentMode = 1
    Case "中上"
        AlignmentMode = 7
        MtxtAlignmentMode = 2
    Case "右上"
        AlignmentMode = 8
        MtxtAlignmentMode = 3
    Case "左中"
        AlignmentMode = 9
        MtxtAlignmentMode = 4
    Case "正中"
        AlignmentMode = 10
        MtxtAlignmentMode = 5
    Case "右中"
        AlignmentMode = 11
        MtxtAlignmentMode = 6
    Case "左下"
        AlignmentMode = 12
        MtxtAlignmentMode = 7
    Case "中下"
        AlignmentMode = 13
        MtxtAlignmentMode = 8
    Case "右下"
        AlignmentMode = 14
        MtxtAlignmentMode = 9
End Select
nCount = o_Elements.Count
For i = 0 To nCount - 1
    If InStr(o_Elements.Item(i).ObjectName, "Text") Then j = j + 1  '如果是文本
    If o_Elements.Item(i).ObjectName = "AcDbText" Then '如果是单行文本
'        j = j + 1
        tmpPoint = o_Elements.Item(i).InsertionPoint '获得插入点坐标
'        If AlignmentMode = -1 Then AlignmentMode = o_Elements.Item(i).Alignment '如果没有设置，则使用第一个对象的对齐方式
        If j = 1 Then '如果是第一个
            If AlignmentMode = 0 Then '左对齐
                o_Elements.Item(i).Alignment = AlignmentMode '设置对齐
                o_Elements.Item(i).InsertionPoint = tmpPoint
            End If
            SavePoint = tmpPoint
        Else
            tmpPoint(0) = SavePoint(0)
            If AlignmentMode = 0 Then
                o_Elements.Item(i).Alignment = AlignmentMode '设置对齐
                o_Elements.Item(i).InsertionPoint = tmpPoint
            End If
        End If
    End If
    If o_Elements.Item(i).ObjectName = "AcDbMText" Then '如果是多行文本
    End If
Next
End Sub

调用方法举例
    ' 创建新的选择集  
  Dim sset As AcadSelectionSet  
  Set sset = ThisDrawing.SelectionSets.Add("SS1")  
  ' 提示用户选择对象  
  ' 并将其添加到选择集中。  
  ' 要完成选择，请按回车键。
  sset.SelectOnScreen

'调用文字对齐函数
AcadTextAlignment sset,"左"

zzyong00

顶一下，
选择的时候，宜过滤一下