如何在命令中交互绘制多段线
请问下高手们，怎样才能在自己编写的命令中交互绘制多段线（像pl命令一样，可以回退、闭合等）呢？本帖最后由 你有种再说一遍 于 2024-10-31 00:48 编辑
Jig内容呀,只需要添加关键字,
u就是撤回,撤回就是队列上面移除,
c就是闭合,
这些IFox内都封装好了...
https://gitee.com/inspirefunctio ... stShared/TestJig.cs
还是最美的几个封装之一,
让你不再写继承,而是通过队列和委托实现定义.
你有种再说一遍 发表于 2024-10-31 00:18
Jig内容呀,只需要添加关键字,
u就是撤回,撤回就是队列上面移除,
c就是闭合,
我通过其他方式已经解决了，jig没接触过，对我来说还是有点难{:1_1:} changyiran 发表于 2024-10-31 10:42
我通过其他方式已经解决了，jig没接触过，对我来说还是有点难
新人最忌讳的就是没有摸全再干,要通过一个个测试慢慢摸会 changyiran 发表于 2024-10-31 10:42
我通过其他方式已经解决了，jig没接触过，对我来说还是有点难
怎么实现的，厉害 羊羊羊 发表于 2024-11-30 17:42
怎么实现的，厉害
不用jip.是不是 选择点时从前点 拉出一根线 论坛有案例
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=187087&extra=page%3D1%26filter%3Dtypeid%26typeid%3D32 Public Class MyPlineCmds
<CommandMethod("MYPOLY")> _
Public Sub MyPoly()
'定义AutoCAD的文档对象(net)'获取当前文件
acDoc = AppAcad.DocumentManager.MdiActiveDocument
'获得当前文档的编辑器(Net)'获取当前命令行对象
acEdit = acDoc.Editor
'得到当前文档图形数据库
Dim db As Database = HostApplicationServices.WorkingDatabase
'原始点(绘制橡皮线的基点)
Dim OldPoint As New Point2d
'拾取的当前点
Dim curPoint As New Point2d
' Get the current UCS
Dim ucs As Matrix3d = acEdit.CurrentUserCoordinateSystem
Dim origin As New Point3d(0, 0, 0)
Dim normal As New Vector3d(0, 0, 1)
normal = normal.TransformBy(ucs)
'Create a temporary plane
Dim plane As New Plane(origin, normal)
' Get the current color
Dim col As Color = acDoc.Database.Cecolor
'定义一个点拖动交互类
Dim PointOpt As New PromptPointOptions("")
'Dim PointOpt As New PromptPointOptions(vbLf & "Select polyline vertex: ")
'允许输入空值（未选择直接按回车键）
PointOpt.AllowNone = True
'.Keywords.Add("Undo", "Undo", "放弃(U)")
'.Keywords.Add("U", "U", "撤回(U)")
Dim acPoly As New Polyline
Do
If acPoly.NumberOfVertices = 0 Then
'当acPoly图元还未创建时，只需询问起点即可
PointOpt.Message = vbLf & "指定起点[退出<esc>]:"
'关闭绘制一条橡皮线.不然从原点会拉出橡皮线
PointOpt.UseBasePoint = False
ElseIf acPoly.NumberOfVertices > 0 Then
'当acPoly图元已存在时，从老点拉出橡皮线
PointOpt.SetMessageAndKeywords(vbLf & "指定下一点或 [放弃(U)]: ", "U")
'UseBasePoint和BasePoint属性控制是否从基点绘制一条橡皮线
PointOpt.UseBasePoint = True
'设置拖动光标基点
PointOpt.BasePoint = New Point3d(OldPoint.X, OldPoint.Y, 0)
End If
'在CAD图中拾取点坐标
Dim PointRes As PromptPointResult = acEdit.GetPoint(PointOpt)
curPoint = PointRes.Value.Convert2d(New Plane)
'如果用户按了 ESC 键或取消了命令就退出
If PointRes.Status = PromptStatus.None Or PointRes.Status = PromptStatus.Cancel Then
Exit Do
End If
'当点被选择到的OK状态
If PointRes.Status = PromptStatus.OK Then
'当acPoly图元已经存在时
If acPoly.NumberOfVertices >= 1 Then
'启动一个事务
Using Trans As Transaction = db.TransactionManager.StartTransaction()
'升级图元对象为可写
acPoly.UpgradeOpen()
Dim Ncount As Integer = acPoly.NumberOfVertices
acPoly.AddVertexAt(Ncount, curPoint, 0, 0, 0)
Trans.Commit() ''提交事务处理以实现真实
End Using
OldPoint = curPoint
End If
'当acPoly图元不存在时
If acPoly.NumberOfVertices = 0 Then
''在内存中创建多段线<polyline>
acPoly = New Polyline()
acPoly.SetDatabaseDefaults()
acPoly.AddVertexAt(0, curPoint, 0, 0, 0)
'调用AppendEntity函数，将图形对象加入到模型空间.
Call AppendEntity(acPoly)
OldPoint = curPoint
End If
End If
'当点选获取了用户输入关键字时
If PointRes.Status = PromptStatus.Keyword Then
If PointRes.StringResult.ToUpper = "U" Then
'启动一个事务，根据 ObjectId 得到 DBobject
Using Trans As Transaction = db.TransactionManager.StartTransaction()
'升级图元对象为可写
acPoly.UpgradeOpen()
Dim Ncount As Integer = acPoly.NumberOfVertices
If Ncount >= 2 Then
acPoly.RemoveVertexAt(Ncount - 1)
End If
Trans.Commit() '提交事务处理以实现真实
End Using
OldPoint = acPoly.GetPoint2dAt(acPoly.NumberOfVertices - 1)
End If
End If
Loop
acEdit.Regen()
End Sub
End Class 上面的代码是我自己琢磨出来的，没有用jip，只用了 PointOpt.UseBasePoint = true 从原点会拉出橡皮线。希望对大家有帮助。 羊羊羊 发表于 2024-12-13 11:36
上面的代码是我自己琢磨出来的，没有用jip，只用了 PointOpt.UseBasePoint = true 从原点会拉出橡皮线。希 ...
阿羊怎么还在敲VB,是时候来学IFox了,大把函数都已经敲好了,各种优美封装...
页:
[1]
2