• Industries
  • Products
  • Buy
  • Services & Support
  • Communities
  • Discussion Groups

    .NET

    Reply
    Distinguished Contributor
    JamieVJohnson2
    Posts: 143
    Registered: ‎08-26-2010

    Align Text and other things

    111 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
    Please use plain text.