[求助]：如何根据点坐标，判断它是否位于闭合区域内

7lord

假设我有一个多段线围成的闭合区域和一个点的坐标，在VBA该如何写代码来判断这个点是否在这个闭合区域内？

cqsnowfox

'判断两线段是否相交
Public Function SegmentItrsec(ByVal P1 As Variant, ByVal P2 As Variant, ByVal Q1 As Variant, ByVal Q2 As Variant) As Boolean
   
    Dim TMP1(1) As Double, TMP2(1) As Double
    Dim T1 As Double, T2 As Double
    Dim Result1 As Double, Result2 As Double
    TMP1(0) = P1(0) - Q1(0): TMP1(1) = P1(1) - Q1(1)
    TMP2(0) = Q2(0) - Q1(0): TMP2(1) = Q2(1) - Q1(1)
    T1 = SLCJ(TMP1, TMP2)
    TMP1(0) = Q2(0) - Q1(0): TMP1(1) = Q2(1) - Q1(1)
    TMP2(0) = P2(0) - Q1(0): TMP2(1) = P2(1) - Q1(1)
    T2 = SLCJ(TMP1, TMP2)
    Result1 = T1 * T2
    If Result1 >= 0 Then
        TMP1(0) = Q1(0) - P1(0): TMP1(1) = Q1(1) - P1(1)
        TMP2(0) = P2(0) - P1(0): TMP2(1) = P2(1) - P1(1)
        T1 = SLCJ(TMP1, TMP2)
        TMP1(0) = P2(0) - P1(0): TMP1(1) = P2(1) - P1(1)
        TMP2(0) = Q2(0) - P1(0): TMP2(1) = Q2(1) - P1(1)
        T2 = SLCJ(TMP1, TMP2)
        Result2 = T1 * T2
        If Result2 >= 0 Then
            SegmentItrsec = True
        Else
            SegmentItrsec = False
        End If
    Else
        SegmentItrsec = False
    End If
   
End Function



'判断点是否落在线段上
Public Function PntOnSegment(ByVal SP As Variant, ByVal EP As Variant, ByVal Tp As Variant) As Boolean
    Dim TSPntX, TSPntY As Double
    Dim ESPntX, ESPntY As Double
    TSPntX = Tp(0) - SP(0)
    TSPntY = Tp(1) - SP(1)
    ESPntX = EP(0) - SP(0)
    ESPntY = EP(1) - SP(1)
    If Abs((TSPntX * ESPntY) - (ESPntX * TSPntY)) < 0.00001 Then
        If Min(Str(SP(0)), Str(EP(0))) <= Tp(0) And _
        Tp(0) <= Max(Str(SP(0)), Str(EP(0))) And _
        Min(Str(SP(1)), Str(EP(1))) <= Tp(1) And _
        Tp(1) <= Max(Str(SP(1)), Str(EP(1))) Then
            PntOnSegment = True
        Else
            PntOnSegment = False
        End If
    End If
End Function
'''''''''''''''''''''''''''''''
'''判断点是否在多边行范围内 '''
''"0"--表示点在多边行范围外 '''
''"1"--表示点在多边行范围内 '''
''"2"--表示点在多边行边上   '''
'''
'''Tpnt 表示需要判断的点
'''VPntX表示多边行的顶点X坐标
'''VPntY表示多边行的顶点X坐标
'''本程序中X，Y坐标分别表示测量坐标的Y，X
'''''''''''''''''''''''''''''''
Public Function PntInPolygon(ByVal Tpnt As Variant, ByVal VPntX As Variant, ByVal VPntY As Variant) As Integer
  
    Dim NewPntNum As Integer
    Dim SPnt(1) As Double
    Dim EPnt(1) As Double
    Dim PL(2) As Double
    Dim Count As Integer
    Dim I As Integer
    PL(0) = -9999999
    PL(1) = Tpnt(1)
    NewPntNum = UBound(VPntX)
    For I = 1 To NewPntNum
        SPnt(0) = Val(VPntX(I))
        SPnt(1) = Val(VPntY(I))
        If I = NewPntNum Then
            EPnt(0) = Val(VPntX(1))
            EPnt(1) = Val(VPntY(1))
        Else
            EPnt(0) = Val(VPntX(I + 1))
            EPnt(1) = Val(VPntY(I + 1))
        End If
        If PntOnSegment(EPnt, SPnt, Tpnt) = True Then
            PntInPolygon = 2 '表示点落在多边行边上
            Exit Function
        Else
            If SPnt(1) <> EPnt(1) Then   '多边行边不水平
                If PntOnSegment(Tpnt, PL, SPnt) = True Then
                    If SPnt(1) > EPnt(1) Then
                        Count = Count + 1
                    End If
                ElseIf PntOnSegment(Tpnt, PL, EPnt) = True Then
                    If EPnt(1) > SPnt(1) Then
                        Count = Count + 1
                    End If
                End If
                If SegmentItrsec(SPnt, EPnt, Tpnt, PL) = True Then
                        Count = Count + 1
                    End If
           End If
        End If
    Next I
  
    If Int(Count / 2) = Count / 2 Then
        PntInPolygon = 0 '表示点落在多边行外
    Else
        PntInPolygon = 1 '表示点落在多边行内
    End If
End Function