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

efan2000

2. 
   
3. Option Explicit
   
4. 
   
5. Private Type COORD
   
6.     x As Long
   
7.     y As Long
   
8. End Type
   
9. Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As Any, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
   
10. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    
11. Private Declare Function PtInRegion Lib "gdi32" (ByVal hRgn As Long, ByVal x As Long, ByVal y As Long) As Long
    
12. 
    
13. Const ALTERNATE = 1
    
14. 
    
15. Private Function PointInPolyine(ByVal Pt As Variant, ByVal lwpLineObj As AcadLWPolyline) As Boolean
    
16.    
    
17.     ' 多段线顶点数目
    
18.     Dim NumCoords As Long
    
19.     NumCoords = (UBound(lwpLineObj.Coordinates) + 1) / 2
    
20.    
    
21.     ' 多段线顶点坐标
    
22.     Dim poly() As COORD
    
23.     ReDim poly(1 To NumCoords)
    
24.     Dim i As Integer
    
25.     For i = 0 To UBound(lwpLineObj.Coordinates) - 1 Step 2
    
26.         poly(i / 2 + 1).x = lwpLineObj.Coordinates(i) * 10000
    
27.         poly(i / 2 + 1).y = lwpLineObj.Coordinates(i + 1) * 10000
    
28.     Next
    
29.    
    
30.     ' 创建区域
    
31.     Dim hRgn As Long
    
32.     hRgn = CreatePolygonRgn(poly(1), NumCoords, ALTERNATE)
    
33.     ' 如果成功创建
    
34.     If hRgn Then
    
35.         ' 如果点在区域内部
    
36.         If PtInRegion(hRgn, Pt(0) * 10000, Pt(1) * 10000) <> 0 Then
    
37.             PointInPolyine = True
    
38.         End If
    
39.     End If
    
40.    
    
41.     ' 删除区域
    
42.     DeleteObject hRgn
    
43. End Function
    
44. 
    
45. Sub test()
    
46.     Dim EntObj As AcadEntity
    
47.     Dim pPt As Variant
    
48.     ThisDrawing.Utility.GetEntity EntObj, pPt, "选择多段线: "
    
49.     pPt = ThisDrawing.Utility.GetPoint(, "指定点: ")
    
50.     If PointInPolyine(pPt, EntObj) Then
    
51.         Debug.Print "点" & Round(pPt(0), 4) & "," & Round(pPt(1), 4) & "在多段线内部! "
    
52.     Else
    
53.         Debug.Print "点" & Round(pPt(0), 4) & "," & Round(pPt(1), 4) & "在多段线外部! "
    
54.     End If
    
55. End Sub
    
56. 
    
57. 立即窗口
    
58. 点234.1859,173.8979在多段线内部!
    

<br /> Option Explicit<br /> <br /> Private Type COORD<br />     x As Long<br />     y As Long<br /> End Type<br /> Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As Any, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long<br /> Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long<br /> Private Declare Function PtInRegion Lib "gdi32" (ByVal hRgn As Long, ByVal x As Long, ByVal y As Long) As Long<br /> <br /> Const ALTERNATE = 1<br /> <br /> Private Function PointInPolyine(ByVal Pt As Variant, ByVal lwpLineObj As AcadLWPolyline) As Boolean<br />     <br />     ' 多段线顶点数目<br />     Dim NumCoords As Long<br />     NumCoords = (UBound(lwpLineObj.Coordinates) + 1) / 2<br />     <br />     ' 多段线顶点坐标<br />     Dim poly() As COORD<br />     ReDim poly(1 To NumCoords)<br />     Dim i As Integer<br />     For i = 0 To UBound(lwpLineObj.Coordinates) - 1 Step 2<br />         poly(i / 2 + 1).x = lwpLineObj.Coordinates(i) * 10000<br />         poly(i / 2 + 1).y = lwpLineObj.Coordinates(i + 1) * 10000<br />     Next<br />     <br />     ' 创建区域<br />     Dim hRgn As Long<br />     hRgn = CreatePolygonRgn(poly(1), NumCoords, ALTERNATE)<br />     ' 如果成功创建<br />     If hRgn Then<br />         ' 如果点在区域内部<br />         If PtInRegion(hRgn, Pt(0) * 10000, Pt(1) * 10000) <> 0 Then<br />             PointInPolyine = True<br />         End If<br />     End If<br />     <br />     ' 删除区域<br />     DeleteObject hRgn<br /> End Function<br /> <br /> Sub test()<br />     Dim EntObj As AcadEntity<br />     Dim pPt As Variant<br />     ThisDrawing.Utility.GetEntity EntObj, pPt, "选择多段线: "<br />     pPt = ThisDrawing.Utility.GetPoint(, "指定点: ")<br />     If PointInPolyine(pPt, EntObj) Then<br />         Debug.Print "点" & Round(pPt(0), 4) & "," & Round(pPt(1), 4) & "在多段线内部! "<br />     Else<br />         Debug.Print "点" & Round(pPt(0), 4) & "," & Round(pPt(1), 4) & "在多段线外部! "<br />     End If<br /> End Sub<br /> <br /> 立即窗口<br /> 点234.1859,173.8979在多段线内部! <br />

莫名

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

gyl

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

sunny2008

我怎么没有测试出来啊?

兰州人

研究一下efan2000API判断点是否在多边形中的用途.