逐点比较法圆弧插补代码VB.doc

VB界面：

直线插补和圆弧插补的程序代码：

Dimx1%,y1%,x2%,y2%,p!
DimDiAsInteger
ConstPI=3.14159

PrivateSubcmdShow_Click()
x1=Val(Text1(0)):y1=Val(Text1(1))
x2=Val(Text1(2)):y2=Val(Text1(3))
pic.Cls
axispic
p=Val(Combo1.Text)
cmdShow.Enabled=False
IfOption1.ValueThen
pic.Circle(x1,y1),0.1,vbBlack
pic.Circle(x2,y2),0.1,vbBlack
zhixianpic,x1,y1,x2,y2
ElseIfOption2.ValueThen
pic.Circle(x1,y1),0.1,vbBlack
pic.Circle(x2,y2),0.1,vbBlack
Ifx1^2+y1^2=x2^2+y2^2Then
yuanhupic,x1,y1,x2,y2
Else
MsgBox"ERROR！请重新输入！",vbCritical
EndIf
EndIf
cmdShow.Enabled=True
EndSub

PrivateSubzhixian(objAsObject,xi%,yi%,xj%,yj%)
Dimx!,y!
f=0
x=xi:y=yi
obj.Line(xi,yi)-(xj,yj),vbBlack
obj.CurrentX=x
obj.CurrentY=y
n=(Abs(xj-xi)+Abs(yj-yi))/p
Whilen<>0
Iff>=0Then
Ifxj<>xiThen
x=x+(xj-xi)/Abs(xj-xi)*p
Else
y=y+(yj-yi)/Abs(yj-yi)*p
EndIf
f=f-Abs(yj-yi)
Else
Ifyj<>yiThen
y=y+(yj-yi)/Abs(yj-yi)*p
EndIf
f=f+Abs(xj-xi)
EndIf
obj.Line-(x,y),vbRed
n=n-1
DoEvents
Fori=1To2000000*p
Nexti
Wend
EndSub
PrivateSubForm_Load()
IfApp.PrevInstanceThenEnd
Combo1.Text=Combo1.List(6)
pic.Height=460
pic.Width=460
pic.Scale(-12,12)-(12,-12)
axispic
EndSub
PrivateSubaxis(objAsObject)
obj.Line(-obj.ScaleWidth/2+0.5,0)-(obj.ScaleWidth/2-0.5,0)
obj.Line-(obj.ScaleWidth/2-1,0.2)
obj.Line(obj.ScaleWidth/2-0.5,0)-(obj.ScaleWidth/2-1,-0.2)
obj.Line(0,obj.ScaleHeight/2+0.5)-(0,-obj.ScaleHeight/2-0.5)
obj.Line-(-0.2,-obj.ScaleHeight/2-1)
obj.Line(0,-obj.ScaleHeight/2-0.5)-(0.2,-obj.ScaleHeight/2-1)
obj.Font.Size=9
Forcx=-10To10Step1
obj.Line(cx,0)-(cx,0.2)
Ifcx<>0Then
obj.CurrentX=cx-0.3
obj.CurrentY=-0.2
obj.Printcx
EndIf
Next
Forcy=-10To10Step1
obj.Line(0,cy)-(0.2,cy)
Ifcy<>0Then
obj.CurrentX=-0.8
obj.CurrentY=cy+0.2
obj.Printcy
EndIf
Next
obj.CurrentX=-0.5
obj.CurrentY=-0.2
obj.Font.Size=9
obj.Print"O"

EndSub
PrivateSubyuanhu(objAsObject,xi%,yi%,xj%,yj%)
n=Abs(xj-xi)+Abs(yj-yi):n=n/p
f=0
r=Sqr(xi^2+yi^2)
Ifxi<>0Then
startP=Atn(yi/xi)
Else
startP=PI/2
EndIf
Ifxj<>0Then
endP=Atn(yj/xj)
Else
endP=PI/2
EndIf
Ifxi<=xjThen
Di=-1
obj.Circle(0,0),r,vb