- 积分
- 2866
- 明经币
- 个
- 注册时间
- 2012-4-27
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
发表于 2024-12-13 11:32:52
|
显示全部楼层
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 |
|