AutoCAD VBNET 获取曲线在3个基本平面的投影

autocad,vbnet,获取,曲线,基本,平面,投影 · 浏览次数 : 5

小编点评

**空间任意曲线在xoy/yoz/xoz平面的投影方法** 该方法根据用户坐标系将空间任意曲线投影到xoy/yoz/xoz平面上。 **步骤：** 1. 获取当前文档的数据库和编辑器。 2. 检查用户坐标系是否为“1”。如果不是，设置当前用户坐标系为单位矩阵。 3. 获取用户选择的曲线。 4. 创建投影的平面。 5. 创建曲线在每个平面的投影。 6. 将投影曲线添加到数据库中。 7. 完成事务。 **代码：** ```vba Public Sub TT_CurveProjected() Dim doc As Document = Application.DocumentManager.MdiActiveDocument Dim db As Database = doc.Database Dim ed As Editor = doc.Editor '转换用户坐标系到世界坐标系 If Application.GetSystemVariable("WORLDUCS").ToString() <> "1" Then ed.CurrentUserCoordinateSystem = Matrix3d.Identity ed.Regen() End If Try Dim peo As New PromptEntityOptions("选择PolyLine") With peo .SetRejectMessage("only Curve can be select") .AddAllowedClass(GetType(Curve), False) End With Dim per = ed.GetEntity(peo) If per.Status <> PromptStatus.OK Then Using tr As Transaction = db.TransactionManager.StartTransaction() Dim bt As BlockTable = tr.GetObject(db.BlockTableId, OpenMode.ForRead) Dim ms As BlockTableRecord = tr.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite) Dim oriCurve As Curve = per.ObjectId.GetObject(OpenMode.ForRead) Dim xoyPlane As New Plane(Point3d.Origin, Vector3d.ZAxis) Dim xozPlane As New Plane(Point3d.Origin, Vector3d.YAxis) Dim yozPlane As New Plane(Point3d.Origin, Vector3d.XAxis) '创建曲线在xoy平面的投影 Dim cur As Curve = oriCurve.GetOrthoProjectedCurve(xoyPlane) cur.Color = Color.FromColorIndex(ColorMethod.ByAci, 150) ms.AppendEntity(cur) '创建曲线在xoz平面的投影 Dim curXoz As Curve = oriCurve.GetOrthoProjectedCurve(xozPlane) curXoz.Color = Color.FromColorIndex(ColorMethod.ByAci, 100) ms.AppendEntity(curXoz) '创建曲线在yoz平面的投影 Dim curYoz As Curve = oriCurve.GetOrthoProjectedCurve(yozPlane) curYoz.Color = Color.FromColorIndex(ColorMethod.ByAci, 50) ms.AppendEntity(curYoz) tr.AddNewlyCreatedDBObject(cur, True) tr.AddNewlyCreatedDBObject(curXoz, True) tr.AddNewlyCreatedDBObject(curYoz, True) tr.Commit() End Using Catch ex As System.Exception Application.ShowAlertDialog(ex.StackTrace) End Try End Sub ``` **注意：** * 此代码假设用户坐标系为“1”。 * 可根据需要修改投影的平面方向。

正文

求取空间任意曲线在xoy/yoz/xoz平面的投影

 <CommandMethod(NameOf(TT_CurveProjected))>
 Public Sub TT_CurveProjected()
     Dim doc As Document = Application.DocumentManager.MdiActiveDocument
     Dim db As Database = doc.Database
     Dim ed As Editor = doc.Editor
     '将用户坐标系转换成世界坐标系
     If Application.GetSystemVariable("WORLDUCS").ToString() <> "1" Then
         ed.CurrentUserCoordinateSystem = Matrix3d.Identity
         ed.Regen()
     End If

     Try
         Dim peo As New PromptEntityOptions("选择PolyLine")
         With peo
             .SetRejectMessage("only Curve can be select")
             .AddAllowedClass(GetType(Curve), False)
         End With
         Dim per = ed.GetEntity(peo)
         If per.Status <> PromptStatus.OK Then Return
         Using tr As Transaction = db.TransactionManager.StartTransaction()
             Dim bt As BlockTable = tr.GetObject(db.BlockTableId, OpenMode.ForRead)
             Dim ms As BlockTableRecord = tr.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
             Dim oriCurve As Curve = per.ObjectId.GetObject(OpenMode.ForRead)
             Dim xoyPlane As New Plane(Point3d.Origin, Vector3d.ZAxis)
             Dim xozPlane As New Plane(Point3d.Origin, Vector3d.YAxis)
             Dim yozPlane As New Plane(Point3d.Origin, Vector3d.XAxis)
             '创建曲线在xoy平面的投影
             Dim cur = oriCurve.GetOrthoProjectedCurve(xoyPlane)
             cur.Color = Color.FromColorIndex(ColorMethod.ByAci, 150)
             ms.AppendEntity(cur)
             tr.AddNewlyCreatedDBObject(cur, True)

             '创建曲线在xoz平面的投影
             Dim curXoz = oriCurve.GetOrthoProjectedCurve(xozPlane)
             curXoz.Color = Color.FromColorIndex(ColorMethod.ByAci, 100)
             ms.AppendEntity(curXoz)
             tr.AddNewlyCreatedDBObject(curXoz, True)

             '创建曲线在yoz平面的投影
             Dim curYoz = oriCurve.GetOrthoProjectedCurve(yozPlane)
             curYoz.Color = Color.FromColorIndex(ColorMethod.ByAci, 50)
             ms.AppendEntity(curYoz)
             tr.AddNewlyCreatedDBObject(curYoz, True)

             tr.Commit()
         End Using
     Catch ex As System.Exception
         Application.ShowAlertDialog(ex.StackTrace)
     End Try
     'Application.UpdateScreen()
 End Sub