libcyjmoving.bas

本系统是给大庆油田做的一个示例程序

Attribute VB_Name = "LibCyjMoving"
Option Explicit

Sub XYPosition_Cal(SetCal As Single, Rcyj As Single, Pcyj As Single, Ccyj As Single, Acyj As Single, _
                  Icyj As Single, Hzhjcyj As Single, Hjsxcyj As Single, Set0 As Single, Spr As Single, _
                  XO As Single, YO As Single, XO1 As Single, YO1 As Single, _
                  XA As Single, YA As Single, XB As Single, YB As Single, XD As Single, YD As Single, _
                  BeamAngle As Single)
          
    Dim pi As Single
    Dim Kcyj As Single
    Dim ASet As Single
    Dim Set2 As Single, Set3 As Single, Set4 As Single
   
    Dim Alfa  As Single, Beta As Single
    Dim F1max As Single, F1min As Single
    Dim F2max As Single
    Dim L As Single
    Dim X As Single
   
    Dim XCfai As Single, CFai As Single
    
    Kcyj = Sqr((Hzhjcyj - Hjsxcyj) ^ 2 + Icyj ^ 2)
    
    pi = 3.14159265
    
    SetCal = SetCal * pi / 180
   
    Alfa = Atn(Icyj / Sqr(Kcyj ^ 2 - Icyj ^ 2))
    
    X = (Ccyj ^ 2 + Kcyj ^ 2 - (Rcyj + Pcyj) ^ 2) / 2 / Ccyj / Kcyj
    F1max = Atn(Sqr(1 - X ^ 2) / X)
    If X < 0 Then F1max = pi + F1max
    
    X = (Ccyj ^ 2 + Kcyj ^ 2 - (Pcyj - Rcyj) ^ 2) / 2 / Ccyj / Kcyj
    F1min = Atn(Sqr(1 - X ^ 2) / X)
    If X <= 0 Then F1min = pi + F1min
    
    Spr = (F1max - F1min) * Acyj
    
    X = ((Pcyj + Rcyj) ^ 2 + Kcyj ^ 2 - Ccyj ^ 2) / 2 / Kcyj / (Pcyj + Rcyj)
    F2max = Atn(Sqr(1 - X ^ 2) / X)
    If X < 0 Then F2max = pi + F2max
     
    Set0 = Alfa - F2max
    
    If SetCal >= 2 * pi Then
        SetCal = SetCal - Int(SetCal / 2 / pi) * 2 * pi
    End If
    
    ASet = Set0 + SetCal
    If ASet >= 2 * pi Then ASet = ASet - 2 * pi
    
    Set2 = 2 * pi - ASet + Alfa
    L = Sqr(Rcyj ^ 2 + Kcyj ^ 2 - 2 * Rcyj * Kcyj * Cos(Set2))
    X = -Rcyj * Sin(Set2) / L
    Beta = Atn(X / Sqr(1 - X ^ 2))
    
    X = (Pcyj ^ 2 + L ^ 2 - Ccyj ^ 2) / 2 / Pcyj / L
    Set3 = Atn(Sqr(1 - X ^ 2) / X) + Beta
    If X <= 0 Then Set3 = pi + Atn(Sqr(1 - X ^ 2) / X) + Beta
    
    X = (Ccyj ^ 2 + L ^ 2 - Pcyj ^ 2) / 2 / Ccyj / L
    Set4 = pi - Atn(Sqr(1 - X ^ 2) / X) + Beta
    If X < 0 Then Set4 = pi - (pi + Atn(Sqr(1 - X ^ 2) / X)) + Beta
    
    X = (L ^ 2 + Ccyj ^ 2 - Pcyj ^ 2) / 2 / L / Ccyj
    XCfai = Atn(Sqr(1 - X ^ 2) / X)
    If X <= 0 Then XCfai = pi + XCfai
    
    CFai = XCfai - Beta
    
    XO = 0
    YO = 0
    
    XO1 = Icyj
    YO1 = Hzhjcyj - Hjsxcyj
    
    XA = Rcyj * Sin(ASet)
    YA = Rcyj * Cos(ASet)
    
    XB = Icyj - Ccyj * Cos(CFai + Alfa - pi / 2)
    YB = Hzhjcyj - Hjsxcyj + Ccyj * Sin(CFai + Alfa - pi / 2)
    
    XD = Icyj + Acyj * Cos(CFai + Alfa - pi / 2)
    YD = Hzhjcyj - Hjsxcyj - Acyj * Sin(CFai + Alfa - pi / 2)
    
    BeamAngle = -(CFai + Alfa - pi / 2)
End Sub
Rem 绘机构图
Sub Fig_CyjMoving(Rcyj As Single, Pcyj As Single, Ccyj As Single, Acyj As Single, _
                  Icyj As Single, Hzhjcyj As Single, Hjsxcyj As Single, _
                  XO As Single, YO As Single, XO1 As Single, YO1 As Single, _
                  XA As Single, YA As Single, XB As Single, YB As Single, XD As Single, YD As Single, _
                  BeamAngle As Single)
   
    Dim pi As Single
    Dim i As Integer
    Dim XMin As Single, XMax As Single
    Dim YMin As Single, YMax As Single
    
    Dim BeamAngle1 As Single, BeamAngle2 As Single
    
    pi = 3.14159265
    
    
    XMin = -(Int(Rcyj) + 1)
    XMax = (Int(Icyj + Acyj) + 1)
    
    YMin = -(Int(Rcyj) + 1)
    YMax = (Int(Hzhjcyj - Hjsxcyj + 1 / 2 * Acyj + 0.5) + 1)
   
    CyjMoving.Pict11.Cls
    CyjMoving.Pict11.Scale (XMin, YMax)-(XMax, YMin)
    
    CyjMoving.Pict11.ForeColor = vbBlue
    CyjMoving.Pict11.BackColor = vbWhite
    
    CyjMoving.Pict11.DrawWidth = 2
    
    CyjMoving.Pict11.Line (XMin, (1 - 0.002) * YMax)-((1 - 0.002) * XMax, (1 - 0.002) * YMin), , B
    
    CyjMoving.Pict11.Line (-1, 0)-(1, 0)
    CyjMoving.Pict11.Line (0, -1)-(0, 1)
    
    CyjMoving.Pict11.Line (Icyj - 1, YO1)-(Icyj + Acyj, YO1)
    CyjMoving.Pict11.Line (Icyj, YO1 - 1)-(Icyj, YO1 + 1)
    
    CyjMoving.Pict11.Line (XO, YO)-(XA, YA)
    CyjMoving.Pict11.Line (XA, YA)-(XB, YB)
    CyjMoving.Pict11.Line (XB, YB)-(XO1, YO1)
    
    CyjMoving.Pict11.Line (XB, YB)-(XD, YD)
    
    CyjMoving.Pict11.Line (XO, YO)-(XO1, YO1)
    
    BeamAngle1 = BeamAngle + 30 * pi / 180
    BeamAngle2 = BeamAngle - 30 * pi / 180
    
    If BeamAngle1 >= 0 Then
        CyjMoving.Pict11.Circle (XO1, YO1), Acyj, , 0, BeamAngle1 '驴头
    Else
        CyjMoving.Pict11.Circle (XO1, YO1), Acyj, , 2 * pi + BeamAngle1, 2 * pi '驴头
    End If
    
    If BeamAngle2 >= 0 Then
        CyjMoving.Pict11.Circle (XO1, YO1), Acyj, , 0, BeamAngle2 '驴头
    Else
        CyjMoving.Pict11.Circle (XO1, YO1), Acyj, , 2 * pi + BeamAngle2, 2 * pi '驴头
    End If
End Sub