动态坐标标注，示例，附源码
本帖最后由 d1742647821 于 2023-6-12 11:14 编辑使用的ifoxcad类库，详见 https://gitee.com/inspirefunction/ifoxcad
一个简单的例子，给大家参考
演示效果
attach://125377.flv
public static class TestClass
{
private static string appName = "ZBBZ";
public static void ZBBZ()
{
var r1 = Env.Editor.GetPoint("\n选择标注位置");
if(r1.Status!=PromptStatus.OK)
return;
var pt1 = r1.Value.Ucs2Wcs();
var ml = new MLeader
{
LeaderLineType = LeaderType.StraightLeader,//引线格式-类型：直线
ContentType = ContentType.MTextContent,//内容-多重引线类型：多行文字
TextAttachmentType = TextAttachmentType.AttachmentBottomOfTopLine//连接位置：第一行加下划线
};
ml.SetDatabaseDefaults();
ml.SetTextAttachmentType(TextAttachmentType.AttachmentBottomOfTopLine, LeaderDirectionType.LeftLeader);
ml.SetTextAttachmentType(TextAttachmentType.AttachmentBottomOfTopLine, LeaderDirectionType.RightLeader);
ml.Annotative = AnnotativeStates.False;
ml.EnableDogleg = false;//水平基线：否
ml.DoglegLength = 50;
var n1 = ml.AddLeader();
var n2 = ml.AddLeaderLine(n1);
ml.AddFirstVertex(n2, pt1);
ml.AddLastVertex(n2, pt1+new Vector3d(1000,1000,0));
var text = new MText
{
Contents = GetBzStr(pt1),
LineSpacingStyle = LineSpacingStyle.Exactly,
LineSpacingFactor = 1
};
//text.Location = tagPoint;
ml.MText = text;
ml.TextHeight = 300;
ml.SetDogleg(0, Vector3d.XAxis);
ml.TextAngleType = TextAngleType.HorizontalAngle;
ml.TextAlignmentType = TextAlignmentType.LeftAlignment;
using var tr = new DBTrans();
tr.CurrentSpace.AddEntity(ml);
tr.RegAppTable.Add(appName);
ml.XData=new XDataList(){{1001,appName},{1000,GetBzStr(pt1)}};
}
/// <summary>
/// 添加事件
/// </summary>
public static void AddEvent()
{
Env.Database.ObjectModified -= Database_ObjectModified;
Env.Database.ObjectModified += Database_ObjectModified;
}
/// <summary>
/// 移除事件
/// </summary>
public static void RemoveEvent()
{
Env.Database.ObjectModified -= Database_ObjectModified;
}
private static void Database_ObjectModified(object sender, ObjectEventArgs e)
{
var db = (Database)sender;
if(e.DBObject is not MLeader ml || ml.GetXDataForApplication(appName) is not{} rb)
return;
string? oldBz = null;
foreach (var tv in rb)
{
if (tv.TypeCode == 1000)
oldBz = tv.Value.ToString();
}
if(oldBz is null)
return;
var newBz = GetBzStr(ml.GetFirstVertex(0));
if(newBz==oldBz)
return;
db.ObjectModified -= Database_ObjectModified;
try
{
var mt = (MText)ml.MText.Clone();
mt.Contents = newBz;
using (ml.ForWrite())
{
ml.MText=mt;
}
}
finally
{
db.ObjectModified += Database_ObjectModified;
}
}
private static string GetBzStr(Point3d pt)
{
return "X="+ pt.X.ToString("0.00")+"\\PY="+pt.Y.ToString("0.00");
}
}
顺便贴一下B站主页，里面发了一些教学视频，感谢支持
https://space.bilibili.com/1848261995
pmq 发表于 2023-3-1 19:23
谢谢楼主分享，有没有vb.net 的，C#的看不懂
用 https://converter.telerik.com/ 转换不了。
我也是初学用vb.net做二开，参照楼主的思想和代码改写了一个简化的vb..net代码，但不知道怎么回事，在该对象的modified事件中，不能修改文本值，有高手知道的指点一下。
改写的这个VB.net代码实现模拟拖放mleader。但不能修改坐标值。
Private Sub CmdCoordMark_Click(sender As Object, e As EventArgs) Handles CmdCoordDim.Click
Dim acDoc As Autodesk.AutoCAD.ApplicationServices.Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
Dim acCurDb As Database = acDoc.Database
Dim acDocEd As Autodesk.AutoCAD.EditorInput.Editor = acDoc.Editor
Dim acBlkTbl As BlockTable
Dim acBlkTblRec As BlockTableRecord
Using aclckdoc As DocumentLock = acDoc.LockDocument
Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
acBlkTbl = CType(acTrans.GetObject(acCurDb.BlockTableId, OpenMode.ForRead), BlockTable)
acBlkTblRec = CType(acTrans.GetObject(acBlkTbl(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord)
Dim retStPoint As PromptPointResult = acDocEd.GetPoint(vbLf & "请选择要标注坐标的点：")
If retStPoint.Status = PromptStatus.OK Then
Else
Exit Sub
End If
Dim pt11 As New Point3d(retStPoint.Value.X, retStPoint.Value.Y, 0)
'得到第二个点的坐标
'第二点的坐标在第一个坐标的基础上加上一个增量。用来实现leader的拖放，
'如不这样做, 则需要第二个点才能进行拖放, 在选中第一个点和准备选中第二个点的的时间差，mleader是没有显示出来，影响效果。
Dim pt22 As New Point3d(retStPoint.Value.X + 0.1, retStPoint.Value.Y + 0.1, 0)
'设置字体
Dim acTextStyleTblRec As TextStyleTableRecord = acTrans.GetObject(acCurDb.Textstyle, OpenMode.ForWrite)
Dim acFont As Autodesk.AutoCAD.GraphicsInterface.FontDescriptor = acTextStyleTblRec.Font
Dim acNewFont As Autodesk.AutoCAD.GraphicsInterface.FontDescriptor
acNewFont = New Autodesk.AutoCAD.GraphicsInterface.FontDescriptor("仿宋", False, False, acFont.CharacterSet, acFont.PitchAndFamily)
acTextStyleTblRec.Font = acNewFont
'建立多文本
Dim text As New MText
text.Contents = GetBzStr(pt11) '传递第一个点的坐标进行内容变换，注意，本示例代码中，在测绘领域，Cad的X坐标代表的北向。
text.LineSpacingStyle = LineSpacingStyle.Exactly
text.LineSpacingFactor = 0.84
'创建多重引线
Dim m1 As New MLeader
m1.LeaderLineType = LeaderType.StraightLeader '直引线
m1.ContentType = ContentType.MTextContent
m1.TextAttachmentType = TextAttachmentType.AttachmentBottomOfTopLine '1连接位置：第一行加下划线
m1.SetDatabaseDefaults()
Dim n1 As Integer = m1.AddLeader()
Dim n2 As Integer = m1.AddLeaderLine(n1)
m1.AddFirstVertex(n1, pt11)
m1.AddLastVertex(n2, pt22)
m1.MText = text
m1.TextHeight = 1
m1.ColorIndex = 3
m1.ArrowSize = 0.5
m1.DoglegLength = 0 '基线为0
m1.LandingGap = 1 '基线与文字的间距为1
'' 添加新对象到模型空间和事务中 Add the new object to Model space and the transaction
Dim entNow As List(Of Entity) = New List(Of Entity) From {m1} '使用对象列表，本示例中只有一个对象，你也可以改写为直接使用mleader
'调用mleader拖放类
Dim jigentity As PubMleaderJig = New PubMleaderJig(entNow, New Point3d(retStPoint.Value.X, retStPoint.Value.Y, 0), New Point3d(pt22.X, pt22.Y, 0))
'在确定具体位置后，把该对象放入数据库中。
Dim prs As PromptResult = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor.Drag(jigentity)
If prs.Status = PromptStatus.OK Then
If prs.Status = PromptStatus.OK Then
Dim enti As Entity
For Each enti In jigentity.ent
acBlkTblRec.AppendEntity(enti)
acTrans.AddNewlyCreatedDBObject(enti, True)
AddHandler enti.Modified, AddressOf entiModified '添加该对象的修改事件
Next
End If
End If
acTrans.Commit()
End Using
End Using
End Sub
'对象修改事件，根据楼主的代码改字的
Private Sub entiModified(ByVal senderObj As Object, ByVal evtArgs As EventArgs)
Dim m As MLeader = CType(senderObj, MLeader)
Dim mt As MText = m.MText.Clone
mt.Contents = GetBzStr(m.GetFirstVertex(0))
m.UpgradeOpen() '对象可写
m.MText = mt '这句没有运行，不知道为什么，还差什么语句
End Sub
拖放类
Public Class PubMleaderJig
'该类专为Mleader拖放使用
Inherits DrawJig
Public SecondMovePt As Point3d '定义第二个插入点
Public FirstMovePt As Point3d '定义第一个插入点
Public ent As List(Of Entity) '定义多实体对象
'构造函数
Public Sub New(ByVal nents As List(Of Entity), ByVal MovePt1 As Point3d, ByVal movePt2 As Point3d)
'MovePt2为第二个点。movePt1为第一个点,
MyBase.New()
SecondMovePt = movePt2
FirstMovePt = MovePt1
ent = nents
End Sub
'检测鼠标的移动量
Protected Overrides Function Sampler(prompts As JigPrompts) As SamplerStatus
Dim psr As PromptPointResult = prompts.AcquirePoint '接收当前鼠标点的坐标
If psr.Status = PromptStatus.OK Then '确认用户点击了左键
Dim MovePtNow As Point3d = psr.Value '当前鼠标点的坐标赋值给一个新变量
'鼠标的坐标以第二个点为准移动。
If (MovePtNow <> SecondMovePt) And MovePtNow.DistanceTo(SecondMovePt) > 0.000001 Then '判断当前鼠标的坐标与原来的坐标值是否不一样，同时相差值不能小于0.000001
Dim vector3d As Vector3d = SecondMovePt.GetVectorTo(MovePtNow) '把原来坐标点转换为顶点值
Dim matrix As Matrix3d = Matrix3d.Displacement(vector3d) '
ent.ForEach(Sub(x) x.TransformBy(matrix)) '使用lambda转换对象的位置
SecondMovePt = MovePtNow '把当前的鼠标值赋给保存旧坐标值的变量
'保持原来第一个点的坐标的值为选中点的坐标
Dim initpoint As MLeader = CType(ent(0), MLeader)
initpoint.SetFirstVertex(0, FirstMovePt)
Return SamplerStatus.OK
Else
Return SamplerStatus.NoChange
End If
Return SamplerStatus.Cancel
End If
End Function
Protected Overrides Function WorldDraw(draw As GraphicsInterface.WorldDraw) As Boolean
For Each entt In ent
draw.Geometry.Draw(entt) '重绘所有图形
Next
Return True
End Function
End Class pmq 发表于 2023-3-1 19:23
谢谢楼主分享，有没有vb.net 的，C#的看不懂
用 https://converter.telerik.com/ 转换不了。
没有 谢谢楼主分享，有没有vb.net 的，C#的看不懂
用 https://converter.telerik.com/ 转换不了。 资瓷一下。 有没有编译好的？ 啊，帅！！！ 资瓷一下，小白666666 好，顶，赞 赞赞赞。。。。太好了，学习的好资料 很不错的示例，学习了 感谢楼主分享 厉害厉害！！！！！！！！
页:
[1]
2