怎么编写一个动态库,实现图片所示功能
网友答: 那位大神指导一下,如果效果不错,能分享代码的,付费网友答: 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
网友答: 那位大神指导一下,如果效果不错,能分享代码的,付费网友答: 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