1.9w+
社区成员
'2.计算直线度误差
Public Sub CalculateZhiXianDu()
Dim x() As Double
Dim RL() As Double
Dim Rmax As Double, Rmin As Double
Dim a As Double, b As Double
Dim i As Integer
Dim fi As Double
Dim SgmXiYi As Double, SgmXi2 As Double, SgmYi As Double
Dim SCL As Double
Dim SCL2 As Double
Dim Wucha As Double
Dim t As Double, Alpha As Double
'输出原始数据
Form1.Text1.Text = " *** 直线度 ***" & vbCr & vbLf & vbCr & vbLf
Form1.Text1.Text = Form1.Text1.Text & " 零件公差:" & Format(fGongCha, fm) & vbCr & vbLf
Form1.Text1.Text = Form1.Text1.Text & " 测量点数:" & iNumOfPoints & vbCr & vbLf & vbCr & vbLf
Form1.Text1.Text = Form1.Text1.Text & " 原始数据:" & vbCr & vbLf
For i = 1 To iNumOfPoints
Form1.Text1.Text = Form1.Text1 + " R" & i & "=" & Format(fLineData(i), fm) & vbCr & vbLf
Next i
SCL = 300 / fTotalLen
ReDim x(1 To iNumOfPoints)
ReDim RL(1 To iNumOfPoints)
CalculateXi x, fTotalLen, iNumOfPoints
Alpha = Atn(fLineData(iNumOfPoints) / x(iNumOfPoints))
For i = 1 To iNumOfPoints
t = x(i)
x(i) = x(i) * Cos(Alpha) + fLineData(i) * Sin(Alpha)
fLineData(i) = fLineData(i) * Cos(Alpha) - t * Sin(Alpha)
Next i
For i = 1 To iNumOfPoints
SgmXiYi = SgmXiYi + x(i) * fLineData(i)
SgmXi2 = SgmXi2 + x(i) * x(i)
SgmYi = SgmYi + fLineData(i)
Next i
a = SgmXiYi / SgmXi2 / 1000
b = SgmYi / iNumOfPoints
'计算各点到理想直线的偏差 RL(i)
For i = 1 To iNumOfPoints
RL(i) = fLineData(i) - a * x(i) - b
Next i
'找出两极值
MaxMin RL, iNumOfPoints, Rmax, Rmin
'计算误差
Wucha = Rmax - Rmin
If Wucha > 0 Then SCL2 = 20 / Wucha Else SCL2 = 1
Form1.picMain.Cls
DrawArrow ToX(-150), ToY(0), ToX(150), ToY(0), vbBlack, True
DrawArrow ToX(0), _
ToY(-Form1.picMain.ScaleHeight / 4), _
ToX(0), _
ToY(Form1.picMain.ScaleHeight / 4), vbBlack, False
Form1.picMain.PSet (ToX(x(1) * SCL), ToY(fLineData(1) * SCL2))
For i = 2 To iNumOfPoints
Form1.picMain.Line -(ToX(x(i) * SCL), ToY(fLineData(i) * SCL2)), vbRed
Next i
'画出直线 y=ax+b 及包容直线
Form1.picMain.Line (ToX(x(1) * SCL), ToY((x(1) * a + b) * SCL2)) _
-(ToX(x(iNumOfPoints) * SCL), ToY((x(iNumOfPoints) * a + b) * SCL2)), vbRed
Form1.picMain.Line (ToX(x(1) * SCL), ToY((x(1) * a + b + Rmax) * SCL2)) _
-(ToX(x(iNumOfPoints) * SCL), ToY((x(iNumOfPoints) * a + b + Rmax) * SCL2)), vbRed
Form1.picMain.Line (ToX(x(1) * SCL), ToY((x(1) * a + b + Rmin) * SCL2)) _
-(ToX(x(iNumOfPoints) * SCL), ToY((x(iNumOfPoints) * a + b + Rmin) * SCL2)), vbRed
'标注误差
Form1.picMain.Line (ToX(100), ToY(-40))-Step(0, -80), vbRed
Form1.picMain.Line -Step(50, 0), vbRed
With Form1.picMain
.FontSize = 12
.CurrentX = .CurrentX - .TextWidth("0.02")
.CurrentY = .CurrentY - .TextHeight("0")
End With
Form1.picMain.Print Format(Wucha, fm)
Form1.picMain.Line (ToX(100), ToY((100 / SCL * a + b + Rmax) * SCL2))-Step(-2, -10), vbRed
Form1.picMain.Line (ToX(100), ToY((100 / SCL * a + b + Rmax) * SCL2))-Step(2, -10), vbRed
Form1.picMain.Line (ToX(100), ToY((100 / SCL * a + b + Rmin) * SCL2))-Step(-2, 10), vbRed
Form1.picMain.Line (ToX(100), ToY((100 / SCL * a + b + Rmin) * SCL2))-Step(2, 10), vbRed
'输出结论
Form1.picMain.FontSize = 22
Form1.picMain.CurrentX = 250
Form1.picMain.CurrentY = Form1.picMain.ScaleHeight - 120
Form1.picMain.Print "直线度误差: " & Format(Wucha, fm)
Form1.picMain.CurrentY = Form1.picMain.CurrentY + 20
Form1.picMain.CurrentX = 250
Form1.picMain.Print IIf(Wucha > fGongCha, "零件不合格", "零件合格")
End Sub