《逐点比较法三、四象限逆圆插补计算》由会员分享，可在线阅读，更多相关《逐点比较法三、四象限逆圆插补计算（7页珍藏版）》请在金锄头文库上搜索。
1、逐点比较法三、四象限逆圆插补计算第三象限第四象限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.Current
2、Y = 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)-(840
3、0, 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) Thenans = MsgBox(出错了，请选择象限, 48, 提示信息)End IfDim a, b, c, d, n, m As IntegerDim r As Singlea = Val(Text1.Text)b = Val(Text2.Text)c
4、= Val(Text3.Text)d = Val(Text4.Text)n = a * a + b * bm = c * c + d * dr = Sqr(n)If Option1.Value = True ThenIf Not (a d) ThenGoTo ww1ElseIf n m ThenGoTo ww2End IfEnd IfIf Option2.Value = True ThenIf Not (a = 0 And b = 0 And d m ThenGoTo ww2End IfEnd IfGoTo ww4ww: ans = MsgBox(出错了，逆圆弧起点、终点不在该象限，请重新输入
5、, 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 = Tru
6、e) Thenans = 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 ThenIf Not (a d) Then GoTo ww1ElseIf n m ThenGoTo ww2End IfEnd I
7、fIf Option2.Value = True ThenIf Not (a = 0 And b = 0 And d m ThenGoTo ww2End IfEnd IfPicture1.ForeColor = vbBluePicture1.DrawWidth = 2If Option1.Value = True ThenIf b = 0 ThenIf c = 0 ThenPicture1.Circle (4500, 1000), r * 300, , 3.14159, 3 * 3.14159 / 2ElsePicture1.Circle (4500, 1000), r * 300, , 3.
8、14159, Atn(d / c) + 3.14159End IfElseIf c = 0 ThenPicture1.Circle (4500, 1000), r * 300, , Atn(b / a) + 3.14159, 3 * 3.14159 / 2ElsePicture1.Circle (4500, 1000), r * 300, , Atn(b / a) + 3.14159, Atn(d / c) + 3.14159End IfEnd IfIf Option2.Value = True ThenIf a = 0 ThenIf d = 0 ThenPicture1.Circle (45
9、00, 1000), r * 300, , 3 * 3.14159 / 2, 2 * 3.14159ElsePicture1.Circle (4500, 1000), r * 300, , 3 * 3.14159 / 2, Atn(d / c) + 3.14159 * 2End IfElseIf d = 0 ThenPicture1.Circle (4500, 1000), r * 300, , Atn(b / a) + 3.14159 * 2, 2 * 3.14159ElsePicture1.Circle (4500, 1000), r * 300, , Atn(b / a) + 3.141
10、59 * 2, Atn(d / c) + 3.14159 * 2End 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 w
11、w4ww4: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(A
12、bs(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 + 1l = l + 1F(m) = F(m - 1) - 2 * Ab
13、s(X(m - 1) + 1X(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(Te
14、xt4), Ye = & Int(Text3), = & j - nElsek = k + 1m = m + 1F(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 & 步,
15、+Y , F( & m & )= & F(m), X( & m & )= & X(m), Y( End IfNext nElseIf Option2.Value = True Then 第四象限插补For n = 1 To jIf F(m) = 0 And j 0 Thenm = m + 1k = k + 1F(m) = F(m - 1) - 2 * Abs(Y(m - 1) + 1X(m) = X(m - 1)Y(m) = Y(m - 1) + 1Picture1.Line (4500 + 300 * (a + l), 1000 - 300 * (b + k - 1)-(4500 + 300 * (a + l), 1000 - 300 * (b + k)Form1.CurrentX = 200
