判断点是否在自由曲线（大量边的多边形）内

wkxxxr

蓝桥玄霜 发表于 2016-8-18 09:25
最前面的Dim语句中是否漏抄了Crr

第二句dim有写。有些不太明白。

潘家湾中学

liucqa 发表于 2016-8-12 21:26
百度 判断一个点是否在多边形内部

恭请老师移步帮忙解决一下：
http://club.excelhome.net/thread-1296101-1-1.html

lt0314

判断点是否在自由曲线内.rar (50.25 KB, 下载次数: 67)

2016-8-18 16:05 上传

点击文件名下载附件

1. 
   
2. Type Point
   
3. x As Double
   
4. y As Double
   
5. End Type
   
6. Public Sub GetStdLine(ps As Point, pe As Point, ByRef a As Double, ByRef b As Double, ByRef c As Double)
   
7. '根据两个点的坐标求经过两点的直线的标准方程参数A、B、C
   
8. Dim xs As Double, ys As Double, xe As Double, ye As Double
   
9. xs = ps.x: ys = ps.y: xe = pe.x: ye = pe.y
   
10. Dim p1 As Double, p2 As Double
    
11. p1 = xs * ye: p2 = xe * ys
    
12. If (p1 = p2) Then
    
13.     If (xs = 0) Then
    
14.         If (xe = 0) Then
    
15.             a = 1: b = 0: c = 0
    
16.         ElseIf (ys = 0) Then
    
17.             a = ye: b = -xe: c = 0
    
18.         End If
    
19.     ElseIf (ye = 0) Then
    
20.         If (ys = 0) Then
    
21.             a = 0: b = 1: c = 0
    
22.         ElseIf (xe = 0) Then
    
23.             a = -ys: b = xs: c = 0
    
24.         End If
    
25.     End If
    
26. Else
    
27.     a = (ys - ye) / (p1 - p2): c = 1
    
28.     If (ys = 0) Then
    
29.         If (ye = 0) Then
    
30.             b = 1: c = 0
    
31.         Else
    
32.             b = -(a * xe + 1) / ye
    
33.         End If
    
34.     Else
    
35.         b = -(a * xs + 1) / ys
    
36.     End If
    
37. End If
    
38. End Sub
    
39. 
    
40. Public Function InPoly(poly() As Point, p As Point) As Boolean
    
41. '判断点是否在多边形内部
    
42. Dim i As Integer, f As Integer, xi As Double
    
43. Dim a As Double, b As Double, c As Double
    
44. Dim ps As Point, pe As Point
    
45. For i = 0 To UBound(poly)
    
46.     ps = poly(i)
    
47.     If (i < UBound(poly)) Then pe = poly(i + 1) Else pe = poly(0)
    
48.     GetStdLine ps, pe, a, b, c
    
49.     If (a <> 0) Then
    
50.         xi = -(b * p.y + c) / a
    
51.         If (xi = p.x) Then
    
52.             InPoly = True: Exit Function
    
53.         ElseIf (xi < p.x) Then
    
54.             f = f + Sgn(pe.y - p.y) - Sgn(ps.y - p.y)
    
55.         End If
    
56.     End If
    
57. Next i
    
58. InPoly = (f <> 0)
    
59. End Function
    
60. Public Function IsIn(Sx As Range, Sy As Range, x As Range, y As Range)
    
61. Dim poly() As Point, p As Point, i As Integer, Xx, Yy
    
62. Dim arr(), j As Long
    
63. Xx = WorksheetFunction.Transpose(Sx): Yy = WorksheetFunction.Transpose(Sy)
    
64. ReDim poly(0 To UBound(Xx) - 1)
    
65. For i = 0 To UBound(Xx) - 1
    
66.     poly(i).x = CDbl(Xx(i + 1)): poly(i).y = CDbl(Yy(i + 1))
    
67. Next i
    
68. For i = 1 To x.Columns(1).Cells.Count
    
69.     p.x = CDbl(x.Cells(i, 1)): p.y = CDbl(y.Cells(i, 1))
    
70.     If InPoly(poly, p) Then
    
71.         ReDim Preserve arr(1, j)
    
72.         arr(0, j) = p.x: arr(1, j) = p.y
    
73.         j = j + 1
    
74.     End If
    
75. Next
    
76. IsIn = arr
    
77. End Function
    
78. Sub main()
    
79. Dim dd
    
80. dd = WorksheetFunction.Transpose(IsIn([g3:g113], [h3:h113], [b3:b490], [c3:c490]))
    
81. Range("d:e").ClearContents
    
82. Range("d3").Resize(UBound(dd), 2) = dd
    
83. End Sub
    

复制代码

蓝桥玄霜

在sub zhx()的过程中第一个dr(j,3)抄错了，错为cr(j,3)
请见附件。

wkxxxr

蓝桥玄霜 发表于 2016-8-19 08:47
在sub zhx()的过程中第一个dr(j,3)抄错了，错为cr(j,3)
请见附件。

谢谢大师耐心指导，复制代码漏改没对出来。代码还需消化。谢谢

yzli007

蓝桥玄霜 发表于 2016-8-17 08:51
我的思路是：
1，先计算多边形范围边界的最大值，从而排除大量的范围外数据；
2，判断通过B列x值的垂直线 ...

"求得比x小的G列的所有值，然后按降序排序，
从最大的开始判断，如果它的相邻点的值大于x的话，表示x垂直线与这两点组成的直线相交，并可求得其交点的坐标值"老师提到的“如果它的相邻点的值大于x的话“，求得的就是比X小的G列的所有值，相邻点的值怎么可能大于X呢？不太明白，请老师指点

yzli007

lt0314 发表于 2016-8-18 16:06

能把思路讲讲吗？让大家学习学习

蓝桥玄霜

请见附件。

蓝桥玄霜

请见附件。

ebkzxcel

lt0314 发表于 2016-8-18 16:06

请问如果有个点刚好在多边形某条边的延伸线上而不在多边形范围中,是否能识别出不在范围内?