首页 > 其他分享 >AutoCAD VBNET 曲线求交点

AutoCAD VBNET 曲线求交点

时间:2023-10-05 19:12:10浏览次数:27  
标签:Dim AutoCAD ed tr peo 交点 End VBNET

曲线求取点,利用几何库

<CommandMethod(NameOf(TT_PolyLineCrossCheck))>
Public Sub TT_PolyLineCrossCheck()
    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 Polyline can be select")
            .AddAllowedClass(GetType(Polyline), False)
        End With
        Dim per1 = ed.GetEntity(peo)
        peo.Message = "选择第二条PolyLine"
        Dim per2 = ed.GetEntity(peo)
        If per1.Status <> PromptStatus.OK Or per2.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 c1 As Curve = per1.ObjectId.GetObject(OpenMode.ForRead)
            Dim c2 As Curve = per2.ObjectId.GetObject(OpenMode.ForRead)
            Dim cur3d1 As Curve3d = c1.GetGeCurve()
            Dim cur3d2 As Curve3d = c2.GetGeCurve()
            Dim c1Plane = c1.GetPlane()
            Dim c2Plane = c2.GetPlane()
            If Not c1Plane.IsCoplanarTo(c2Plane) Then
                MsgBox("两条曲线不共面无法求取交点", MsgBoxStyle.Critical)
                Return
            End If
            Dim c1c2 As New CurveCurveIntersector3d(cur3d1, cur3d2, c1Plane.Normal)
            If c1c2.NumberOfIntersectionPoints > 0 Then '获取交点的个数
                For index = 0 To c1c2.NumberOfIntersectionPoints - 1 '提取每个交点的坐标
                    Dim p As New DBPoint(c1c2.GetIntersectionPoint(index))
                    ms.AppendEntity(p)
                    tr.AddNewlyCreatedDBObject(p, True)
                Next
                tr.Commit()
                MsgBox("交点生成成功!")
            Else
                MsgBox("找不到交点", MsgBoxStyle.Critical)
            End If
        End Using
    Catch ex As System.Exception
        Application.ShowAlertDialog(ex.StackTrace)
    End Try
End Sub

 

标签:Dim,AutoCAD,ed,tr,peo,交点,End,VBNET
From: https://www.cnblogs.com/NanShengBlogs/p/17743763.html

相关文章

  • AutoCAD Electrical 2020 64位简体中文安装版下载 安装包下载
    AutoCADElectrical2013基于在AutoCAD2013打造,Electrical版本也叫AutoCAD电气版,在AutoCAD的基础上添加了一个Electrical模块,内置简体中文,增加了多种工具和一整套电气设计CAD功能,如符号库、物料清单(BOM)报告和PLCI/O设计等等,增强了界面视觉效果,专业的电器设计工具可极大的提高了......
  • AutoCAD VBNET 获取曲线在3个基本平面的投影
    求取空间任意曲线在xoy/yoz/xoz平面的投影  <CommandMethod(NameOf(TT_CurveProjected))>PublicSubTT_CurveProjected()DimdocAsDocument=Application.DocumentManager.MdiActiveDocumentDimdbAsDatabase=doc.DatabaseDimedAsEditor=......
  • AutoCAD VBNET 当前文档保存
    当前文档保存总出问题现在借助com的方法实现了保存文件<CommandMethod(NameOf(TT_SaveDrawing))>PublicSubTT_SaveDrawing()DimdocAsDocument=Application.DocumentManager.MdiActiveDocumentDimdbAsDatabase=doc.DatabaseDim......
  • Aveva Marine VBNET 编程系列====>读取drawing explorer的第2层级 Sub views
    接上期的内容,此次读取view的下一层几subview主要用到下面的方法获取view的第一个子级一个封装的类PublicClassDrawingExpolrerExPublicSharedFunctionDrawingHasViews(draftAppAsMarDrafting)AsBooleanDimvhAsMarElementHandleTry......
  • Aveva Marine VBNET 编程系列===>读取drawing explorer的第一层级 view
    今天我们研究下读取drawingexpolrer的第一层级:view下面的图纸的层级目录示意图,我们今天需要获取所有的view 主要用到2个方法:1#获取第一个元素MarDrafting.ElementChildFirstGetMethod() 2#获取相邻的元素MarDrafting.ElementSiblingNextGet Method  ......
  • Aveva Marine VBNET 编程系列-封装一个类
    由于AM的marapi的大部分类实现了IDisposable接口,所有避免内存过大,用了一般需要dispose下微软官方的解释:https://learn.microsoft.com/zh-cn/dotnet/api/system.idisposable?view=net-7.0 以下是MarDrafting类的定义,很显然它实现了IDisposable接口 ImportsSystem.Reflec......
  • Aveva Marine VBNET 编程系列-创建曲线
    显现的效果 代码实现:<MyAmFunctionAtt(NameOf(绘图控制),NameOf(新建曲线))>PublicSub新建曲线(wmAsWindowManager)DimdraftAppAsNewMarDraftingDimuiAsNewMarUi'ImportsAveva.Marine.UIDimutilyAsNewMarUtil'ImportsA......
  • Aveva Marine VBNET 编程系列-新建图纸,创建文字
    根据MarApi,创建图形文件,新建文字ImportsAveva.ApplicationFramework.PresentationImportsAveva.Marine.Drafting'marAPI.dllPublicClass绘图控制<MyAmFunctionAtt(NameOf(绘图控制),NameOf(新建图纸))>PublicSub新建图纸(wmAsWindowManager)Di......
  • Aveva Marine VBNET 编程系列-修改程序快捷键
    修改HullDesign程序的主题以及菜单项的快捷键 引用的dll文件下面的是代码和快捷键配置文件:https://files.cnblogs.com/files/NanShengBlogs/AMShortCut.HullDesign.zip?t=1695908179&download=trueImportsAveva.ApplicationFramework.PresentationImportsAveva.Applic......
  • Aveva Marine VBNET 编程系列-搭建开发框架
    引用的DllAveva.ApplicationFramework.dllAveva.ApplicationFramework.Presentation菜单展示效果创建Attribute,用于反射来动态创建菜单,不用每次都去写commandPublicClassMyAmFunctionAttInheritsAttributePrivate_menuNameAsStringPublicPropertyM......