efan2000 发表于 2004-1-8 20:42:00

[另类]使用API判断点是否在多边形中


Option Explicit

Private Type COORD
    x As Long
    y As Long
End Type
Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As Any, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function PtInRegion Lib "gdi32" (ByVal hRgn As Long, ByVal x As Long, ByVal y As Long) As Long

Const ALTERNATE = 1

Private Function PointInPolyine(ByVal Pt As Variant, ByVal lwpLineObj As AcadLWPolyline) As Boolean
   
    ' 多段线顶点数目
    Dim NumCoords As Long
    NumCoords = (UBound(lwpLineObj.Coordinates) + 1) / 2
   
    ' 多段线顶点坐标
    Dim poly() As COORD
    ReDim poly(1 To NumCoords)
    Dim i As Integer
    For i = 0 To UBound(lwpLineObj.Coordinates) - 1 Step 2
      poly(i / 2 + 1).x = lwpLineObj.Coordinates(i) * 10000
      poly(i / 2 + 1).y = lwpLineObj.Coordinates(i + 1) * 10000
    Next
   
    ' 创建区域
    Dim hRgn As Long
    hRgn = CreatePolygonRgn(poly(1), NumCoords, ALTERNATE)
    ' 如果成功创建
    If hRgn Then
      ' 如果点在区域内部
      If PtInRegion(hRgn, Pt(0) * 10000, Pt(1) * 10000) <> 0 Then
            PointInPolyine = True
      End If
    End If
   
    ' 删除区域
    DeleteObject hRgn
End Function

Sub test()
    Dim EntObj As AcadEntity
    Dim pPt As Variant
    ThisDrawing.Utility.GetEntity EntObj, pPt, "选择多段线: "
    pPt = ThisDrawing.Utility.GetPoint(, "指定点: ")
    If PointInPolyine(pPt, EntObj) Then
      Debug.Print "点" & Round(pPt(0), 4) & "," & Round(pPt(1), 4) & "在多段线内部! "
    Else
      Debug.Print "点" & Round(pPt(0), 4) & "," & Round(pPt(1), 4) & "在多段线外部! "
    End If
End Sub

立即窗口
点234.1859,173.8979在多段线内部!

莫名 发表于 2004-1-8 22:30:00

点在多边形的边上无法判断哦？

gyl 发表于 2004-1-8 22:48:00

试验了一下,似乎只适用于凸多边形的情况!

sunny2008 发表于 2007-3-19 20:30:00

<p>我怎么没有测试出来啊?</p><p></p>

兰州人 发表于 2008-3-29 19:58:00

研究一下efan2000<strong>API判断点是否在多边形中的用途.</strong>
页: [1]
查看完整版本: [另类]使用API判断点是否在多边形中