VB代码 判断点在多边形内.docx
VB代码 判断点在多边形内Picture1 Command2 Command3 Label6 Command1 Command4 代码如下： Dim n As Long Dim x As Double Dim y As Double Dim px As Double Dim py As Double Private Sub Command1_Click Command3.Enabled = False Call dzdbxn(n, x, y, px, py) End Sub 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 = 0 To n - 1 j = i + 1: If i = n - 1 Then j = 0 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 Picture1.Print "i=" + Str(i) + " j=" + Str(j) + " d1=" + Str(d1) + " d3=" + Str(d3) 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 = 0 To n - 1 dx = Abs(ptx(i) - px): dy = Abs(pty(i) - py) If i = 0 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 = 0 To n - 1 j = i + 1: If i = n - 1 Then j = 0 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 Picture1.Print "sum=" + Str(sum) + " px=" + Str(px) + " py=" + Str(py) If sum > 0 And sum <> 2 * Int(sum / 2) Then dzdbxn = True Label6.Caption = "点在多边形内" Else dzdbxn = False Label6.Caption = "点在多边形外" 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 Private Sub Command2_Click n = Val(InputBox("根据要形成多边形的边数输入相应的n值") If n < 3 Then MsgBox "边数必须3！请重试！" ReDim x(n - 1) ReDim y(n - 1) For i = 0 To UBound(x) x(i) = InputBox("X(" & i & ")=") y(i) = InputBox("Y(" & i & ")=") Next Command3.Enabled = True End Sub Private Sub Command3_Click px = InputBox("X=") py = InputBox("Y=") Command1.Enabled = True Command2.Enabled = False End Sub Private Sub Command4_Click Unload Form1 End Sub
