怎样用VB.NET实现动态文字对齐

hao2913941

怎么编写一个动态库，实现图片所示功能

hao2913941

那位大神指导一下，如果效果不错，能分享代码的，付费

pmq

    Public Sub AlignTextDynamic()
        Dim doc As Document = Application.DocumentManager.MdiActiveDocument
        Dim db As Database = doc.Database
        Dim ed As Editor = doc.Editor
      
        Dim pso As New PromptSelectionOptions With {
            .MessageForAdding = "选择要对齐的单行文字:"
        }
        Dim filter As New SelectionFilter({New TypedValue(DxfCode.Start, "TEXT")})
        Dim psr As PromptSelectionResult = ed.GetSelection(pso, filter)
        If psr.Status <> PromptStatus.OK Then Return

        Dim textIds = psr.Value.GetObjectIds()
        
        Dim ppr1 As PromptPointResult = ed.GetPoint("指定对齐点:")
        If ppr1.Status <> PromptStatus.OK Then Return
        Dim basePt As Point3d = ppr1.Value
        
        Dim jig As New TextAlignJig(textIds, basePt)
        Dim res As PromptResult = ed.Drag(jig)

        If res.Status = PromptStatus.OK Then
            
            jig.Update()
        End If
    End Sub
End Class

' 自定义Jig类，实现动态对齐
Public Class TextAlignJig
    Inherits DrawJig

    Private ReadOnly _textIds As ObjectId()
    Private _basePt As Point3d
    Private _currentPt As Point3d
    Private ReadOnly _alignedPts As List(Of Point3d)

    Public Sub New(textIds As ObjectId(), basePt As Point3d)
        _textIds = textIds
        _basePt = basePt
        _currentPt = basePt
        _alignedPts = New List(Of Point3d)
    End Sub

    Protected Overrides Function Sampler(prompts As JigPrompts) As SamplerStatus
        Dim ppo As New JigPromptPointOptions(vbLf & "指定参考对齐直线的第二点:") With {
            .UseBasePoint = True,
            .BasePoint = _basePt
        }
        Dim ppr As PromptPointResult = prompts.AcquirePoint(ppo)
        If ppr.Status = PromptStatus.Cancel Then
            Return SamplerStatus.Cancel
        End If
        If ppr.Value = _currentPt Then
            Return SamplerStatus.NoChange
        End If
        _currentPt = ppr.Value
        Return SamplerStatus.OK
    End Function

    Protected Overrides Function WorldDraw(draw As Autodesk.AutoCAD.GraphicsInterface.WorldDraw) As Boolean
        
        Dim lineVec As Vector3d = _currentPt - _basePt
        If lineVec.Length = 0 Then Return True

         draw.Geometry.WorldLine(_basePt, _currentPt)

        _alignedPts.Clear()
        Using tr As Transaction = Application.DocumentManager.MdiActiveDocument.Database.TransactionManager.StartTransaction()
            For Each id In _textIds
                Dim txt As DBText = CType(tr.GetObject(id, OpenMode.ForRead), DBText)
                Dim oldPt As Point3d = txt.Position
               
                Dim projPt As Point3d = ProjectPointToLine(oldPt, _basePt, lineVec)
                _alignedPts.Add(projPt)
               
                Dim txtCopy As New DBText()
                txtCopy.SetDatabaseDefaults()
                txtCopy.Position = projPt
                txtCopy.TextString = txt.TextString
                txtCopy.Height = txt.Height
                txtCopy.Rotation = txt.Rotation
                draw.Geometry.Draw(txtCopy)
            Next
            tr.Commit()
        End Using
        Return True
    End Function

    Private Function ProjectPointToLine(pt As Point3d, basePt As Point3d, lineVec As Vector3d) As Point3d
      
        Dim AP As Vector3d = pt - basePt
        Dim t As Double = AP.DotProduct(lineVec) / lineVec.LengthSqrd
        Dim proj As Point3d = basePt + lineVec.MultiplyBy(t)

        Return proj

    End Function

    Public Function Update() As Boolean
        
        Using tr As Transaction = Application.DocumentManager.MdiActiveDocument.Database.TransactionManager.StartTransaction()
            For i = 0 To _textIds.Length - 1
                Dim txt As DBText = CType(tr.GetObject(_textIds(i), OpenMode.ForWrite), DBText)
                txt.Position = _alignedPts(i)
            Next
            tr.Commit()
        End Using
        Return True
    End Function

End Class