|
|
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,"左" |
|
置顶卡
