数控实验指导书逐点比较法直线插补程序Word格式.docx
《数控实验指导书逐点比较法直线插补程序Word格式.docx》由会员分享，可在线阅读，更多相关《数控实验指导书逐点比较法直线插补程序Word格式.docx（18页珍藏版）》请在冰点文库上搜索。
BeginVB.FormForm1
AutoRedraw=-1'
True
BorderStyle=1'
FixedSingle
Caption="
插补"
ClientHeight=7755
ClientLeft=90
ClientTop=480
ClientWidth=9630
LinkTopic="
Form1"
MaxButton=0'
False
MinButton=0'
ScaleHeight=517
ScaleMode=3'
Pixel
ScaleWidth=642
StartUpPosition=2'
屏幕中心
BeginVB.FrameFrame5
Height=975
Left=7320
TabIndex=15
Top=4440
Width=2175
BeginVB.LineLine5
BorderColor=&
H000000FF&
X1=120
X2=1080
Y1=360
Y2=360
End
BeginVB.LineLine6
H00FF0000&
Y1=720
Y2=720
BeginVB.LabelLabel2
插补路线"
Height=255
Left=1200
TabIndex=17
Top=240
Width=855
BeginVB.LabelLabel3
理想路线"
TabIndex=16
Top=600
BeginVB.FrameFrame4
插补选择"
Height=735
TabIndex=5
Top=3480
BeginVB.OptionButtonOption2
圆弧"
Height=180
TabIndex=7
Top=360
Width=735
BeginVB.OptionButtonOption1
直线"
Left=240
TabIndex=6
Value=-1'
BeginVB.ComboBoxCombo1
Height=300
Left=8400
Style=2'
DropdownList
TabIndex=13
Top=5760
Width=1095
BeginVB.PictureBoxpic
BackColor=&
H00FFFFFF&
BorderStyle=0'
None
FillStyle=0'
Solid
Height=6750
ScaleHeight=450
ScaleWidth=450
TabIndex=9
Top=840
Width=6750
BeginVB.FrameFrame3
Height=2415
TabIndex=1
BeginVB.FrameFrame2
终点坐标"
Height=855
Left=120
TabIndex=4
Top=1320
Width=1935
BeginVB.TextBoxText1
Height=375
Index=3
Left=1080
MaxLength=2
TabIndex=12
Text="
0"
Width=615
Index=2
TabIndex=11
BeginVB.FrameFrame1
起点坐标"
TabIndex=2
Index=1
TabIndex=10
Index=0
TabIndex=3
BeginVB.CommandButtoncmdShow
开始演示"
Left=7680
TabIndex=0
Top=6720
BeginVB.LabelLabel4
脉冲当量：
"
TabIndex=14
Top=5880
BeginVB.LabelLabel1
逐点比较插补法演示程序"
BeginPropertyFont
Name="
宋体"
Size=18
Charset=134
Weight=400
Underline=0'
Italic=0'
Strikethrough=0'
EndProperty
Left=1920
TabIndex=8
Visible=0'
Width=3975
End
AttributeVB_Name="
AttributeVB_GlobalNameSpace=False
AttributeVB_Creatable=False
AttributeVB_PredeclaredId=True
AttributeVB_Exposed=False
'
OptionExplicit
起点坐标，终点坐标，脉冲当量
Dimx1%,y1%,x2%,y2%,p!
DimDiAsInteger'
-1为顺时针，1为逆时针
ConstPI=3.14159
PrivateSubcmdShow_Click（）
IfText1（0）<
>
"
AndText1
（1）<
And_
Text1
（2）<
AndText1（3）<
Then
x1=Val（Text1（0））:
y1=Val（Text1
（1））
x2=Val（Text1
（2））:
y2=Val（Text1（3））
Else
MsgBox"
输入坐标不完整!
ExitSub
EndIf
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
chabu_lpic,x1,y1,x2,y2
ElseIfOption2.ValueThen'
圆弧插补
Ifx1^2+y1^2=x2^2+y2^2Then
chabu_c1pic,x1,y1,x2,y2
Else
输入坐标错误！
请重新输入！
vbCritical
EndIf
cmdShow.Enabled=True
EndSub
PrivateSubchabu_l（objAsObject,x0%,y0%,xe%,ye%）'
直线插补
Dimx!
y!
f=0
x=x0:
y=y0
obj.Line（x0,y0）-（xe,ye）,vbBlue
obj.CurrentX=x
obj.CurrentY=y
n=（Abs（xe-x0）+Abs（ye-y0））/p'
总步数
Whilen<
0
Iff>
=0Then
Ifxe<
x0Then
x=x+Sgn（xe-x0）*p
Else'
xe=0时，应该先向y轴运动
y=y+Sgn（ye-y0）*p
f=f-Abs（ye-y0）
Ifye<
y0Then
f=f+Abs（xe-x0）
obj.Line-（x,y）,vbRed'
画折线
n=n-1
DoEvents
Fori=1To2000000*p
'
延时
Nexti
Wend
PrivateSubForm_Load（）
IfApp.PrevInstanceThenEnd'
禁止两个程序同时运行
Combo1.AddItem"
0.01"
0.02"
0.05"
0.1"
0.2"
0.5"
1"
Show
st="
Me.Font.Size=24
x=（Me.ScaleWidth-Me.TextWidth（st））/2
y=10'
（pic.Top-Me.TextWidth（St））/2
Randomize
Fori=1To10
CurrentX=x:
CurrentY=y
Me.ForeColor=Rnd*65535
Printst
x=x+0.6
y=y+0.4
Nexti
Combo1.Text=Combo1.List（5）
pic.Height=450
pic.Width=450
pic.Scale（-10,10）-（10,-10）
**********************************************************************
PrivateSubaxis（objAsObject）
画x轴
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）
画y轴
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=-9To9Step3
obj.Line（cx,0）-（cx,0.2）
Ifcx<
0Then
obj.CurrentX=cx-0.3
obj.CurrentY=-0.2
obj.Printcx
Next
Forcy=-9To9Step3
obj.Line（0,cy）-（0.2,cy）
Ifcy<
obj.CurrentX=-0.8
obj.CurrentY=cy+0.2
obj.Printcy
obj.CurrentX=-0.5
obj.CurrentY=-0.2
obj.Font.Size=12
obj.Print"
O"
坐标原点
*********************************************************************
PrivateSubchabu_c1（objAsObject,x0%,y0%,xe%,ye%）
第一象限圆弧插补
n=Abs（xe-x0）+Abs（ye-y0）:
n=n/p'
r=Sqr（x0^2+y0^2）
Ifx0<
startP=Atn（y0/x0）
startP=PI/2
Ifxe<
endP=Atn（ye/xe）
endP=PI/2
=xeThen
Di=-1'
顺时针
obj.Circle（0,0）,r,vbBlue,endP,startP
Di=1
obj.Circle（0,0）,r,vbBlue,startP,endP
obj.CurrentX=x0
obj.CurrentY=y0
Iff*Di>
f=f-2*x*Di+p
x=x-p*Di
ElseIff*Di<
f=f+2*y*Di+p
y=y+p*Di
ElseIff*Di=0Then
IfDi=1Then
y=y+p
obj.Line-（x,y）,vbRed
PrivateSubText1_Change（IndexAsInteger）
IfAbs（Val（Text1（Index）.Text））>
9Then
输入数值过大，屏幕内不能完全显示！
Text1（Index）.Text="
IfLeft（Text1（Index）,1）="
AndLen（Text1（Index））=2Then
Text1（Index）=Right（Text1（Index）,1）
IfRight（Text1（Index）,1）="
-"
Text1（Index）=Left（Text1（Index）,1）
PrivateSubText1_Click（IndexAsInteger）
Text1（Index）.SelStart=0
Text1（Index）.SelLength=Len（Text1（Index））
PrivateSubText1_KeyPress（IndexAsInteger,KeyAsciiAsInteger）
只能输入数字，负号
If（KeyAscii<
48OrKeyAscii>
57）AndKeyAscii<
45_
AndKeyAscii<
8Then
KeyAscii=0
升级会员 