数控122 太劣阿昕哥
四、程序
Public X0 As Double, Y0 As Double, X1 As Double, Y1 As Double, X2 As Double, Y2 As Double, R As Double
Public Xs1 As Double, Ys1 As Double, Xs2 As Double, Ys2 As Double
Public Ori As Integer
Public Xl1 As Double, Yl1 As Double, Xl2 As Double, Yl2 As Double, dX1 As Double, dY1 As Double, dX2 As Double, dY2 As Double, d1 As Double, d2 As Double
Private Sub Command1_Click()
Dim X1_FWD As Integer, Y1_FWD As Integer, X2_FWD As Integer, Y2_FWD As Integer
Dim alfa As Double, beta As Double
Call PaintAxis
'绘制补偿前图像
Picture1.ForeColor = vbBlue
Picture1.DrawWidth = 1
Picture1.Line (X0, Y0)-(X1, Y1)
Picture1.Line (X1, Y1)-(X2, Y2)
'算法设计
'计算坐标增量
dX1 = X1 - X0
dY1 = Y1 - Y0
dX2 = X2 - X1
dY2 = Y2 - Y1
alfa = Atn(dY1 / dX1)
beta = Atn(dY2 / dX2)
If dX1 >= 0 Then
X1_FWD = 1
Else
X1_FWD = -1
End If
If dX2 >= 0 Then
X2_FWD = 1
X2_FWD = -1
End If
If dY1 >= 0 Then
Y1_FWD = 1
Else
Y1_FWD = -1
End If
If dY2 >= 0 Then
Y2_FWD = 1
Else
Y2_FWD = -1
End If
'计算d1,d2
d1 = Sqr(dX1 ^ 2 + dY1 ^ 2)
d2 = Sqr(dX2 ^ 2 + dY2 ^ 2)
'计算方向矢量投影
Xl1 = dX1 / d1
Yl1 = dY1 / d1
Xl2 = dX2 / d2
Yl2 = dY2 / d2
'判断缩短型,伸长型,插入型
If Ori * (Yl2 * Xl1 - Xl2 * Yl1) >= 0 Then '缩短型
'刀补建立
If Combo1.ListIndex = 0 And Ori * (Yl2 * Xl1 - Xl2 * Yl1) <> 0 Then Xs1 = X1 - R * Ori * Yl2
Ys1 = Y1 + R * Ori * Xl2
X_0p.Text = X0
Y_0p.Text = Y0
X_s1.Text = Xs1
Y_s1.Text = Ys1
X_2p.Text = Xs1 + dX2
Y_2p.Text = Ys1 + dY2
Picture1.ForeColor = vbMagenta
Picture1.Line (X0, Y0)-(Xs1, Ys1)
Picture1.Line (Xs1, Ys1)-(Xs1 + dX2, Ys1 + dY2)
'刀补进行
ElseIf Combo1.ListIndex = 1 Then
If Yl2 * Xl1 - Xl2 * Yl1 = 0 Then 'l1与l2共线
Xs1 = X1 - R * Ori * Yl1
Ys1 = Y1 + R * Ori * Xl1
X_0p.Text = Xs1 - dX1
Y_0p.Text = Ys1 - dY1
X_s1.Text = Xs1
Y_s1.Text = Ys1
X_2p.Text = Xs1 + dX2
Y_2p.Text = Ys1 + dY2
Picture1.ForeColor = vbMagenta
Picture1.Line (Xs1 - dX1, Ys1 - dY1)-(Xs1, Ys1)
Picture1.Line (Xs1, Ys1)-(Xs1 + dX2, Ys1 + dY2)
Else ' l1与l2不共线
Xs1 = X1 + (Xl2 - Xl1) * Ori * R / (Xl1 * Yl2 - Xl2 * Yl1)
Ys1 = Y1 + (Yl2 - Yl1) * Ori * R / (Xl1 * Yl2 - Xl2 * Yl1)
X_0p.Text = Xs1 - dX1
Y_0p.Text = Ys1 - dY1
X_s1.Text = Xs1
Y_s1.Text = Ys1
X_2p.Text = Xs1 + dX2
Y_2p.Text = Ys1 + dY2
Picture1.ForeColor = vbMagenta
Picture1.Line (Xs1 - dX1, Ys1 - dY1)-(Xs1, Ys1)
Picture1.Line (Xs1, Ys1)-(Xs1 + dX2, Ys1 + dY2)
End If
'刀补撤销
ElseIf Combo1.ListIndex = 2 And Ori * (Yl2 * Xl1 - Xl2 * Yl1) <> 0 Then Xs1 = X1 - R * Ori * Yl1
Ys1 = Y1 + R * Ori * Xl1
X_0p.Text = Xs1 - dX1
Y_0p.Text = Ys1 - dY1
X_s1.Text = Xs1
Y_s1.Text = Ys1
X_2p.Text = X2
Y_2p.Text = Y2
Picture1.ForeColor = vbMagenta
Picture1.Line (Xs1 - dX1, Ys1 - dY1)-(Xs1, Ys1)
Picture1.Line (Xs1, Ys1)-(X2, Y2)
End If
ElseIf Ori * (Yl2 * Xl1 - Xl2 * Yl1) < 0 And (Yl2 * Yl1 + Xl2 * Xl1) >= 0 Then '伸长型
'刀补建立
If Combo1.ListIndex = 0 Then
'第一对转接点
Xs1 = X1 - R * Ori * Yl1
Ys1 = Y1 + R * Ori * Yl1
'第二对转接点
Xs2 = X1 + (Xl2 - Xl1) * R * Ori / (Xl1 * Yl2 - Xl2 * Yl1)
Ys2 = Y1 + (Yl2 - Yl1) * R * Ori / (Xl1 * Yl2 - Xl2 * Yl1)
'输出坐标
'X0',Y0'
X_0p.Text = X0
Y_0p.Text = Y0
'Xs1,Ys1
X_s1.Text = Xs1
Y_s1.Text = Ys1
'Xs2,Ys2
X_s2.Text = Xs2
Y_s2.Text = Ys2
'X2' Y2'
X_2p.Text = Xs2 + dX2
Y_2p.Text = Ys2 + dY2
'绘图
Picture1.ForeColor = vbMagenta
Picture1.Line (X0, Y0)-(Xs1, Ys1)
Picture1.Line (Xs1, Ys1)-(Xs2, Ys2)
Picture1.Line (Xs2, Ys2)-(Xs2 + dX2, Ys2 + dY2)
'刀补进行
ElseIf Combo1.ListIndex = 1 Then
Xs1 = X1 + (Xl2 - Xl1) * R * Ori / (Xl1 * Yl2 - Xl2 * Yl1)
Ys1 = Y1 + (Yl2 - Yl1) * R * Ori / (Xl1 * Yl2 - Xl2 * Yl1)
'输出坐标
'X0',Y0'
X_0p.Text = X0
Y_0p.Text = Y0
'Xs1,Ys1
X_s1.Text = Xs1
Y_s1.Text = Ys1
'X2' Y2'
X_2p.Text = Xs2 + dX2
Y_2p.Text = Ys2 + dY2
'绘图
Picture1.ForeColor = vbMagenta
Picture1.Line (Xs1 - dX1, Ys1 - dY1)-(Xs1, Ys1)
Picture1.Line (Xs1, Ys1)-(Xs1 + dX2, Ys1 + dY2)
'刀补撤销
ElseIf Combo1.ListIndex = 2 Then
Xs1 = X1 + (Xl2 - Xl1) * R * Ori / (Xl1 * Yl2 - Xl2 * Yl1)
Ys1 = Y1 + (Yl2 - Yl1) * R * Ori / (Xl1 * Yl2 - Xl2 * Yl1)
Xs2 = X1 - R * Ori * Yl2
Ys2 = Y1 + R * Ori * Xl2
'输出坐标
'X0',Y0'
X_0p.Text = Xs1 - dX1
Y_0p.Text = Ys1 - dY1
'Xs1,Ys1
X_s1.Text = Xs1
Y_s1.Text = Ys1
'Xs2,Ys2
X_s2.Text = Xs2
Y_s2.Text = Ys2
'X2' Y2'
X_2p.Text = X2
Y_2p.Text = Y2
'绘图
Picture1.ForeColor = vbMagenta
Picture1.Line (Xs1 - dX1, Ys1 - dY1)-(Xs1, Ys1)
Picture1.Line (Xs1, Ys1)-(Xs2, Ys2)
Picture1.Line (Xs2, Ys2)-(X2, Y2)
End If
ElseIf Ori * (Yl2 * Xl1 - Xl2 * Yl1) < 0 And (Yl2 * Yl1 + Xl2 * Xl1) < 0 Then '插入型