module1.bas

用vb写的数控仿真系统

Attribute VB_Name = "Module1"
Option Explicit
Public CurrentNX As Single, CurrentNY As Single, CurrentNZ As Single, CurrentNF As Single, CurrentNR As Single, CurrentNI As Single, CurrentNJ As Single, PauseRun As Boolean, TempX As Single, TempY As Single, TempZ As Single
Public VIEWXYZ As Boolean, OPX As Single, OPY As Single, OPZ As Single, FalsePoint As Boolean, MirrorX As Boolean, MirrorY As Boolean, CurrentGM As String
Dim RunFast As Integer, FirstPoint As Boolean, NOTX As Boolean, NOTIJ As Boolean, NEWZ As Single
Public StopRun As Boolean, SCALESIZE As Single, HowDC As Boolean, UserRTODC As Boolean, LineW As Integer
Sub G00(X As Single, Y As Single, Z As Single)   'G00过程
  frmmain.lblState.Caption = "快速定位到" & "X:" & X & " Y:" & Y & " Z:" & Z
  CurrentNX = X      '定位到当前坐标
  CurrentNY = Y
  CurrentNZ = Z
End Sub
Sub G01(X As Single, Y As Single, Z As Single)   'G01过程
  Dim X1 As Single, Y1 As Single, SPointX As Single, SPointY As Single, I As Single, L As Single
  On Error GoTo errhand
  If X = CurrentNX And Y = CurrentNY And Z = CurrentNZ Then
     Exit Sub
  End If
  If StopRun = True Then
    Exit Sub
  End If
  frmmain.lblState.Caption = "直线插补|" & "起点: X" & CurrentNX & " Y" & CurrentNY & " Z" & CurrentNZ & "终点: X" & X & " Y" & Y & " Z" & Z
  SPointX = CurrentNX
  SPointY = CurrentNY
  If X <> CurrentNX Then
     Dim K As Single
     K = (Y - CurrentNY) / (X - CurrentNX)
     For I = CurrentNX To X Step Sgn(X - CurrentNX)
        Y1 = SPointY + K * (I - SPointX)
        X1 = I
        Call DrawLine(CurrentNX, CurrentNY, X1, Y1)
        CurrentNX = X1
        CurrentNY = Y1
        CurrentNZ = Z
     Next I
  Else
     For I = CurrentNY To Y Step Sgn(Y - CurrentNY)
        Y1 = I
        X1 = CurrentNX
        Call DrawLine(CurrentNX, CurrentNY, X1, Y1)
        CurrentNX = X1
        CurrentNY = Y1
        CurrentNZ = Z
        If X = CurrentNX And Y = CurrentNY And Z = CurrentNZ Then
           Exit Sub
        End If
    Next I
  End If
  Exit Sub
errhand:
  If StopRun = False Then
  MsgBox "程序发生错误,请检查G代码!", vbOKOnly, "错误"
  End If
End Sub
Sub G03(X As Single, Y As Single, I As Single, J As Single)   'G03过程
frmmain.lblState.Caption = "逆圆插补|" & "起点: X" & CurrentNX & " Y" & CurrentNY & " Z" & CurrentNZ & "终点: X" & X & " Y" & Y & " Z" & CurrentNZ & "半径:" & CurrentNR & " 圆心:X" & I & " Y" & J
If HowDC = True Then
 Call DrawTCircle(X, Y, I, J, False)
Else
 Call DrawCircle(X, Y, I, J, False)
End If
End Sub
Sub G02(X As Single, Y As Single, I As Single, J As Single)   'G02过程
  frmmain.lblState.Caption = "顺圆插补|" & "起点: X" & CurrentNX & " Y" & CurrentNY & " Z" & CurrentNZ & "终点: X" & X & " Y" & Y & " Z" & CurrentNZ & "半径:" & CurrentNR & " 圆心:X" & I & " Y" & J
 If HowDC = True Then
  Call DrawTCircle(X, Y, I, J, True)
 Else
  Call DrawCircle(X, Y, I, J, True)
 End If
End Sub
Public Sub DrawCircle(X As Single, Y As Single, I As Single, J As Single, CircleTime As Boolean)   '无插补画圆
  Dim SPXY As Single, EPXY As Single, PointX(3) As Single, PointY(3) As Single, L As Single
  Dim CallFOR As Single
  On Error GoTo errhand
  If StopRun = True Then
     Exit Sub
  End If
  If (X - I) ^ 2 + (Y - J) ^ 2 <> CurrentNR ^ 2 And UserRTODC = False Then
       Dim ErrorR As Integer
       ErrorR = MsgBox("请检查你画圆的终点是否在圆周上！是否只以终点的Ｘ坐标作为标准？", vbYesNo, "错误")
       If ErrorR = vbNo Then
          StopRun = True
          Exit Sub
       End If
  End If
  If CircleTime = False Then
    CurrentNI = I
    CurrentNJ = J
    PointX(0) = I + CurrentNR
    PointY(0) = J
    PointX(1) = I
    PointY(1) = J + CurrentNR
    PointX(2) = I - CurrentNR
    PointY(2) = J
    PointX(3) = I
    PointY(3) = J - CurrentNR
  Else
    CurrentNI = I
    CurrentNJ = J
    PointX(0) = I + CurrentNR
    PointY(0) = J
    PointX(3) = I
    PointY(3) = J + CurrentNR
    PointX(2) = I - CurrentNR
    PointY(2) = J
    PointX(1) = I
    PointY(1) = J - CurrentNR
  End If
  SPXY = JudgePXY(CurrentNX, CurrentNY, I, J, CircleTime)
  EPXY = JudgePXY(X, Y, I, J, CircleTime)
  If SPXY <> EPXY Then
     If EPXY > SPXY Then
        For CallFOR = SPXY To EPXY
           If CallFOR + 1 < EPXY Then
            Call PXYTOGraphic(PointX(CallFOR + 1), PointY(CallFOR + 1), CallFOR, CallFOR + 1, CircleTime)
           Else
            Call PXYTOGraphic(X, Y, CallFOR, CallFOR + 1, CircleTime)
           End If
           If CallFOR + 1 = EPXY Then
             Exit For
           End If
        Next CallFOR
     ElseIf EPXY < SPXY Then
        If SPXY < 4 Then
            For CallFOR = SPXY To 3
               If CallFOR + 1 <> 4 Then
                Call PXYTOGraphic(PointX(CallFOR + 1), PointY(CallFOR + 1), CallFOR, CallFOR + 1, CircleTime)
               Else
                Call PXYTOGraphic(PointX(0), PointY(0), CallFOR, CallFOR + 1, CircleTime)
               End If
            Next CallFOR
        End If
        If EPXY = 1 Then
         Call PXYTOGraphic(X, Y, 4, 1, CircleTime)
        ElseIf EPXY > 1 Then
         Call PXYTOGraphic(PointX(1), PointY(1), 4, 1, CircleTime)
           For CallFOR = 1 To EPXY - 1
            If CallFOR + 1 = EPXY Then
              Call PXYTOGraphic(X, Y, CallFOR, CallFOR + 1, CircleTime)
              Exit For
            End If
            Call PXYTOGraphic(PointX(CallFOR + 1), PointY(CallFOR + 1), CallFOR, CallFOR + 1, CircleTime)
           Next CallFOR
        End If
      End If
  ElseIf EPXY = SPXY Then
    Dim TOX As Single, TOY As Single, StartX As Single, StartY As Single
    StartX = CurrentNX
    StartY = CurrentNY
   If CircleTime = False Then
         If SPXY = 1 Then
            If Y - CurrentNY > 0 Then
               For TOX = StartX To X Step -1
                 TOY = (CurrentNR ^ 2 - (TOX - CurrentNI) ^ 2) ^ 0.5 + CurrentNJ
                   Call DrawLine(CurrentNX, CurrentNY, TOX, TOY)
                 CurrentNX = TOX
                 CurrentNY = TOY
               Next TOX
            Else
               Call PXYTOGraphic(PointX(2), PointY(2), 1, 2, CircleTime)
               Call PXYTOGraphic(PointX(3), PointY(3), 2, 3, CircleTime)
               Call PXYTOGraphic(PointX(0), PointY(0), 3, 4, CircleTime)
               Call PXYTOGraphic(X, Y, 4, 1, CircleTime)
            End If
         ElseIf SPXY = 2 Then
            If Y - CurrentNY < 0 Then
               For TOX = StartX To X Step -1
                 TOY = (CurrentNR ^ 2 - (TOX - CurrentNI) ^ 2) ^ 0.5 + CurrentNJ
                   Call DrawLine(CurrentNX, CurrentNY, TOX, TOY)
                 CurrentNX = TOX
                 CurrentNY = TOY
               Next TOX
            Else
              Call PXYTOGraphic(PointX(3), PointY(3), 2, 3, CircleTime)
              Call PXYTOGraphic(PointX(0), PointY(0), 3, 4, CircleTime)
              Call PXYTOGraphic(PointX(1), PointY(1), 4, 1, CircleTime)
              Call PXYTOGraphic(X, Y, 1, 2, CircleTime)
            End If
         ElseIf SPXY = 3 Then
            If Y - CurrentNY < 0 Then
               For TOX = StartX To X
                 TOY = -(CurrentNR ^ 2 - (TOX - CurrentNI) ^ 2) ^ 0.5 + CurrentNJ
                   Call DrawLine(CurrentNX, CurrentNY, TOX, TOY)
                 CurrentNX = TOX
                 CurrentNY = TOY
               Next TOX
            Else
               Call PXYTOGraphic(PointX(0), PointY(0), 3, 4, CircleTime)
               Call PXYTOGraphic(PointX(1), PointY(1), 4, 1, CircleTime)
               Call PXYTOGraphic(PointX(2), PointY(2), 1, 2, CircleTime)
               Call PXYTOGraphic(X, Y, 2, 3, CircleTime)
            End If
        ElseIf SPXY = 4 Then
            If Y - CurrentNY > 0 Then
               For TOX = StartX To X
                 TOY = -(CurrentNR ^ 2 - (TOX - CurrentNI) ^ 2) ^ 0.5 + CurrentNJ
                   Call DrawLine(CurrentNX, CurrentNY, TOX, TOY)
                 CurrentNX = TOX
                 CurrentNY = TOY
               Next TOX
            Else
               Call PXYTOGraphic(PointX(1), PointY(1), 4, 1, CircleTime)
               Call PXYTOGraphic(PointX(2), PointY(2), 1, 2, CircleTime)
               Call PXYTOGraphic(PointX(3), PointY(3), 2, 3, CircleTime)
               Call PXYTOGraphic(X, Y, 3, 4, CircleTime)
            End If
        End If
  Else
         If SPXY = 1 Then
            If Y - CurrentNY < 0 Then
               For TOX = StartX To X Step -1
                 TOY = -(CurrentNR ^ 2 - (TOX - CurrentNI) ^ 2) ^ 0.5 + CurrentNJ
                   Call DrawLine(CurrentNX, CurrentNY, TOX, TOY)
                 CurrentNX = TOX
                 CurrentNY = TOY
               Next TOX
            Else
               Call PXYTOGraphic(PointX(2), PointY(2), 1, 2, CircleTime)
               Call PXYTOGraphic(PointX(3), PointY(3), 2, 3, CircleTime)
               Call PXYTOGraphic(PointX(0), PointY(0), 3, 4, CircleTime)
               Call PXYTOGraphic(X, Y, 4, 1, CircleTime)
            End If
         ElseIf SPXY = 2 Then
            If Y - CurrentNY > 0 Then
               For TOX = StartX To X Step -1
                 TOY = -(CurrentNR ^ 2 - (TOX - CurrentNI) ^ 2) ^ 0.5 + CurrentNJ
                   Call DrawLine(CurrentNX, CurrentNY, TOX, TOY)
                 CurrentNX = TOX
                 CurrentNY = TOY
               Next TOX
            Else
              Call PXYTOGraphic(PointX(3), PointY(3), 2, 3, CircleTime)
              Call PXYTOGraphic(PointX(0), PointY(0), 3, 4, CircleTime)
              Call PXYTOGraphic(PointX(1), PointY(1), 4, 1, CircleTime)
              Call PXYTOGraphic(X, Y, 1, 2, CircleTime)
            End If
         ElseIf SPXY = 3 Then
            If Y - CurrentNY > 0 Then
               For TOX = StartX To X
                 TOY = (CurrentNR ^ 2 - (TOX - CurrentNI) ^ 2) ^ 0.5 + CurrentNJ
                   Call DrawLine(CurrentNX, CurrentNY, TOX, TOY)
                 CurrentNX = TOX
                 CurrentNY = TOY
               Next TOX
            Else
               Call PXYTOGraphic(PointX(0), PointY(0), 3, 4, CircleTime)
               Call PXYTOGraphic(PointX(1), PointY(1), 4, 1, CircleTime)
               Call PXYTOGraphic(PointX(2), PointY(2), 1, 2, CircleTime)
               Call PXYTOGraphic(X, Y, 2, 3, CircleTime)
            End If
        ElseIf SPXY = 4 Then
            If Y - CurrentNY < 0 Then
               For TOX = StartX To X
                 TOY = (CurrentNR ^ 2 - (TOX - CurrentNI) ^ 2) ^ 0.5 + CurrentNJ
                   Call DrawLine(CurrentNX, CurrentNY, TOX, TOY)
                 CurrentNX = TOX
                 CurrentNY = TOY
               Next TOX
            Else
               Call PXYTOGraphic(PointX(1), PointY(1), 4, 1, CircleTime)
               Call PXYTOGraphic(PointX(2), PointY(2), 1, 2, CircleTime)
               Call PXYTOGraphic(PointX(3), PointY(3), 2, 3, CircleTime)
               Call PXYTOGraphic(X, Y, 3, 4, CircleTime)
            End If
        End If
  End If
 End If
 Exit Sub
errhand:
If StopRun = False Then
  MsgBox "程序发生错误,请检查G代码!", vbOKOnly, "错误"
End If
End Sub
Public Sub PICDRAWCLS()       '重画坐标轴
  frmmain.PicDraw.Cls
  frmmain.PicDraw.DrawWidth = 1
 If VIEWXYZ = False Then
    frmmain.PicDraw.Line (0, frmmain.PicDraw.ScaleTop - 300)-(0, 0), &HC0FFFF
    frmmain.PicDraw.Line (0, 0)-(frmmain.PicDraw.ScaleWidth / 2 - 300, 0), &HC0FFFF
    frmmain.lblXYZ0(0).Top = -100
    frmmain.lblXYZ0(0).Left = frmmain.PicDraw.ScaleWidth / 2 - 400
    frmmain.lblXYZ0(1).Top = frmmain.PicDraw.ScaleTop - 300
    frmmain.lblXYZ0(1).Left = -150
    frmmain.lblXYZ0(3).Top = -100
    frmmain.lblXYZ0(3).Left = 10
    frmmain.lblXYZ0(2).Visible = False
 Else
    frmmain.PicDraw.Line (0, frmmain.PicDraw.ScaleTop - 300)-(0, 0), &HC0FFFF
    frmmain.PicDraw.Line (0, 0)-(frmmain.PicDraw.ScaleWidth / 2 - 300, 0), &HC0FFFF
    frmmain.PicDraw.Line (0, 0)-(2000 * Cos(225 * 6.28 / 360), 2000 * Sin(225 * 6.28 / 360)), &HC0FFFF
    frmmain.lblXYZ0(2).Visible = True
    frmmain.lblXYZ0(0).Top = 2000 * Sin(225 * 6.28 / 360)
    frmmain.lblXYZ0(0).Left = 2000 * Cos(225 * 6.28 / 360)
    frmmain.lblXYZ0(2).Top = frmmain.PicDraw.ScaleTop - 300
    frmmain.lblXYZ0(2).Left = -150
    frmmain.lblXYZ0(1).Top = -100
    frmmain.lblXYZ0(1).Left = frmmain.PicDraw.ScaleWidth / 2 - 400
    frmmain.lblXYZ0(3).Top = -100
    frmmain.lblXYZ0(3).Left = 10
 End If
 frmmain.PicDraw.DrawWidth = LineW
End Sub
Public Sub DrawLine(X1 As Single, Y1 As Single, X2 As Single, Y2 As Single)    '画线过程
  Dim LX1 As Single, LX2 As Single, LY1 As Single, LY2 As Single, L As Single
  If StopRun = True Then   '判断是否按了停止
   Exit Sub
  End If
  If X1 = X2 And Y1 = Y2 And CurrentNZ = NEWZ Then
    Exit Sub
  End If
  Do While PauseRun = True    '暂停控制
    For L = 0 To 10000
      DoEvents
    Next L
  Loop
  If VIEWXYZ = True Then
   LX1 = X1 * Sin(45 * 6.28 / 360) * Cos(225 * 6.28 / 360) + Y1
   LX2 = X2 * Sin(45 * 6.28 / 360) * Cos(225 * 6.28 / 360) + Y2
   LY1 = X1 * Sin(45 * 6.28 / 360) * Sin(225 * 6.28 / 360) + CurrentNZ
   LY2 = X2 * Sin(45 * 6.28 / 360) * Sin(225 * 6.28 / 360) + NEWZ
   frmmain.Line1.X1 = LX2 * SCALESIZE
   frmmain.Line1.X2 = frmmain.Line1.X1
   frmmain.Line1.Y1 = LY2 * SCALESIZE
   frmmain.Line1.Y2 = frmmain.Line1.Y1 + 300
    If CurrentNZ = NEWZ Then
     frmmain.PicDraw.Line (LX1 * SCALESIZE, LY1 * SCALESIZE)-(LX2 * SCALESIZE, LY2 * SCALESIZE), vbGreen
    Else
     frmmain.PicDraw.Line (LX1 * SCALESIZE, LY1 * SCALESIZE)-(LX2 * SCALESIZE, LY2 * SCALESIZE), &HC00000
    End If
   CurrentNZ = NEWZ
  Else
   frmmain.Shape1.Left = X2 * SCALESIZE - 35
   frmmain.Shape1.Top = Y2 * SCALESIZE + 50
   frmmain.PicDraw.Line (X1 * SCALESIZE, Y1 * SCALESIZE)-(X2 * SCALESIZE, Y2 * SCALESIZE)
  End If
   For L = CurrentNF * 20 To 20000   '速度控制
     DoEvents
   Next L
End Sub
Public Sub G04() 'G04过程
   frmmain.lblState.Caption = "暂停"
   PauseRun = True
End Sub
Public Sub G28() 'G28过程
   frmmain.lblState.Caption = "回到参考点"
   TempX = CurrentNX
   TempY = CurrentNY
   TempZ = CurrentNZ
   Call G00(0, 0, 0)
End Sub
Public Sub G29()  'G29过程
   frmmain.lblState.Caption = "由参考点返回"
   Call G00(TempX, TempY, TempZ)
End Sub
Public Sub G40()   'G40过程
   frmmain.lblState.Caption = "取消刀具补偿"
   frmmain.LblLR.Caption = "关"
End Sub
Public Sub G41()   'G41过程
   frmmain.lblState.Caption = "打开左刀补"
   frmmain.LblLR.Caption = "左"
End Sub
Public Sub G42()    'G42过程
   frmmain.lblState.Caption = "打开右刀补"
   frmmain.LblLR.Caption = "右"
End Sub
Public Sub G54()    'G54过程
   frmmain.lblState.Caption = "工件坐标系选择"
   OPX = 0
   OPY = 0
   OPZ = 0
   frmmain.TXTOR(0) = frmmain.txtTrue(0)
   frmmain.TXTOR(1) = frmmain.txtTrue(1)
   frmmain.TXTOR(2) = frmmain.txtTrue(2)
End Sub
Public Sub G90()    'G90过程
   frmmain.lblState.Caption = "绝对值编程"
   FalsePoint = False
End Sub
Public Sub G91()   'G91过程
   frmmain.lblState.Caption = "相对值编程"
   FalsePoint = True
End Sub
Public Sub M02()   'M02过程
   frmmain.lblState.Caption = "程序停止"
   StopRun = True
End Sub
Public Sub M2()   'M02过程
   frmmain.lblState.Caption = "程序停止"
   StopRun = True
End Sub
Public Sub M03()   'M03过程
   frmmain.lblState.Caption = "主轴正转启动"
   frmmain.lblRotate.Caption = "正"
End Sub
Public Sub M3()   'M03过程
   frmmain.lblState.Caption = "主轴正转启动"
   frmmain.lblRotate.Caption = "正"
End Sub
Public Sub G43()   'G43过程
   frmmain.lblState.Caption = "刀具长度正向补偿"
   FalsePoint = True
End Sub
Public Sub G44()   'G44过程
   frmmain.lblState.Caption = "刀具长度负向补偿"
   FalsePoint = True
End Sub
Public Sub M06()   'M06过程
   frmmain.lblState.Caption = "换刀"
   FalsePoint = True
End Sub
Public Sub M6()   'M06过程
   frmmain.lblState.Caption = "换刀"
   FalsePoint = True
End Sub
Public Sub M04()    'M04过程
   frmmain.lblState.Caption = "主轴反转启动"
   frmmain.lblRotate.Caption = "反"
End Sub
Public Sub M4()    'M04过程
   frmmain.lblState.Caption = "主轴反转启动"
   frmmain.lblRotate.Caption = "反"