完整版基于vb的直线插补与圆弧插补实验.docx

1、完整版基于vb的直线插补与圆弧插补实验主界面面板逐点比较圆弧插补程序如下：Private Sub Command1_Click()Xe = Val(Text1.Text)Ye = Val(Text2.Text)Picture1.Scale (-20, 20)-(20, -20)Picture1.ClsPicture1.Line (-20, 0)-(20, 0), vbBluePicture1.Line (19, 1)-(20, 0), vbbiuePicture1.Line -(19, -1), vbBluePicture1.Print XPicture1.Line (0, -20)-(0,

2、20), vbBluePicture1.Line (1, 19)-(0, 20), vbBluePicture1.Line -(-1, 19), vbBluePicture1.Print YPicture1.Line (0, 0)-(Xe, Ye), vbBluePicture1.Print (; Xe; ,; Ye; )If Text1.Text = none Or Text2.Text = none Then MsgBox 请输入加工终点坐标值。Text3.Text = 0Text4.Text = 0Text5.Text = 0End SubPrivate Sub Command2_Cli

3、ck()Dim sum As IntegerXe = Val(Text1.Text)Ye = Val(Text2.Text)Xm = Val(Text3.Text)Ym = Val(Text4.Text)m = Val(Text5.Text)sum = Xe * Ym - Xm * Ye第一象限开始If Xe 0 And Ye 0 And sum = 0 Then Picture1.Line (Xm, Ym)-(Xm + 1, Ym), vbRed: Text3.Text = Xm + 1If Xe 0 And Ye 0 And sum = Abs(Xe) + Abs(Ye) - 1 Then

4、 MsgBox 加工完毕！第二象限开始If Xe 0 And sum = 0 Then Picture1.Line (Xm, Ym)-(Xm, Ym + 1), vbRed: Text4.Text = Ym + 1If Xe 0 And sum = Abs(Xe) + Abs(Ye) + 1 Then MsgBox 加工完毕！第三象限开始If Xe 0 And Ye = 0 Then Picture1.Line (Xm, Ym)-(Xm - 1, Ym), vbRed: Text3.Text = Xm - 1If Xe 0 And Ye 0 And sum = Abs(Xe) + Abs(Ye

5、) Then MsgBox 加工完毕！第四象限开始If Xe 0 And Ye = 0 Then Picture1.Line (Xm, Ym)-(Xm, Ym - 1), vbRed: Text4.Text = Ym - 1If Xe 0 And Ye 0 And sum = Abs(Xe) + Abs(Ye) Then MsgBox 加工完毕！Text5.Text = Abs(Val(Text3.Text) + Abs(Val(Text4.Text)End SubPrivate Sub Command3_Click()Form2.HideForm1.ShowEnd Sub数字积分器法圆弧插补

6、程序如下：Private Sub Command1_Click()Xe = Val(Text1.Text)Ye = Val(Text2.Text)Picture1.Scale (-20, 20)-(20, -20)Picture1.ClsPicture1.Line (-20, 0)-(20, 0), vbBluePicture1.Line (19, 1)-(20, 0), vbbiuePicture1.Line -(19, -1), vbBluePicture1.Print XPicture1.Line (0, -20)-(0, 20), vbBluePicture1.Line (1, 19)

7、-(0, 20), vbBluePicture1.Line -(-1, 19), vbBluePicture1.Print YPicture1.Line (0, 0)-(Xe, Ye), vbBluePicture1.Print (; Xe; ,; Ye; )Text3.Text = 0Text4.Text = 0Text5.Text = 0Text6.Text = 0Text7.Text = 0End SubPrivate Sub Command2_Click()Xe = Val(Text1.Text)Ye = Val(Text2.Text)ax = Val(Text3.Text)ay =

8、Val(Text4.Text)n = Val(Text7.Text)Xm = Val(Text5.Text)Ym = Val(Text6.Text)If Text1.Text = none Or Text2.Text = none Then MsgBox 请输入加工终点坐标值。终点判断a = ax + Abs(Xe)If a = 16 Then Text3.Text = a - 16If a = 32 Then Text3.Text = a - 32b = ay + Abs(Ye)If b = 16 Then Text4.Text = b - 16If b = 32 Then Text4.Te

9、xt = b - 32第一象限开始If Xe 0 And Ye 0 And a = 16 And b 0 And Ye 0 And a = 16 And b = 16 Then Picture1.Line (Xm, Ym)-(Xm + 1, Ym + 1), vbRed: Text7.Text = n + 2: Text5.Text = Xm + 1: Text6.Text = Ym + 1If Xe 0 And Ye 0 And a = 16 Then Picture1.Line (Xm, Ym)-(Xm, Ym + 1), vbRed: Text7.Text = n + 1: Text6.

10、Text = Ym + 1If n = Abs(Xe) + Abs(Ye) Then MsgBox 错误：已经加工完毕，无法继续加工，请点击复位！第二象限开始If Xe 0 And a = 16 And b 16 Then Picture1.Line (Xm, Ym)-(Xm - 1, Ym), vbRed: Text7.Text = n + 1: Text5.Text = Xm - 1If Xe 0 And a = 16 And b = 16 Then Picture1.Line (Xm, Ym)-(Xm - 1, Ym + 1), vbRed: Text7.Text = n + 2: Te

11、xt5.Text = Xm - 1: Text6.Text = Ym + 1If Xe 0 And a = 16 Then Picture1.Line (Xm, Ym)-(Xm, Ym + 1), vbRed: Text7.Text = n + 1: Text6.Text = Ym + 1第三象限开始If Xe 0 And Ye = 16 And b 16 Then Picture1.Line (Xm, Ym)-(Xm - 1, Ym), vbRed: Text7.Text = n + 1: Text5.Text = Xm - 1If Xe 0 And Ye = 16 And b = 16 T

12、hen Picture1.Line (Xm, Ym)-(Xm - 1, Ym - 1), vbRed: Text7.Text = n + 2: Text5.Text = Xm - 1: Text6.Text = Ym - 1If Xe 0 And Ye 0 And a = 16 Then Picture1.Line (Xm, Ym)-(Xm, Ym - 1), vbRed: Text7.Text = n + 1: Text6.Text = Ym - 1第四象限开始If Xe 0 And Ye = 16 And b 0 And Ye = 16 And b = 16 Then Picture1.L

13、ine (Xm, Ym)-(Xm + 1, Ym - 1), vbRed: Text7.Text = n + 2: Text5.Text = Xm + 1: Text6.Text = Ym - 1If Xe 0 And Ye 0 And a = 16 Then Picture1.Line (Xm, Ym)-(Xm, Ym - 1), vbRed: Text7.Text = n + 1: Text6.Text = Ym - 1结束If n = Abs(Xe) + Abs(Ye) Then Text7.Text = Abs(Xe) + Abs(Ye)If n = Abs(Xe) + Abs(Ye)

14、 - 1 And a = 16 Then MsgBox 加工完毕！If n = Abs(Xe) + Abs(Ye) - 1 And b = 16 Then MsgBox 加工完毕！If n = Abs(Xe) + Abs(Ye) - 2 And a = 16 And b = 16 Then MsgBox 加工完毕！End SubPrivate Sub Command3_Click()Form3.HideForm1.ShowEnd Sub逐点比较圆弧插补程序如下：Dim R, a, b, Ym, Xm, Xe, YePrivate Sub Command1_Click()R = Val(Text

15、1.Text)a = Val(Text2.Text)b = Val(Text3.Text)Xe = Val(Text4.Text)Ye = Val(Text5.Text)Xm = Val(Text6.Text)Ym = Val(Text7.Text)Picture1.Scale (-Picture1.ScaleWidth / 4, Picture1.ScaleHeight / 4)-(Picture1.ScaleWidth / 4, -Picture1.ScaleHeight / 4)Picture1.ClsPicture1.Line (-20, 0)-(20, 0), vbBluePictu

16、re1.Line (19, 1)-(20, 0), vbbiuePicture1.Line -(19, -1), vbBluePicture1.Print XPicture1.Line (0, -20)-(0, 20), vbBluePicture1.Line (1, 19)-(0, 20), vbBluePicture1.Line -(-1, 19), vbBluePicture1.Print YPicture1.Circle (0, 0), Text1, vbBlue, Text2, Text3Picture1.Print (; Xe; ,; Ye; )Text1.Text = Text2

17、.Text = Text3.Text = Text6.Text = Text7.Text = End SubPrivate Sub Command2_Click()Dim sum As Single, Y, XIf Option1 Then 逆圆弧 Y = Sqr(R 2 - Xm 2) X = Sqr(R 2 - Ym 2) If Xm = R And Ym = 0 Then 一象限 Picture1.Line (Xm, Ym)-(Xm, Ym + 1), vbRed: Ym = Ym + 1 Text7.Text = Ym + 1 End If If Xm 0 And Ym 0 Then

18、If Xm = X Then Picture1.Line (Xm, Ym)-(Xm - 1, Ym), vbRed: Text6.Text = Xm - 1: Xm = Xm - 1 Else If Ym Y Then Picture1.Line (Xm, Ym)-(Xm, Ym + 1), vbRed: Text7.Text = Ym + 1: Ym = Ym + 1 End If End If End IfIf Xm = Xe And Ym = Ye Then MsgBox 加工完成！End IfIf Xm = 0 And Ym = R Then 二象限 Picture1.Line (Xm

19、, Ym)-(Xm - 1, Ym), vbRed: Xm = Xm - 1 Text6.Text = Xm - 1End IfIf Xm 0 Then If Ym = Y Then Picture1.Line (Xm, Ym)-(Xm, Ym - 1), vbRed: Ym = Ym - 1: Text7.Text = Ym - 1 Else If Xm -X Then Picture1.Line (Xm, Ym)-(Xm - 1, Ym), vbRed: Xm = Xm - 1: Text6.Text = Xm - 1 End If End IfEnd IfIf Xm = Xe And Y

20、m = Ye Then MsgBox 加工完成！End If If Xm = -R And Ym = 0 Then 三象限 Picture1.Line (Xm, Ym)-(Xm, Ym - 1), vbRed: Ym = Ym - 1 Text7.Text = Ym - 1End IfIf Xm 0 And Ym 0 Then If Ym -X Then Picture1.Line (Xm, Ym)-(Xm, Ym - 1), vbRed: Ym = Ym - 1: Text7.Text = Ym - 1 End If End IfEnd IfIf Xm = Xe And Ym = Ye Th

21、en MsgBox 加工完成！End IfIf Xm = 0 And Ym = -R Then 四象限 Picture1.Line (Xm + 1, Ym)-(Xm, Ym), vbRed: Xm = Xm + 1: Text6.Text = Xm + 1End IfIf Xm 0 And Ym 0 Then If Ym -Y Then Picture1.Line (Xm, Ym)-(Xm, Ym + 1), vbRed: Ym = Ym + 1: Text7.Text = Ym + 1 Else If Xm 0 And Ym 0 Then If Ym Y Then Picture1.Line

22、 (Xm, Ym)-(Xm, Ym - 1), vbRed: Ym = Ym - 1: Text7.Text = Ym - 1 Else If Xm X Then Picture1.Line (Xm, Ym)-(Xm + 1, Ym), vbRed: Xm = Xm + 1: Text6.Text = Xm + 1 End If End IfEnd IfIf Xm = Xe And Ym = Ye Then MsgBox 加工完成！End IfIf Xm = -R And Ym = 0 Then 第二象限 Picture1.Line (Xm, Ym)-(Xm, Ym + 1), vbRed:

23、Ym = Ym + 1: Text7.Text = Ym + 1End IfIf Xm 0 Then If Ym Y Then Picture1.Line (Xm, Ym)-(Xm, Ym + 1), vbRed: Ym = Ym + 1: Text7.Text = Ym + 1 Else If Xm -X Then Picture1.Line (Xm, Ym)-(Xm + 1, Ym), vbRed: Xm = Xm + 1: Text6.Text = Xm + 1 End If End IfEnd IfIf Xm = Xe And Ym = Ye Then MsgBox 加工完成！End

24、IfIf Xm = 0 And Ym = -R Then 第三象限 Picture1.Line (Xm, Ym)-(Xm - 1, Ym), vbRed: Xm = Xm - 1: Text6.Text = Xm - 1End IfIf Xm 0 And Ym 0 Then If Ym -X Then Picture1.Line (Xm, Ym)-(Xm - 1, Ym), vbRed: Xm = Xm - 1: Text6.Text = Xm - 1 End If End IfEnd IfIf Xm = Xe And Ym = Ye Then MsgBox 加工完成！End IfIf Xm

25、= R And Ym = 0 Then 第四象限 Picture1.Line (Xm, Ym)-(Xm, Ym - 1), vbRed: Ym = Ym - 1: Text7.Text = Ym - 1End IfIf Xm 0 And Ym X Then Picture1.Line (Xm, Ym)-(Xm - 1, Ym), vbRed: Xm = Xm - 1: Text6.Text = Xm - 1 Else If Ym -Y Then Picture1.Line (Xm, Ym)-(Xm, Ym - 1), vbRed: Ym = Ym - 1: Text7.Text = Ym - 1 End If End IfEnd IfIf Xm = Xe And Ym = Ye Then MsgBox 加工完成！End IfEnd IfEnd SubPrivate Sub Command3_Click()Form4.HideForm1.ShowEnd Sub数字积分器法圆弧插补程序如下：Dim R, a, b, Ym, Xm, Xe, Ye, ax, ay, m, n, s, tPrivate Sub Command1_Click()R = Val(Text1.Text)a = Val(Text2.Text)b = Val(Text3.Te