田草博客

互联网田草博客


网友交流QQ群:11740834 需注明申请加入原因

微信 公众号:ByCAD

邮箱:tiancao1001x126.com
ByCAD,微信公众号
首页 | 普通 | 电脑 | AutoCAD | VB/VB.NET | FLash | 结构 | 建筑 | 电影 | BIM | 规范 | 软件 | ID
-随机-|-分布-
-博客论坛-|-﨣﨤﨧﨨-
-网站导航-|-规范下载-
-BelovedFLash欣赏-

用户登陆
用户:
密码:
 

站点日历
73 2024 - 3 48
     12
3456789
10111213141516
17181920212223
24252627282930
31


站点统计

最新评论



点监视器和Hook的结合应用 Autodesk官方卸载工具
未知 射线法判断点是否在曲线内(C#版)   [ 日期:2018-11-13 ]   [ 来自:转化 ]  HTML
http://bbs.xdcad.net/thread-711543-1-2.html

Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.EditorInput

Public Class Class1
    Enum IncidenceType
        kIncidenceToLeft = 0
        kIncidenceToRight
        kIncidenceToFront
        kIncidenceUnknown
    End Enum

    Private Function CurveIncidence(ByVal curve As Curve, ByVal param As Double, ByVal dir As Vector3d, ByVal normal As Vector3d) As IncidenceType
        Dim deriv1 As Vector3d = curve.GetFirstDerivative(param)

        If deriv1.IsParallelTo(dir) Then
            ' need second degree analysis
            Dim deriv2 As Vector3d = curve.GetSecondDerivative(param)

            If deriv2.IsZeroLength() OrElse deriv2.IsParallelTo(dir) Then
                Return IncidenceType.kIncidenceToFront
            Else
                If deriv2.CrossProduct(dir).DotProduct(normal) < 0 Then
                    Return IncidenceType.kIncidenceToRight
                Else
                    Return IncidenceType.kIncidenceToLeft
                End If
            End If
        End If
        If deriv1.CrossProduct(dir).DotProduct(normal) < 0 Then
            Return IncidenceType.kIncidenceToLeft
        Else
            Return IncidenceType.kIncidenceToRight
        End If
    End Function

    Private Function IsInsideCurve(ByVal curve As Curve, ByVal testPt As Point3d) As Boolean
        If Not curve.Closed Then
            ' cannot be inside
            Return False
        End If

        Dim ptOnCurve As Point3d = curve.GetClosestPointTo(testPt, False)

        If testPt = ptOnCurve Then
            Return True
        End If

        If Not curve.IsPlanar Then
            Return False
        End If

        ' check its planar
        Dim plane As Plane = curve.GetPlane()

        ' make the test ray from the plane
        Dim epsilon As Double = 0.000002
        ' ( trust me on this )
        Dim IntersectionPoints As New Point3dCollection()
        Dim normal As Vector3d = plane.Normal
        Dim testVector As Vector3d = normal.GetPerpendicularVector()

        Using ray As New Ray()
            ray.BasePoint = testPt

            Dim nGlancingHits As Integer = 0, numberOfInters As Integer = 0
            Dim bRetryWithOtherRayDirection As Boolean

            Do
                bRetryWithOtherRayDirection = False

                IntersectionPoints.Clear()

                ray.UnitDir = testVector

                ' fire the ray at the curve
                curve.IntersectWith(ray, Intersect.OnBothOperands, IntersectionPoints, IntPtr.Zero, IntPtr.Zero)

                numberOfInters = IntersectionPoints.Count

                If numberOfInters = 0 Then
                    Return False
                End If

                nGlancingHits = 0

                Dim i As Integer = 0
                While i < IntersectionPoints.Count
                    Dim hitParam As Double

                    Try
                        'This try/catch block circumvents an issue with GetParameterAtPoint API
                        hitParam = curve.GetParameterAtPoint(IntersectionPoints(i))
                    Catch
                        bRetryWithOtherRayDirection = True
                        testVector = testVector.RotateBy(5.0 * Math.PI / 180.0, normal)
                        Exit Try
                    End Try

                    Dim inParam As Double = hitParam - epsilon
                    Dim outParam As Double = hitParam + epsilon

                    'Loop back inside the curve if param is falling outside of range
                    If inParam < curve.StartParam Then
                        inParam = curve.EndParam - epsilon + (curve.StartParam - inParam)
                    End If

                    If outParam > curve.EndParam Then
                        outParam = curve.StartParam + epsilon + (curve.EndParam - outParam)
                    End If

                    Dim inIncidence As IncidenceType = CurveIncidence(curve, inParam, testVector, normal)
                    Dim outIncidence As IncidenceType = CurveIncidence(curve, outParam, testVector, normal)

                    If inIncidence = IncidenceType.kIncidenceToFront OrElse outIncidence = IncidenceType.kIncidenceToFront Then
                        bRetryWithOtherRayDirection = True
                        testVector = testVector.RotateBy(5.0 * Math.PI / 180.0, normal)
                        Exit While
                    End If

                    If (inIncidence = IncidenceType.kIncidenceToRight AndAlso outIncidence = IncidenceType.kIncidenceToLeft) OrElse (inIncidence = IncidenceType.kIncidenceToLeft AndAlso outIncidence = IncidenceType.kIncidenceToRight) Then
                        nGlancingHits += 1
                    End If
                    System.Threading.Interlocked.Increment(i)
                End While
            Loop While bRetryWithOtherRayDirection

            Return ((numberOfInters + nGlancingHits) Mod 2 = 1)
        End Using
    End Function
    <CommandMethod("TestIsInsideCurve")> _
    Public Sub TestIsInsideCurve()
        Dim doc As Document = Application.DocumentManager.MdiActiveDocument
        Dim db As Database = doc.Database
        Dim ed As Editor = doc.Editor

        Dim peo As New PromptEntityOptions(vbLf & "Select a Curve: ")
        peo.SetRejectMessage(vbLf & "Invalid selection...")
        peo.AddAllowedClass(GetType(Curve), False)

        Dim per As PromptEntityResult = ed.GetEntity(peo)

        If per.Status <> PromptStatus.OK Then
            Return
        End If

        Dim ppr As PromptPointResult = ed.GetPoint(vbLf & "Pick a point")

        If ppr.Status <> PromptStatus.OK Then
            Return
        End If

        Using Tx As Transaction = db.TransactionManager.StartTransaction()
            Dim curve As Curve = TryCast(Tx.GetObject(per.ObjectId, OpenMode.ForRead), Curve)

            Dim res As Boolean = IsInsideCurve(curve, ppr.Value)

            ed.WriteMessage(vbLf & "Inside: " + res.ToString())
        End Using
    End Sub
End Class





暂时没有评论
发表评论 - 不要忘了输入验证码哦!
作者: 用户:  密码:   注册? 验证:  防止恶意留言请输入问题答案:1*1=?  
评论:

禁止表情
禁止UBB
禁止图片
识别链接
识别关键字

字体样式 文字大小 文字颜色
插入粗体文本 插入斜体文本 插入下划线
左对齐 居中对齐 右对齐
插入超级链接 插入邮件地址 插入图像
插入 Flash 插入代码 插入引用
插入列表 插入音频文件 插入视频文件
插入缩进符合
点击下载按钮 下标 上标
水平线 简介分割标记
表  情
 
Tiancao Blog All Rights Reserved 田草博客 版权所有
Copyright ©