[VBA]判断点px是否在多边形内

yshf 发表于 2005-7-1 14:04:00

判断点px是否在多边形内 document.write ( code_jk_my("'判断点px是否在多边形内; '即可适用于凹多边形的判断，也适用于凸多边形的判断 '所选射线px(x0 y0)--pxy(x0+2*max|x0-xi| y0+min|y0-yi|) 不与多边形任何一顶点相交 '入口参数多边形：(n, ptx(), pty(), px , py) '返回值False (在多边形外)、True(在多边形上及在多边形内) Public Function dzdbxn(n As Long, ptx() As Double, pty() As Double, px As Double, py As Double) As Boolean Dim j As Long Dim d1 As Double Dim d2 As Double Dim d3 As Double dzdbxn = False For i = 1 To n j = i + 1: If i = n Then j = 1 d1 = Abs(ptx(i) * pty(j) + ptx(j) * py + px * pty(i) - ptx(i) * py - ptx(j) * pty(i) - px * pty(j)) d2 = Pold(ptx(i), pty(i), ptx(j), pty(j)) d3 = Abs(d2 - Pold(ptx(i), pty(i), px, py) - Pold(ptx(j), pty(j), px, py)) d1 = d1 / d2 Print "i=" + Str(i) + " j=" + Str(j) + " d1=" + Str(d1) + " d3=" + Str(d3) '注意：d1 d3判断值1前的0个数=多边形区域坐标值中小数位数-1 If d1 < 0.0001 And d3 < 0.0001 Then dzdbxn = True: Exit Function Next i If dzdbxn = False Then Dim dx As Double Dim xmax As Double Dim dy As Double Dim ymin As Double For i = 1 To n dx = Abs(ptx(i) - px): dy = Abs(pty(i) - py) If i = 1 Then xmax = dx: ymin = dy Else If dx > xmax Then xmax = dx If dy < ymin Then ymin = dy End If Next i Dim sum As Long sum = 0: xmax = 2# * xmax For i = 1 To n j = i + 1: If i = n Then j = 1 d1 = ymin * (ptx(j) - ptx(i)) - xmax * (pty(j) - pty(i)) d2 = xmax * (pty(i) - py) - ymin * (ptx(i) - px) d3 = (ptx(j) - ptx(i)) * (pty(i) - py) - (pty(j) - pty(i)) * (ptx(i) - px) If (d2 * (d1 - d2)) >= 0# And d3 * d1 >= 0# Then sum = sum + 1 Next i 'Print "sum=" + Str(sum) + " px=" + Str(px) + " py=" + Str(py) If sum > 0 And sum <> 2 * Int(sum / 2) Then dzdbxn = True Else dzdbxn = False End If End If End Function Function Pold(x1 As Double, y1 As Double, x2 As Double, y2 As Double) As Double '两点间距离计算 Pold = Sqr((x2 - x1) * (x2 - x1) + (y2 - y1) * (y2 - y1)) End Function ")); '判断点px是否在多边形内; '即可适用于凹多边形的判断，也适用于凸多边形的判断 '所选射线px(x0 y0)--pxy(x0+2*max|x0-xi| y0+min|y0-yi|) 不与多边形任何一顶点相交 '入口参数多边形：(n, ptx(), pty(), px , py) '返回值False (在多边形外)、True(在多边形上及在多边形内) Public Function dzdbxn(n As Long, ptx() As Double, pty() As Double, px As Double, py As Double) As Boolean Dim j As Long Dim d1 As Double Dim d2 As Double Dim d3 As Double dzdbxn = False For i = 1 To n j = i + 1: If i = n Then j = 1 d1 = Abs(ptx(i) * pty(j) + ptx(j) * py + px * pty(i) - ptx(i) * py - ptx(j) * pty(i) - px * pty(j)) d2 = Pold(ptx(i), pty(i), ptx(j), pty(j)) d3 = Abs(d2 - Pold(ptx(i), pty(i), px, py) - Pold(ptx(j), pty(j), px, py)) d1 = d1 / d2 Print "i=" + Str(i) + " j=" + Str(j) + " d1=" + Str(d1) + " d3=" + Str(d3) '注意：d1 d3判断值1前的0个数=多边形区域坐标值中小数位数-1 If d1 < 0.0001 And d3 < 0.0001 Then dzdbxn = True: Exit Function Next i If dzdbxn = False Then Dim dx As Double Dim xmax As Double Dim dy As Double Dim ymin As Double For i = 1 To n dx = Abs(ptx(i) - px): dy = Abs(pty(i) - py) If i = 1 Then xmax = dx: ymin = dy Else If dx > xmax Then xmax = dx If dy < ymin Then ymin = dy End If Next i Dim sum As Long sum = 0: xmax = 2# * xmax For i = 1 To n j = i + 1: If i = n Then j = 1 d1 = ymin * (ptx(j) - ptx(i)) - xmax * (pty(j) - pty(i)) d2 = xmax * (pty(i) - py) - ymin * (ptx(i) - px) d3 = (ptx(j) - ptx(i)) * (pty(i) - py) - (pty(j) - pty(i)) * (ptx(i) - px) If (d2 * (d1 - d2)) >= 0# And d3 * d1 >= 0# Then sum = sum + 1 Next i 'Print "sum=" + Str(sum) + " px=" + Str(px) + " py=" + Str(py) If sum > 0 And sum <> 2 * Int(sum / 2) Then dzdbxn = True Else dzdbxn = False End If End If End Function Function Pold(x1 As Double, y1 As Double, x2 As Double, y2 As Double) As Double '两点间距离计算 Pold = Sqr((x2 - x1) * (x2 - x1) + (y2 - y1) * (y2 - y1)) End Function

cbse_smy 发表于 2005-8-13 15:56:00

有一个更简单,以多边形做一个面域,再以点为圆心做一个很小的圆,取二者并集,若并后的面积与多边形面一样大则点在多边形内,若并后的面积等于多形面积加上圆的面积则点在其外,否则在多边形线上!

页: [1]

明经CAD社区's Archiver

[VBA]判断点px是否在多边形内