.NET

Reply
Mentor
JamieVJohnson2
Posts: 165
Registered: ‎08-26-2010
Message 1 of 1 (193 Views)

Align Text and other things

193 Views, 0 Replies
12-07-2012 02:10 PM
<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

jvj

You are not logged in.

Log into access your profile, ask and answer questions, share ideas and more. Haven't signed up yet? Register

Announcements
Are you familiar with the Autodesk Expert Elites? The Expert Elite program is made up of customers that help other customers by sharing knowledge and exemplifying an engaging style of collaboration. To learn more, please visit our Expert Elite website.

Need installation help?

Start with some of our most frequented solutions to get help installing your software.

Ask the Community