vbcad 发表于 2014-11-19 11:16:40

文字自动对齐自定义函数

本帖最后由 vbcad 于 2014-11-19 11:22 编辑


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 AlignmentModeAs 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 发表于 2014-11-21 07:33:14

顶一下，
选择的时候，宜过滤一下
页: [1]
查看完整版本: 文字自动对齐自定义函数