《VB代码 判断点在多边形内.docx》由会员分享,可在线阅读,更多相关《VB代码 判断点在多边形内.docx(4页珍藏版)》请在三一办公上搜索。
1、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 Doub
2、le, 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)
3、, 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 xmax Then xmax = dx If dy = 0# And d3 * d1 = 0# Then sum = sum + 1 Next i Picture1.Print sum= + Str(sum
4、) + 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
5、) + (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
链接地址:https://www.31ppt.com/p-3168270.html