完整版基于vb的直线插补与圆弧插补实验.docx
《完整版基于vb的直线插补与圆弧插补实验.docx》由会员分享，可在线阅读，更多相关《完整版基于vb的直线插补与圆弧插补实验.docx（23页珍藏版）》请在冰豆网上搜索。
完整版基于vb的直线插补与圆弧插补实验
主界面面板
逐点比较圆弧插补
程序如下：
PrivateSubCommand1_Click（）
Xe=Val（Text1.Text）
Ye=Val（Text2.Text）
Picture1.Scale（-20,20）-（20,-20）
Picture1.Cls
Picture1.Line（-20,0）-（20,0）,vbBlue
Picture1.Line（19,1）-（20,0）,vbbiue
Picture1.Line-（19,-1）,vbBlue
Picture1.Print"X"
Picture1.Line（0,-20）-（0,20）,vbBlue
Picture1.Line（1,19）-（0,20）,vbBlue
Picture1.Line-（-1,19）,vbBlue
Picture1.Print"Y"
Picture1.Line（0,0）-（Xe,Ye）,vbBlue
Picture1.Print"（";Xe;",";Ye;"）"
IfText1.Text=noneOrText2.Text=noneThenMsgBox"请输入加工终点坐标值。
"
Text3.Text=0
Text4.Text=0
Text5.Text=0
EndSub
PrivateSubCommand2_Click（）
DimsumAsInteger
Xe=Val（Text1.Text）
Ye=Val（Text2.Text）
Xm=Val（Text3.Text）
Ym=Val（Text4.Text）
m=Val（Text5.Text）
sum=Xe*Ym-Xm*Ye
'第一象限开始
IfXe>0AndYe>0Andsum>=0ThenPicture1.Line（Xm,Ym）-（Xm+1,Ym）,vbRed:
Text3.Text=Xm+1
IfXe>0AndYe>0Andsum<0ThenPicture1.Line（Xm,Ym）-（Xm,Ym+1）,vbRed:
Text4.Text=Ym+1
IfAbs（Xm）+Abs（Ym）>=Abs（Xe）+Abs（Ye）-1ThenMsgBox"加工完毕！
"
'第二象限开始
IfXe<0AndYe>0Andsum>=0ThenPicture1.Line（Xm,Ym）-（Xm,Ym+1）,vbRed:
Text4.Text=Ym+1
IfXe<0AndYe>0Andsum<0ThenPicture1.Line（Xm,Ym）-（Xm-1,Ym）,vbRed:
Text3.Text=Xm-1
IfAbs（Xm）+Abs（Ym）>=Abs（Xe）+Abs（Ye）+1ThenMsgBox"加工完毕！
"
'第三象限开始
IfXe<0AndYe<0Andsum>=0ThenPicture1.Line（Xm,Ym）-（Xm-1,Ym）,vbRed:
Text3.Text=Xm-1
IfXe<0AndYe<0Andsum<0ThenPicture1.Line（Xm,Ym）-（Xm,Ym-1）,vbRed:
Text4.Text=Ym-1
IfAbs（Xm）+Abs（Ym）>=Abs（Xe）+Abs（Ye）ThenMsgBox"加工完毕！
"
'第四象限开始
IfXe>0AndYe<0Andsum>=0ThenPicture1.Line（Xm,Ym）-（Xm,Ym-1）,vbRed:
Text4.Text=Ym-1
IfXe>0AndYe<0Andsum<0ThenPicture1.Line（Xm,Ym）-（Xm+1,Ym）,vbRed:
Text3.Text=Xm+1
IfAbs（Xm）+Abs（Ym）>=Abs（Xe）+Abs（Ye）ThenMsgBox"加工完毕！
"
Text5.Text=Abs（Val（Text3.Text））+Abs（Val（Text4.Text））
EndSub
PrivateSubCommand3_Click（）
Form2.Hide
Form1.Show
EndSub
数字积分器法圆弧插补
程序如下：
PrivateSubCommand1_Click（）
Xe=Val（Text1.Text）
Ye=Val（Text2.Text）
Picture1.Scale（-20,20）-（20,-20）
Picture1.Cls
Picture1.Line（-20,0）-（20,0）,vbBlue
Picture1.Line（19,1）-（20,0）,vbbiue
Picture1.Line-（19,-1）,vbBlue
Picture1.Print"X"
Picture1.Line（0,-20）-（0,20）,vbBlue
Picture1.Line（1,19）-（0,20）,vbBlue
Picture1.Line-（-1,19）,vbBlue
Picture1.Print"Y"
Picture1.Line（0,0）-（Xe,Ye）,vbBlue
Picture1.Print"（";Xe;",";Ye;"）"
Text3.Text=0
Text4.Text=0
Text5.Text=0
Text6.Text=0
Text7.Text=0
EndSub
PrivateSubCommand2_Click（）
Xe=Val（Text1.Text）
Ye=Val（Text2.Text）
ax=Val（Text3.Text）
ay=Val（Text4.Text）
n=Val（Text7.Text）
Xm=Val（Text5.Text）
Ym=Val（Text6.Text）
IfText1.Text=noneOrText2.Text=noneThenMsgBox"请输入加工终点坐标值。
"
'终点判断
a=ax+Abs（Xe）
Ifa<16ThenText3.Text=a
Ifa>=16ThenText3.Text=a-16
Ifa>=32ThenText3.Text=a-32
b=ay+Abs（Ye）
Ifb<16ThenText4.Text=b
Ifb>=16ThenText4.Text=b-16
Ifb>=32ThenText4.Text=b-32
'第一象限开始
IfXe>0AndYe>0Anda>=16Andb<16ThenPicture1.Line（Xm,Ym）-（Xm+1,Ym）,vbRed:
Text7.Text=n+1:
Text5.Text=Xm+1
IfXe>0AndYe>0Anda>=16Andb>=16ThenPicture1.Line（Xm,Ym）-（Xm+1,Ym+1）,vbRed:
Text7.Text=n+2:
Text5.Text=Xm+1:
Text6.Text=Ym+1
IfXe>0AndYe>0Anda<16Andb>=16ThenPicture1.Line（Xm,Ym）-（Xm,Ym+1）,vbRed:
Text7.Text=n+1:
Text6.Text=Ym+1
Ifn=Abs（Xe）+Abs（Ye）ThenMsgBox"错误：
已经加工完毕，无法继续加工，请点击复位！
"
'第二象限开始
IfXe<0AndYe>0Anda>=16Andb<16ThenPicture1.Line（Xm,Ym）-（Xm-1,Ym）,vbRed:
Text7.Text=n+1:
Text5.Text=Xm-1
IfXe<0AndYe>0Anda>=16Andb>=16ThenPicture1.Line（Xm,Ym）-（Xm-1,Ym+1）,vbRed:
Text7.Text=n+2:
Text5.Text=Xm-1:
Text6.Text=Ym+1
IfXe<0AndYe>0Anda<16Andb>=16ThenPicture1.Line（Xm,Ym）-（Xm,Ym+1）,vbRed:
Text7.Text=n+1:
Text6.Text=Ym+1
'第三象限开始
IfXe<0AndYe<0Anda>=16Andb<16ThenPicture1.Line（Xm,Ym）-（Xm-1,Ym）,vbRed:
Text7.Text=n+1:
Text5.Text=Xm-1
IfXe<0AndYe<0Anda>=16Andb>=16ThenPicture1.Line（Xm,Ym）-（Xm-1,Ym-1）,vbRed:
Text7.Text=n+2:
Text5.Text=Xm-1:
Text6.Text=Ym-1
IfXe<0AndYe<0Anda<16Andb>=16ThenPicture1.Line（Xm,Ym）-（Xm,Ym-1）,vbRed:
Text7.Text=n+1:
Text6.Text=Ym-1
'第四象限开始
IfXe>0AndYe<0Anda>=16Andb<16ThenPicture1.Line（Xm,Ym）-（Xm+1,Ym）,vbRed:
Text7.Text=n+1:
Text5.Text=Xm+1
IfXe>0AndYe<0Anda>=16Andb>=16ThenPicture1.Line（Xm,Ym）-（Xm+1,Ym-1）,vbRed:
Text7.Text=n+2:
Text5.Text=Xm+1:
Text6.Text=Ym-1
IfXe>0AndYe<0Anda<16Andb>=16ThenPicture1.Line（Xm,Ym）-（Xm,Ym-1）,vbRed:
Text7.Text=n+1:
Text6.Text=Ym-1
'结束
Ifn>=Abs（Xe）+Abs（Ye）ThenText7.Text=Abs（Xe）+Abs（Ye）
Ifn=Abs（Xe）+Abs（Ye）-1Anda>=16ThenMsgBox"加工完毕！
"
Ifn=Abs（Xe）+Abs（Ye）-1Andb>=16ThenMsgBox"加工完毕！
"
Ifn=Abs（Xe）+Abs（Ye）-2Anda>=16Andb>=16ThenMsgBox"加工完毕！
"
EndSub
PrivateSubCommand3_Click（）
Form3.Hide
Form1.Show
EndSub
逐点比较圆弧插补
程序如下：
DimR,a,b,Ym,Xm,Xe,Ye
PrivateSubCommand1_Click（）
R=Val（Text1.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.Cls
Picture1.Line（-20,0）-（20,0）,vbBlue
Picture1.Line（19,1）-（20,0）,vbbiue
Picture1.Line-（19,-1）,vbBlue
Picture1.Print"X"
Picture1.Line（0,-20）-（0,20）,vbBlue
Picture1.Line（1,19）-（0,20）,vbBlue
Picture1.Line-（-1,19）,vbBlue
Picture1.Print"Y"
Picture1.Circle（0,0）,Text1,vbBlue,Text2,Text3
Picture1.Print"（";Xe;",";Ye;"）"
Text1.Text=""
Text2.Text=""
Text3.Text=""
Text6.Text=""
Text7.Text=""
EndSub
PrivateSubCommand2_Click（）
DimsumAsSingle,Y,X
IfOption1Then'逆圆弧
Y=Sqr（R^2-Xm^2）
X=Sqr（R^2-Ym^2）
IfXm=RAndYm=0Then'一象限
Picture1.Line（Xm,Ym）-（Xm,Ym+1）,vbRed:
Ym=Ym+1
Text7.Text=Ym+1
EndIf
IfXm>0AndYm>0Then
IfXm>=XThen
Picture1.Line（Xm,Ym）-（Xm-1,Ym）,vbRed:
Text6.Text=Xm-1:
Xm=Xm-1
Else
IfYmPicture1.Line（Xm,Ym）-（Xm,Ym+1）,vbRed:
Text7.Text=Ym+1:
Ym=Ym+1
EndIf
EndIf
EndIf
IfXm=XeAndYm=YeThen
MsgBox"加工完成！
"
EndIf
IfXm=0AndYm=RThen'二象限
Picture1.Line（Xm,Ym）-（Xm-1,Ym）,vbRed:
Xm=Xm-1
Text6.Text=Xm-1
EndIf
IfXm<0AndYm>0Then
IfYm>=YThen
Picture1.Line（Xm,Ym）-（Xm,Ym-1）,vbRed:
Ym=Ym-1:
Text7.Text=Ym-1
Else
IfXm>-XThen
Picture1.Line（Xm,Ym）-（Xm-1,Ym）,vbRed:
Xm=Xm-1:
Text6.Text=Xm-1
EndIf
EndIf
EndIf
IfXm=XeAndYm=YeThen
MsgBox"加工完成！
"
EndIf
IfXm=-RAndYm=0Then'三象限
Picture1.Line（Xm,Ym）-（Xm,Ym-1）,vbRed:
Ym=Ym-1
Text7.Text=Ym-1
EndIf
IfXm<0AndYm<0Then
IfYm<-YThen
Picture1.Line（Xm,Ym）-（Xm+1,Ym）,vbRed:
Xm=Xm+1:
Text6.Text=Xm+1
Else
IfXm>-XThen
Picture1.Line（Xm,Ym）-（Xm,Ym-1）,vbRed:
Ym=Ym-1:
Text7.Text=Ym-1
EndIf
EndIf
EndIf
IfXm=XeAndYm=YeThen
MsgBox"加工完成！
"
EndIf
IfXm=0AndYm=-RThen'四象限
Picture1.Line（Xm+1,Ym）-（Xm,Ym）,vbRed:
Xm=Xm+1:
Text6.Text=Xm+1
EndIf
IfXm>0AndYm<0Then
IfYm<-YThen
Picture1.Line（Xm,Ym）-（Xm,Ym+1）,vbRed:
Ym=Ym+1:
Text7.Text=Ym+1
Else
IfXmPicture1.Line（Xm,Ym）-（Xm+1,Ym）,vbRed:
Xm=Xm+1:
Text6.Text=Xm+1
EndIf
EndIf
EndIf
IfXm=XeAndYm=YeThen
MsgBox"加工完成！
"
EndIf
EndIf
IfOption2Then'顺圆弧
Y=Sqr（R^2-Xm^2）
X=Sqr（R^2-Ym^2）
IfXm=0AndYm=RThen'第一象限
Picture1.Line（Xm,Ym）-（Xm+1,Ym）,vbRed:
Xm=Xm+1:
Text6.Text=Xm+1
EndIf
IfXm>0AndYm>0Then
IfYm>YThen
Picture1.Line（Xm,Ym）-（Xm,Ym-1）,vbRed:
Ym=Ym-1:
Text7.Text=Ym-1
Else
IfXmPicture1.Line（Xm,Ym）-（Xm+1,Ym）,vbRed:
Xm=Xm+1:
Text6.Text=Xm+1
EndIf
EndIf
EndIf
IfXm=XeAndYm=YeThen
MsgBox"加工完成！
"
EndIf
IfXm=-RAndYm=0Then'第二象限
Picture1.Line（Xm,Ym）-（Xm,Ym+1）,vbRed:
Ym=Ym+1:
Text7.Text=Ym+1
EndIf
IfXm<0AndYm>0Then
IfYmPicture1.Line（Xm,Ym）-（Xm,Ym+1）,vbRed:
Ym=Ym+1:
Text7.Text=Ym+1
Else
IfXm<-XThen
Picture1.Line（Xm,Ym）-（Xm+1,Ym）,vbRed:
Xm=Xm+1:
Text6.Text=Xm+1
EndIf
EndIf
EndIf
IfXm=XeAndYm=YeThen
MsgBox"加工完成！
"
EndIf
IfXm=0AndYm=-RThen'第三象限
Picture1.Line（Xm,Ym）-（Xm-1,Ym）,vbRed:
Xm=Xm-1:
Text6.Text=Xm-1
EndIf
IfXm<0AndYm<0Then
IfYm<-YThen
Picture1.Line（Xm,Ym）-（Xm,Ym+1）,vbRed:
Ym=Ym+1:
Text7.Text=Ym+1
Else
IfXm>-XThen
Picture1.Line（Xm,Ym）-（Xm-1,Ym）,vbRed:
Xm=Xm-1:
Text6.Text=Xm-1
EndIf
EndIf
EndIf
IfXm=XeAndYm=YeThen
MsgBox"加工完成！
"
EndIf
IfXm=RAndYm=0Then'第四象限
Picture1.Line（Xm,Ym）-（Xm,Ym-1）,vbRed:
Ym=Ym-1:
Text7.Text=Ym-1
EndIf
IfXm>0AndYm<0Then
IfXm>XThen
Picture1.Line（Xm,Ym）-（Xm-1,Ym）,vbRed:
Xm=Xm-1:
Text6.Text=Xm-1
Else
IfYm>-YThen
Picture1.Line（Xm,Ym）-（Xm,Ym-1）,vbRed:
Ym=Ym-1:
Text7.Text=Ym-1
EndIf
EndIf
EndIf
IfXm=XeAndYm=YeThen
MsgBox"加工完成！
"
EndIf
EndIf
EndSub
PrivateSubCommand3_Click（）
Form4.Hide
Form1.Show
EndSub
数字积分器法圆弧插补
程序如下：
DimR,a,b,Ym,Xm,Xe,Ye,ax,ay,m,n,s,t
PrivateSubCommand1_Click（）
R=Val（Text1.Text）
a=Val（Text2.Text）
b=Val（Text3.Te
升级会员 