VB.NET模拟CAD中的椭圆命令(drawjig)

snsj

1. Option Explicit Off    '隐式声明变量
   
2. Imports Autodesk.AutoCAD.ApplicationServices
   
3. Imports Autodesk.AutoCAD.DatabaseServices
   
4. Imports Autodesk.AutoCAD.EditorInput
   
5. Imports Autodesk.AutoCAD.Geometry
   
6. Imports Autodesk.AutoCAD.Runtime
   
7. Public Class AU_DrawJig
   
8.     Inherits Autodesk.AutoCAD.EditorInput.DrawJig
   
9.     Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
   
10.     Dim db As Database = HostApplicationServices.WorkingDatabase()         '将数据库作为公用函数
    
11.     Dim el_pt1, el_pt2, elcen As Point3d : Dim normal As Vector3d = Vector3d.ZAxis '椭圆的轴的两点和Z轴矢量
    
12.     Dim elent As Ellipse  '在内存中创建椭圆
    
13.     Dim ratio As Double '短轴与长轴的长度比例
    
14.     Dim czdst As Double '长半轴距离
    
15.     Dim vec As Vector2d : Dim ddd As Double : Dim elmaj, elmaj1 As Vector3d : Dim ang As Double
    
16.     Public Shared Function apple_polar3d(ByVal pPt As Point3d, ByVal dAng As Double, ByVal dDist As Double)
    
17.         Return New Point3d(pPt.X + dDist * Math.Cos(dAng), pPt.Y + dDist * Math.Sin(dAng), pPt.Z)
    
18.     End Function
    
19.     <CommandMethod("cc")> _
    
20. Public Sub DoJigA()
    
21.         '设置轴端点1
    
22.         Dim el_ptopt As PromptPointOptions = New PromptPointOptions(vbCrLf & "点取椭圆的轴端点<第一点>:")
    
23.         el_ptopt.AllowNone = True '允许回车/空格响应
    
24.         Dim respt As PromptPointResult = ed.GetPoint(el_ptopt) '开始动态取值
    
25.         If respt.Status = PromptStatus.Cancel Then '如果取消了就退出
    
26.             Return
    
27.         End If
    
28.         el_pt1 = respt.Value '设置椭圆轴端点1
    
29.         '设置轴端点2
    
30.         Dim el_ptopt1 As PromptPointOptions = New PromptPointOptions(vbCrLf & "点取椭圆的轴端点<第二点>:")
    
31.         el_ptopt1.AllowNone = True '允许回车/空格响应
    
32.         el_ptopt1.UseBasePoint = True
    
33.         el_ptopt1.BasePoint = el_pt1 '使用上一个点作为基点
    
34.         Dim respt1 As PromptPointResult = ed.GetPoint(el_ptopt1) '开始动态取值
    
35.         If respt1.Status = PromptStatus.Cancel Or el_pt1.DistanceTo(el_pt2) = 0 Then '如果取消了或两点距离为0就退出
    
36.             Return
    
37.         End If
    
38.         el_pt2 = respt1.Value '设置椭圆轴端点2
    
39.         elcen = New Point3d((el_pt1.X + el_pt2.X) / 2, (el_pt1.Y + el_pt2.Y) / 2, 0) '得到椭圆圆心，只取平面点，两点的中点
    
40.         elmaj = elcen.GetVectorTo(el_pt2) '长轴矢量,起点为圆心，中点为长轴的一个端点
    
41.         ratio = 0.0001 '短轴与长轴的长度比例
    
42.         czdst = el_pt1.DistanceTo(elcen)  '长轴一半的长度
    
43.         ddd = 0.000001
    
44.         el_pt12d = New Point2d(el_pt1.X, el_pt1.Y) : el_pt22d = New Point2d(el_pt2.X, el_pt2.Y)
    
45.         vec = el_pt12d - el_pt22d   '从A到B的向量
    
46.         ang = vec.Angle + Math.PI * 0.5 '角度
    
47.         elent = New Ellipse(Point3d.Origin, Vector3d.ZAxis, New Vector3d(0.000001, 0.0, 0.0), 1, 0.0, 0.0) '初始化椭圆
    
48.         'If SamplerStatus.Cancel Then
    
49.         Using trans As Transaction = db.TransactionManager.StartTransaction()
    
50.             Dim bt As BlockTable = DirectCast(trans.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)
    
51.             Dim btr As BlockTableRecord = DirectCast(trans.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
    
52.             Dim jigRes As PromptResult = ed.Drag(Me)  ' 开始拖动。
    
53.             If jigRes.Status = PromptStatus.OK Then
    
54.                 ' 将圆对象加入到图形数据库中。
    
55.                 btr.AppendEntity(elent)
    
56.                 trans.AddNewlyCreatedDBObject(elent, True)
    
57.                 trans.Commit()
    
58.             End If
    
59.         End Using
    
60.         'End If
    
61.     End Sub
    
62.     Protected Overrides Function Sampler(ByVal prompts As JigPrompts) As SamplerStatus
    
63.         Dim prOptions2 As New JigPromptDistanceOptions(vbLf & "点取生成椭圆/回车结束:")
    
64.         prOptions2.UseBasePoint = True
    
65.         prOptions2.BasePoint = elcen               '以椭圆圆心为基点
    
66.         prOptions2.Cursor = CursorType.NoSpecialCursor
    
67.         myPR = prompts.AcquireDistance(prOptions2) '得到一个距离DOUBLE
    
68.         curRat = myPR.Value
    
69.         If myPR.Status <> PromptStatus.Cancel Then
    
70.             If ddd = curRat Or ddd = 0 Then '数值不能为0
    
71.                 Return SamplerStatus.NoChange
    
72.             Else
    
73.                 If curRat <> 0 Then
    
74.                     ddd = curRat
    
75.                     ratio = Math.Abs(ddd / czdst) '一定要取绝对值，因为有可能出现负数
    
76.                     If ratio > 1 Then
    
77.                         elmaj1 = elcen.GetVectorTo(apple_polar3d(elcen, ang, ddd))
    
78.                         ratio = 1 / ratio
    
79.                         elent.Set(elcen, normal, elmaj1, ratio, 0, 2 * Math.PI)  '更新椭圆参数
    
80.                     Else
    
81.                         elent.Set(elcen, normal, elmaj, ratio, 0, 2 * Math.PI)  '更新椭圆参数
    
82.                     End If
    
83.                     Return SamplerStatus.OK
    
84.                 Else
    
85.                     Return SamplerStatus.NoChange
    
86.                 End If
    
87.             End If
    
88.         Else
    
89.             Return SamplerStatus.Cancel  '如果用户按ESC拖拽取消
    
90.         End If
    
91.     End Function
    
92.     Protected Overrides Function WorldDraw(ByVal draw As Autodesk.AutoCAD.GraphicsInterface.WorldDraw) As Boolean
    
93.         draw.Geometry.Draw(elent)
    
94.         Return True
    
95.     End Function
    
96. End Class
    

Option Explicit Off    '隐式声明变量<br /> Imports Autodesk.AutoCAD.ApplicationServices<br /> Imports Autodesk.AutoCAD.DatabaseServices<br /> Imports Autodesk.AutoCAD.EditorInput<br /> Imports Autodesk.AutoCAD.Geometry<br /> Imports Autodesk.AutoCAD.Runtime<br /> Public Class AU_DrawJig<br />     Inherits Autodesk.AutoCAD.EditorInput.DrawJig<br />     Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor<br />     Dim db As Database = HostApplicationServices.WorkingDatabase()         '将数据库作为公用函数<br />     Dim el_pt1, el_pt2, elcen As Point3d : Dim normal As Vector3d = Vector3d.ZAxis '椭圆的轴的两点和Z轴矢量<br />     Dim elent As Ellipse  '在内存中创建椭圆<br />     Dim ratio As Double '短轴与长轴的长度比例<br />     Dim czdst As Double '长半轴距离<br />     Dim vec As Vector2d : Dim ddd As Double : Dim elmaj, elmaj1 As Vector3d : Dim ang As Double<br />     Public Shared Function apple_polar3d(ByVal pPt As Point3d, ByVal dAng As Double, ByVal dDist As Double)<br />         Return New Point3d(pPt.X + dDist * Math.Cos(dAng), pPt.Y + dDist * Math.Sin(dAng), pPt.Z)<br />     End Function<br />     <CommandMethod("cc")> _<br /> Public Sub DoJigA()<br />         '设置轴端点1<br />         Dim el_ptopt As PromptPointOptions = New PromptPointOptions(vbCrLf & "点取椭圆的轴端点<第一点>:")<br />         el_ptopt.AllowNone = True '允许回车/空格响应<br />         Dim respt As PromptPointResult = ed.GetPoint(el_ptopt) '开始动态取值<br />         If respt.Status = PromptStatus.Cancel Then '如果取消了就退出<br />             Return<br />         End If<br />         el_pt1 = respt.Value '设置椭圆轴端点1<br />         '设置轴端点2<br />         Dim el_ptopt1 As PromptPointOptions = New PromptPointOptions(vbCrLf & "点取椭圆的轴端点<第二点>:")<br />         el_ptopt1.AllowNone = True '允许回车/空格响应<br />         el_ptopt1.UseBasePoint = True<br />         el_ptopt1.BasePoint = el_pt1 '使用上一个点作为基点<br />         Dim respt1 As PromptPointResult = ed.GetPoint(el_ptopt1) '开始动态取值<br />         If respt1.Status = PromptStatus.Cancel Or el_pt1.DistanceTo(el_pt2) = 0 Then '如果取消了或两点距离为0就退出<br />             Return<br />         End If<br />         el_pt2 = respt1.Value '设置椭圆轴端点2<br />         elcen = New Point3d((el_pt1.X + el_pt2.X) / 2, (el_pt1.Y + el_pt2.Y) / 2, 0) '得到椭圆圆心，只取平面点，两点的中点<br />         elmaj = elcen.GetVectorTo(el_pt2) '长轴矢量,起点为圆心，中点为长轴的一个端点<br />         ratio = 0.0001 '短轴与长轴的长度比例<br />         czdst = el_pt1.DistanceTo(elcen)  '长轴一半的长度<br />         ddd = 0.000001<br />         el_pt12d = New Point2d(el_pt1.X, el_pt1.Y) : el_pt22d = New Point2d(el_pt2.X, el_pt2.Y)<br />         vec = el_pt12d - el_pt22d   '从A到B的向量<br />         ang = vec.Angle + Math.PI * 0.5 '角度<br />         elent = New Ellipse(Point3d.Origin, Vector3d.ZAxis, New Vector3d(0.000001, 0.0, 0.0), 1, 0.0, 0.0) '初始化椭圆<br />         'If SamplerStatus.Cancel Then<br />         Using trans As Transaction = db.TransactionManager.StartTransaction()<br />             Dim bt As BlockTable = DirectCast(trans.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)<br />             Dim btr As BlockTableRecord = DirectCast(trans.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)<br />             Dim jigRes As PromptResult = ed.Drag(Me)  ' 开始拖动。<br />             If jigRes.Status = PromptStatus.OK Then<br />                 ' 将圆对象加入到图形数据库中。<br />                 btr.AppendEntity(elent)<br />                 trans.AddNewlyCreatedDBObject(elent, True)<br />                 trans.Commit()<br />             End If<br />         End Using<br />         'End If<br />     End Sub<br />     Protected Overrides Function Sampler(ByVal prompts As JigPrompts) As SamplerStatus<br />         Dim prOptions2 As New JigPromptDistanceOptions(vbLf & "点取生成椭圆/回车结束:")<br />         prOptions2.UseBasePoint = True<br />         prOptions2.BasePoint = elcen               '以椭圆圆心为基点<br />         prOptions2.Cursor = CursorType.NoSpecialCursor<br />         myPR = prompts.AcquireDistance(prOptions2) '得到一个距离DOUBLE<br />         curRat = myPR.Value<br />         If myPR.Status <> PromptStatus.Cancel Then<br />             If ddd = curRat Or ddd = 0 Then '数值不能为0<br />                 Return SamplerStatus.NoChange<br />             Else<br />                 If curRat <> 0 Then<br />                     ddd = curRat<br />                     ratio = Math.Abs(ddd / czdst) '一定要取绝对值，因为有可能出现负数<br />                     If ratio > 1 Then<br />                         elmaj1 = elcen.GetVectorTo(apple_polar3d(elcen, ang, ddd))<br />                         ratio = 1 / ratio<br />                         elent.Set(elcen, normal, elmaj1, ratio, 0, 2 * Math.PI)  '更新椭圆参数<br />                     Else<br />                         elent.Set(elcen, normal, elmaj, ratio, 0, 2 * Math.PI)  '更新椭圆参数<br />                     End If<br />                     Return SamplerStatus.OK<br />                 Else<br />                     Return SamplerStatus.NoChange<br />                 End If<br />             End If<br />         Else<br />             Return SamplerStatus.Cancel  '如果用户按ESC拖拽取消<br />         End If<br />     End Function<br />     Protected Overrides Function WorldDraw(ByVal draw As Autodesk.AutoCAD.GraphicsInterface.WorldDraw) As Boolean<br />         draw.Geometry.Draw(elent)<br />         Return True<br />     End Function<br /> End Class<br />