<CommandMethod("AlignText")> _
Public Shared Sub AlignText()
'pick 2 points, then select text entities, then align all text based on their insertion points.
Try
Dim doc As Document = AApplication.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Using lock As DocumentLock = doc.LockDocument()
Using trans As Transaction = db.TransactionManager.StartTransaction
Dim pso As New PromptSelectionOptions
pso.MessageForAdding = "Select text, mtext, mleader, or blocks to align:"
pso.MessageForRemoval = "Remove object:"
pso.AllowDuplicates = False
pso.SingleOnly = False
Dim psr As PromptSelectionResult = doc.Editor.GetSelection(pso)
If psr.Status = PromptStatus.OK Then
Dim dbtextEnts As New List(Of DBText)
Dim brEnts As New List(Of BlockReference)
Dim mtextEnts As New List(Of MText)
Dim mLeaderEnts As New List(Of MLeader)
'look for text,mtext,mleader, or blocks in the selection set
For i As Integer = 0 To psr.Value.Count - 1
Dim so As Autodesk.AutoCAD.EditorInput.SelectedObject = psr.Value(i)
Dim ent As Entity = trans.GetObject(so.ObjectId, OpenMode.ForWrite)
If TypeOf ent Is BlockReference Then
Dim br As BlockReference = ent
brEnts.Add(ent)
ElseIf TypeOf ent Is MText Then
Dim mt As MText = ent
mtextEnts.Add(mt)
ElseIf TypeOf ent Is DBText Then
Dim dtext As DBText = ent
dbtextEnts.Add(dtext)
ElseIf TypeOf ent Is MLeader Then
Dim ml As MLeader = ent
mLeaderEnts.Add(ml)
End If
Next
'get 2 points to define a line
Dim point1 As Point3d
Dim point2 As Point3d
point1 = UserGetPoint("Select first point of reference line:", doc)
point2 = UserGetPointWithBasePoint(point1, "Select second point of reference line:", doc)
Dim line As New Line(point1, point2)
'calculate the perpendicular distance between each objects insertion point and this line
Dim newPoint As Point3d
Dim mMove As New Matrix3d
For Each dtext As DBText In dbtextEnts
newPoint = FindPointPerpendicularToLine(line, dtext.Position)
mMove = New Matrix3d
mMove = Matrix3d.Displacement(dtext.Position.GetVectorTo(newPoint))
dtext.TransformBy(mMove)
Next
For Each br As BlockReference In brEnts
newPoint = FindPointPerpendicularToLine(line, br.Position)
mMove = New Matrix3d
mMove = Matrix3d.Displacement(br.Position.GetVectorTo(newPoint))
br.TransformBy(mMove)
Next
For Each mt As MText In mtextEnts
newPoint = FindPointPerpendicularToLine(line, mt.Location)
mMove = New Matrix3d
mMove = Matrix3d.Displacement(mt.Location.GetVectorTo(newPoint))
mt.TransformBy(mMove)
Next
For Each ml As MLeader In mLeaderEnts
Dim basePoint As Point3d
Select Case ml.ContentType
Case ContentType.BlockContent
basePoint = ml.BlockPosition
newPoint = FindPointPerpendicularToLine(line, ml.BlockPosition)
Case ContentType.MTextContent
basePoint = ml.TextLocation
newPoint = FindPointPerpendicularToLine(line, ml.TextLocation)
End Select
mMove = New Matrix3d
mMove = Matrix3d.Displacement(basePoint.GetVectorTo(newPoint))
ml.MoveMLeader(mMove.Translation, MoveType.MoveContentAndDoglegPoints)
ml.recomputeBreakPoints()
Next
End If
trans.Commit()
End Using
End Using
doc = Nothing
db = Nothing
Catch ex As System.Exception
MsgBox(ex.ToString)
End Try
End SubSupporting routines:
Public Function UserGetPoint(ByRef strMessage As String, ByRef doc As Document) As Point3d
Autodesk.AutoCAD.Internal.Utils.SetFocusToDwgView()
Dim point As Point3d = Nothing
Dim ppr As PromptPointResult
ppr = doc.Editor.GetPoint(strMessage)
If ppr.Status = PromptStatus.OK Then
point = New Point3d(ppr.Value.ToArray)
End If
doc.Editor.WriteMessage(vbCrLf)
Return point
End Function
Public Function UserGetPointWithBasePoint(ByRef basePoint As Point3d, ByRef strMessage As String, ByRef doc As Document) As Point3d
Autodesk.AutoCAD.Internal.Utils.SetFocusToDwgView()
Dim point As Point3d = Nothing
Dim ppr As PromptPointResult
Dim ppo As New PromptPointOptions(strMessage)
ppo.BasePoint = basePoint
ppo.UseBasePoint = True
ppo.UseDashedLine = False
ppo.AllowNone = False
ppr = doc.Editor.GetPoint(ppo)
If ppr.Status = PromptStatus.OK Then
point = New Point3d(ppr.Value.ToArray)
End If
doc.Editor.WriteMessage(vbCrLf)
Return point
End Function More supporting routines:
Public Function FindPointPerpendicularToLine(ByRef line As Line, ByVal basePoint As Point3d) As Point3d
Dim pReturn As Point3d = line.GetClosestPointTo(basePoint, True)
Return pReturn
End FunctionI've gotten a bit tired of searching for the illusive align text command I remember over a decade ago, and maybe it was a custom routine even back then, so I created one that works for my needs and am posting it here. This command works on DBText (text), MText, Blocks, and MLeaders by aligning only the insertion/position points perpendicular to a line you pick (with 2 points).
This is my first attempt to write code for MLeader objects, so be nice.
I post this for prosperity, so if you think it needs any improvements feel free to let me know. If you want to 'steel' it go ahead, (HINT HINT Autodesk, this should be easily found in all annotative programs).
jvj
jvj
