逐点比较法三四象限逆圆插补计算

逐点比较法三、四象限逆圆插补计算第三象限第四象限Private Sub Command1_Click()Picture1.ForeColor = vbBlackPicture1.DrawWidth = 2Picture1.Line (500, 1000)-(8500, 1000) 画直线坐标轴Picture1.Line (4500, 1000)-(4500, 5000)Picture1.CurrentX = 230 当前位置Picture1.CurrentY = 900Picture1.Print -X 坐标轴标注Picture1.CurrentX = 4300Picture1.CurrentY = 800Picture1.Print (0,0)Picture1.CurrentX = 8650Picture1.CurrentY = 900Picture1.Print XPicture1.CurrentX = 4400Picture1.CurrentY = 5100Picture1.Print -YPicture1.Line (500, 1000)-(600, 950) 箭头Picture1.Line (500, 1000)-(600, 1050)Picture1.Line (8500, 1000)-(8400, 950)Picture1.Line (8500, 1000)-(8400, 1050)Picture1.Line (4500, 5000)-(4450, 4900)Picture1.Line (4500, 5000)-(4550, 4900)End SubPrivate Sub 坐标判别_Click()If Not (Option1.Value = True Or Option2.Value = True) Then ans = MsgBox(出错了，请选择象限, 48, 提示信息)End IfDim a, b, c, d, n, m As IntegerDim r As Singlea = Val(Text1.Text)b = Val(Text2.Text)c = Val(Text3.Text)d = Val(Text4.Text)n = a * a + b * bm = c * c + d * dr = Sqr(n)If Option1.Value = True Then If Not (a = 0 And b = 0 And c = 0 And d = 0) Then GoTo ww ElseIf Not (a d) Then GoTo ww1 ElseIf n m Then GoTo ww2 End IfEnd IfIf Option2.Value = True Then If Not (a = 0 And b = 0 And d = 0) Then GoTo ww ElseIf Not (a c And b d) Then GoTo ww1 ElseIf n m Then GoTo ww2 End IfEnd IfGoTo ww4ww: ans = MsgBox(出错了，逆圆弧起点、终点不在该象限，请重新输入, 48, 提示信息)GoTo ww3ww1: ans = MsgBox(出错了，逆圆弧起点、终点位置错误，请重新输入, 48, 提示信息)GoTo ww3ww2: ans = MsgBox(出错了，该象限所绘圆弧不以原点为圆心，请重新输入, 48, 提示信息)ww3: Text1.Text = Text2.Text = Text3.Text = Text4.Text = Text1.SetFocusGoTo ww4ww4:End SubPrivate Sub Command4_Click()If Not (Option1.Value = True Or Option2.Value = True) Then ans = MsgBox(出错了，请选择象限, 48, 提示信息)End IfDim a, b, c, d, n, m As IntegerDim r As Singlea = Val(Text1.Text)b = Val(Text2.Text)c = Val(Text3.Text)d = Val(Text4.Text)n = a * a + b * bm = c * c + d * dr = Sqr(n)If Option1.Value = True Then If Not (a = 0 And b = 0 And c = 0 And d = 0) Then GoTo ww ElseIf Not (a d) Then GoTo ww1 ElseIf n m Then GoTo ww2 End IfEnd IfIf Option2.Value = True Then If Not (a = 0 And b = 0 And d = 0) Then GoTo ww ElseIf Not (a c And b d) Then GoTo ww1 ElseIf n m Then GoTo ww2 End IfEnd IfPicture1.ForeColor = vbBluePicture1.DrawWidth = 2If Option1.Value = True Then If b = 0 Then If c = 0 Then Picture1.Circle (4500, 1000), r * 300, , 3.14159, 3 * 3.14159 / 2 Else Picture1.Circle (4500, 1000), r * 300, , 3.14159, Atn(d / c) + 3.14159 End If ElseIf c = 0 Then Picture1.Circle (4500, 1000), r * 300, , Atn(b / a) + 3.14159, 3 * 3.14159 / 2 Else Picture1.Circle (4500, 1000), r * 300, , Atn(b / a) + 3.14159, Atn(d / c) + 3.14159 End IfEnd IfIf Option2.Value = True Then If a = 0 Then If d = 0 Then Picture1.Circle (4500, 1000), r * 300, , 3 * 3.14159 / 2, 2 * 3.14159 Else Picture1.Circle (4500, 1000), r * 300, , 3 * 3.14159 / 2, Atn(d / c) + 3.14159 * 2 End If ElseIf d = 0 Then Picture1.Circle (4500, 1000), r * 300, , Atn(b / a) + 3.14159 * 2, 2 * 3.14159 Else Picture1.Circle (4500, 1000), r * 300, , Atn(b / a) + 3.14159 * 2, Atn(d / c) + 3.14159 * 2 End IfEnd IfGoTo ww4ww: ans = MsgBox(出错了，逆圆弧起点、终点不在该象限，请重新输入, 48, 提示信息)GoTo ww3ww1: ans = MsgBox(出错了，逆圆弧起点、终点位置错误，请重新输入, 48, 提示信息)GoTo ww3ww2: ans = MsgBox(出错了，该象限所绘圆弧不以原点为圆心，请重新输入, 48, 提示信息)ww3: Text1.Text = Text2.Text = Text3.Text = Text4.Text = Text1.SetFocusGoTo ww4ww4:End SubPrivate Sub Command2_Click()Dim k, m, j, l, n, F(30), X(30), Y(30) As Integer, a As Integer, b As Integer, c As Integer, d As Integera = Int(Text1)b = Int(Text2)c = Int(Text3)d = Int(Text4)m = 0l = 0k = 0F(m) = 0X(m) = aY(m) = bPicture1.ForeColor = vbGreenPicture1.DrawWidth = 3j = Abs(Abs(a) - Abs(c) + Abs(Abs(b) - Abs(d)Form1.CurrentX = 200Form1.CurrentY = 200Print 初始, 进给方向 , F(0)=0, X(0) = & Int(Text1), Y(0)= & Int(Text2), Xe = & Int(Text4), Ye = & Int(Text3), = & jIf Option1.Value = True Then 第三象限插补For n = 1 To jIf F(m) = 0 And j 0 Thenm = m + 1 l = l + 1 F(m) = F(m - 1) - 2 * Abs(X(m - 1) + 1 X(m) = X(m - 1) + 1 Y(m) = Y(m - 1) Picture1.Line (4500 + 300 * (a + l - 1), 1000 - 300 * (b - k)-(4500 + 300 * (a + l), 1000 - 300 * (b - k) Form1.CurrentX = 200Form1.CurrentY = 200 + m * 300Print 第 & m & 步, -X , F( & m & )= & F(m), X( & m & )= & X(m), Y( & m & )= & Y(m), Xe = & Int(Text4), Ye = & Int(Text3), = & j - nElsek = k + 1m = m + 1 F(m) = F(m - 1) + 2 * Abs(Y(m - 1) + 1Y(m) = Y(m - 1) - 1X(m) = X(m - 1) Picture1.Line (4500 + 300 * (a + l), 1000 - 300 * (b - k + 1)-(4500 + 300 * (a + l), 1000 - 300 * (b - k) Form1.CurrentX = 200Form1.CurrentY = 200 + m * 300Print 第 & m & 步, +Y , F( & m & )= & F(m), X( & m & )= & X(m), Y( & m & )= & Y(m), Xe = & Int(Text4), Ye = & Int(Text3), = & j - n; End IfNext nElseIf Option2.Value = True Then 第四象限插补For n = 1 To jIf F(m) = 0 And j 0 Thenm = m + 1 k = k + 1 F(m) = F(m - 1) - 2 * Abs(Y(m - 1) + 1 X(m) = X(m - 1) Y(m) = Y(m - 1) + 1 Picture1.Line (4500 + 300 * (a + l), 1000 - 300 * (b + k - 1)-(4500 + 300 * (a + l), 1000 - 300 * (b + k) Form1.CurrentX = 200Form1.CurrentY = 200 + m * 300Print 第 & m & 步, -Y , F( & m & )= & F(m), X( & m & )= & X(m), Y( & m & )= & Y(m), Xe = & Int(Text4), Ye = & Int(Text3), = & j - nElsel = l + 1m = m + 1 F(m) = F(m - 1) + 2 * Abs(X(m - 1) + 1Y(m) = Y(m - 1)X(m) = X(m - 1) + 1 Picture1.Line (4500 + 300 * (a + l - 1), 1000 - 300 * (b + k)-(4500 + 300 * (a + l), 1000 - 300 * (b + k) Form1.CurrentX = 200Form1.CurrentY = 200 + m * 300Print 第 & m & 步, +X , F( & m & )= & F(m), X( & m & )= & X(m), Y( & m & )= & Y(m), Xe = & Int(Text4), Ye = & Int(Text3), = & j - nEnd IfNext nEnd IfEnd SubPrivate Sub Command3_Click() 清除Text1.Text = Text2.Text = Text3.Text = Text4.Text = Picture1.ClsForm1.ClsText1.SetFocus