<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 Sub
Supporting 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 Function
I'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