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

逐点比较法三、四象限逆圆插补计算第三象限
第四象限
Private Sub Command1_Click(>
Picture1.ForeColor = vbBlack
Picture1.DrawWidth = 2
Picture1.Line (500, 1000>-(8500, 1000> '画直线坐标轴Picture1.Line (4500, 1000>-(4500, 5000>
Picture1.CurrentX = 230 '当前位置
Picture1.CurrentY = 900
Picture1.Print "-X" '坐标轴标注
Picture1.CurrentX = 4300
Picture1.CurrentY = 800
Picture1.Print "(0,0>"
Picture1.CurrentX = 8650
Picture1.CurrentY = 900
Picture1.Print "X"
Picture1.CurrentX = 4400
Picture1.CurrentY = 5100
Picture1.Print "-Y"
Picture1.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 Sub
Private Sub 坐标判别_Click(>
If Not (Option1.Value = True Or Option2.Value = True> Then ans = MsgBox("出错了，请选择象限", 48, "提示信息"> End If
Dim a, b, c, d, n, m As Integer
Dim r As Single
a = Val(Text1.Text>
b = Val(Text2.Text>
c = Val(Text3.Text>
d = Val(Text4.Text>
n = a * a + b * b
m = c * c + d * d
r = 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 < c And b > d> Then
GoTo ww1
ElseIf n <> m Then
GoTo ww2
End If
End If
If Option2.Value = True Then
If Not (a >= 0 And b <= 0 And c >= 0 And d <= 0> Then
GoTo ww
ElseIf Not (a < c And b < d> Then
GoTo ww1
ElseIf n <> m Then
GoTo ww2
End If
End If
GoTo ww4
ww: ans = MsgBox("出错了，逆圆弧起点、终点不在该象限，请重新输入", 48, "提示信息">
GoTo ww3
ww1: ans = MsgBox("出错了，逆圆弧起点、终点位置错误，请重新输入", 48, "提示信息"> GoTo ww3
ww2: ans = MsgBox("出错了，该象限所绘圆弧不以原点为圆心，请重新输入", 48, "提示信息">
ww3: Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text1.SetFocus
GoTo ww4
ww4:
End Sub
Private Sub Command4_Click(>
If Not (Option1.Value = True Or Option2.Value = True> Then
ans = MsgBox("出错了，请选择象限", 48, "提示信息">
End If
Dim a, b, c, d, n, m As Integer
Dim r As Single
a = Val(Text1.Text>
b = Val(Text2.Text>
c = Val(Text3.Text>
d = Val(Text4.Text>
n = a * a + b * b
m = c * c + d * d
r = 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 < c And b > d> Then
GoTo ww1
ElseIf n <> m Then
GoTo ww2
End If
End If
If Option2.Value = True Then
If Not (a >= 0 And b <= 0 And c >= 0 And d <= 0> Then
GoTo ww
ElseIf Not (a < c And b < d> Then
GoTo ww1
ElseIf n <> m Then
GoTo ww2
End If
End If
Picture1.ForeColor = vbBlue
Picture1.DrawWidth = 2
If 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 If
End If
If 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 If
End If
GoTo ww4
ww: ans = MsgBox("出错了，逆圆弧起点、终点不在该象限，请重新输入", 48, "提示信息">
GoTo ww3
ww1: ans = MsgBox("出错了，逆圆弧起点、终点位置错误，请重新输入", 48, "提示信息"> GoTo ww3
ww2: ans = MsgBox("出错了，该象限所绘圆弧不以原点为圆心，请重新输入", 48, "提示信息">
ww3: Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text1.SetFocus
GoTo ww4
ww4:
End Sub
Private 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 Integer
a = Int(Text1>
b = Int(Text2>
c = Int(Text3>
d = Int(Text4>
m = 0
l = 0
k = 0
F(m> = 0
X(m> = a
Y(m> = b
Picture1.ForeColor = vbGreen
Picture1.DrawWidth = 3
j = Abs(Abs(a> - Abs(c>> + Abs(Abs(b> - Abs(d>>
Form1.CurrentX = 200
Form1.CurrentY = 200
Print "初始", "进给方向 ", "F(0>=0", " X(0> =" & Int(Text1>, " Y(0>=" & Int(Text2>, " Xe = " & Int(Text4>, " Ye = " & Int(Text3>, " ∑ = " & j
If Option1.Value = True Then '第三象限插补
For n = 1 To j
If F(m> >= 0 And j > 0 Then
m = 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 = 200
Form1.CurrentY = 200 + m * 300
Print "第" & m & "步", " -△X ", "F(" & m & ">=" & F(m>, " X(" & m & ">=" & X(m>, " Y(" & m & ">=" & Y(m>, " Xe = " & Int(Text4>, " Ye = " & Int(Text3>, " ∑ = " & j - n
Else
k = k + 1
m = m + 1
F(m> = F(m - 1> + 2 * Abs(Y(m - 1>> + 1
Y(m> = Y(m - 1> - 1
X(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 = 200
Form1.CurrentY = 200 + m * 300
Print "第" & m & "步", " +△Y ", "F(" & m & ">=" & F(m>, " X(" & m & ">=" & X(m>, " Y(" & m & ">=" & Y(m>, " Xe = " & Int(Text4>, " Ye = " & Int(Text3>, " ∑ = " & j - n。

"" End If
Next n
ElseIf Option2.Value = True Then '第四象限插补
For n = 1 To j
If F(m> >= 0 And j > 0 Then
m = 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 = 200
Form1.CurrentY = 200 + m * 300
Print "第" & m & "步", " -△Y ", "F(" & m & ">=" & F(m>, " X(" & m & ">=" & X(m>, " Y(" & m & ">=" & Y(m>, " Xe = " & Int(Text4>, " Ye = " & Int(Text3>, " ∑ = " & j - n
Else
l = l + 1
m = m + 1
F(m> = F(m - 1> + 2 * Abs(X(m - 1>> + 1
Y(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 = 200
Form1.CurrentY = 200 + m * 300
Print "第" & m & "步", " +△X ", "F(" & m & ">=" & F(m>, " X(" & m & ">=" & X(m>, " Y(" & m & ">=" & Y(m>, " Xe = " & Int(Text4>, " Ye = " & Int(Text3>, " ∑ = " & j - n
End If
Next n
End If
End Sub
Private Sub Command3_Click(> '清除
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Picture1.Cls
Form1.Cls
Text1.SetFocus
申明：
所有资料为本人收集整理，仅限个人学习使用，勿做商业用途。