module1.bas

用vb写的数控仿真系统

    Exit Sub
errhand:
  If StopRun = False Then
    MsgBox "仿真过程发生错误,请检查G代码!", vbOKOnly, "错误"
  End If
End Sub
Public Sub ABSPoint(ByRef X1 As Single, ByRef Y1 As Single, ByRef Z1 As Single)    '转换到绝对坐标
    Static LX1 As Single, LY1 As Single, LZ1 As Single
    Dim LX2 As Single, LY2 As Single, LZ2 As Single
    If FalsePoint = True Then
      If FirstPoint = False Then   '相对坐标到绝对坐标
       LX1 = 0
       LY1 = 0
       LZ1 = 0
       X1 = X1 + OPX
       Y1 = Y1 + OPY
       Z1 = Z1 + OPZ
       FirstPoint = True
      Else
       X1 = X1 + LX1
       Y1 = Y1 + LY1
       Z1 = Z1 + LZ1
      End If
       LX1 = X1
       LY1 = Y1
       LZ1 = Z1
    End If
    If MirrorX = True Then
       Y1 = -1 * Y1
    End If
    If MirrorY = True Then
       X1 = -1 * X1
    End If
End Sub

Public Sub G92(X As Single, Y As Single, Z As Single)
   frmmain.lblState.Caption = "工件坐标系选择"
   frmmain.LblCX = X
   frmmain.LblCY = Y
   frmmain.LblCZ = Z
   OPX = X
   OPY = Y
   OPZ = Z
   frmmain.TXTOR(0) = Val(frmmain.txtTrue(0)) - X
   frmmain.TXTOR(1) = Val(frmmain.txtTrue(1)) - Y
   frmmain.TXTOR(2) = Val(frmmain.txtTrue(2)) - Z
End Sub
Public Sub IniLoad()      '初始化过程
   CurrentNX = 0
   CurrentNY = 0
   CurrentNZ = 0
   CurrentNR = 0
   CurrentNI = 0
   CurrentNJ = 0
   CurrentNF = 360
   PauseRun = False
   TempX = 0
   TempY = 0
   TempZ = 0
   NEWZ = 0
   OPX = 0
   OPY = 0
   OPZ = 0
   StopRun = False
   FalsePoint = False
   MirrorX = False
   MirrorY = False
   CurrentGM = "#"
   FirstPoint = False
   Call PICDRAWCLS
End Sub
Public Sub DrawTCircle(ByVal X As Single, Y As Single, I As Single, J As Single, CircleTime As Boolean)   '圆插补过程
    Dim xm As Single, ym As Single, xm1 As Single, ym1 As Single
    Dim r2 As Single, rm2 As Single, fm As Single, SamePoint As Boolean
    If StopRun = True Then
       Exit Sub
    End If
        xm = CurrentNX
        ym = CurrentNY
        r2 = CurrentNR ^ 2
    If (X - I) ^ 2 + (Y - J) ^ 2 <> CurrentNR ^ 2 And UserRTODC = False Then
       GoTo errhand
    End If
    SamePoint = True
    Do Until ((X = xm) And (Y = ym)) And SamePoint = False
        rm2 = (xm - I) ^ 2 + (ym - J) ^ 2
        fm = rm2 - r2
    If CircleTime = True Then        '顺圆插补
            If xm >= I And ym >= J Then
                    If fm >= 0 Then
                        ym1 = ym - 1
                        xm1 = xm
                    Else
                        xm1 = xm + 1
                        ym1 = ym
                    End If
                    GoTo GotoNext
            End If
            
            If xm <= I And ym >= J Then
                
                    If fm >= 0 Then
                        ym1 = ym
                        xm1 = xm + 1
                    Else
                        xm1 = xm
                        ym1 = ym + 1
                    End If
                    GoTo GotoNext
            End If
            If xm <= I And ym <= J Then
                
                    If fm >= 0 Then
                        ym1 = ym + 1
                        xm1 = xm
                    Else
                        xm1 = xm - 1
                        ym1 = ym
                    End If
                    GoTo GotoNext
            End If
            If xm >= I And ym <= J Then
                
                    If fm >= 0 Then
                        ym1 = ym
                        xm1 = xm - 1
                    Else
                        xm1 = xm
                        ym1 = ym - 1
                    End If
                    GoTo GotoNext
            End If
    Else                               '逆圆插补
            If xm >= I And ym >= J Then
                    If fm >= 0 Then
                        ym1 = ym
                        xm1 = xm - 1
                    Else
                        xm1 = xm
                        ym1 = ym + 1
                    End If
                    GoTo GotoNext
            End If
            
            If xm <= I And ym >= J Then
                
                    If fm >= 0 Then
                        ym1 = ym - 1
                        xm1 = xm
                    Else
                        xm1 = xm - 1
                        ym1 = ym
                    End If
                    GoTo GotoNext
            End If
            If xm <= I And ym <= J Then
                
                    If fm >= 0 Then
                        ym1 = ym
                        xm1 = xm + 1
                    Else
                        xm1 = xm
                        ym1 = ym - 1
                    End If
                    GoTo GotoNext
            End If
            If xm >= I And ym <= J Then
                
                    If fm >= 0 Then
                        ym1 = ym + 1
                        xm1 = xm
                    Else
                        xm1 = xm + 1
                        ym1 = ym
                    End If
                    GoTo GotoNext
            End If
 
    End If
GotoNext:
      Call DrawLine(xm, ym, xm1, ym1)       '画出图形
      xm = xm1
      ym = ym1
      CurrentNX = xm
      CurrentNY = ym
      If xm = X And ym = Y And SamePoint = True Then
         SamePoint = False
         Exit Do
      End If
    Loop
    Exit Sub
errhand:
  MsgBox "请检查你画圆的终点是否在圆周上，本程序将停止仿真！！！", vbOKOnly, "错误"
  StopRun = True
 End Sub
Public Function JudgePXY(X As Single, Y As Single, I As Single, J As Single, CircleTime As Boolean) As Integer   '用于无插补时,判断象限(顺圆象限与逆圆不同)
   If X > I Then
     If Y > J Then
      If CircleTime = False Then
       JudgePXY = 1
      Else
       JudgePXY = 4
      End If
     ElseIf Y < J Then
      If CircleTime = False Then
       JudgePXY = 4
      Else
       JudgePXY = 1
      End If
     ElseIf Y = J Then
          JudgePXY = 4
     End If
   ElseIf X < I Then
     If Y > J Then
      If CircleTime = False Then
       JudgePXY = 2
      Else
       JudgePXY = 3
      End If
     ElseIf Y < J Then
      If CircleTime = False Then
       JudgePXY = 3
      Else
       JudgePXY = 2
      End If
     ElseIf Y = J Then
       JudgePXY = 2
     End If
   ElseIf X = I Then
     If Y > J Then
        If CircleTime = False Then
           JudgePXY = 1
        Else
           JudgePXY = 3
        End If
     ElseIf Y < J Then
        If CircleTime = False Then
           JudgePXY = 3
        Else
           JudgePXY = 1
        End If
     End If
   End If
End Function
Public Sub PXYTOGraphic(EndX As Single, Endy As Single, PXY1 As Single, PXY2 As Single, CircleTime As Boolean)   '无插补的部份计算
   Dim TOX As Single, TOY As Single, StartX As Single, StartY As Single, L As Single
   On Error GoTo errhand
   StartX = CurrentNX
   StartY = CurrentNY
   If StopRun = True Then
      Exit Sub
   End If
   If CircleTime = False Then
      If PXY1 = 1 And PXY2 = 2 Then
          For TOX = StartX To EndX Step -1
            TOY = (CurrentNR ^ 2 - (TOX - CurrentNI) ^ 2) ^ 0.5 + CurrentNJ
            Call DrawLine(CurrentNX, CurrentNY, TOX, TOY)
            CurrentNX = TOX
            CurrentNY = TOY
          Next TOX
      ElseIf PXY1 = 2 And PXY2 = 3 Then
          For TOY = StartY To Endy Step -1
            TOX = -(CurrentNR ^ 2 - (TOY - CurrentNJ) ^ 2) ^ 0.5 + CurrentNI
            Call DrawLine(CurrentNX, CurrentNY, TOX, TOY)
            CurrentNX = TOX
            CurrentNY = TOY
          Next TOY
      ElseIf PXY1 = 3 And PXY2 = 4 Then
          For TOX = StartX To EndX
            TOY = -(CurrentNR ^ 2 - (TOX - CurrentNI) ^ 2) ^ 0.5 + CurrentNJ
            Call DrawLine(CurrentNX, CurrentNY, TOX, TOY)
            CurrentNX = TOX
            CurrentNY = TOY
          Next TOX
      ElseIf PXY1 = 4 And PXY2 = 1 Then
          For TOY = StartY To Endy
            TOX = (CurrentNR ^ 2 - (TOY - CurrentNJ) ^ 2) ^ 0.5 + CurrentNI
            Call DrawLine(CurrentNX, CurrentNY, TOX, TOY)
            CurrentNX = TOX
            CurrentNY = TOY
          Next TOY
      End If
   Else
      If PXY1 = 1 And PXY2 = 2 Then
          For TOX = StartX To EndX Step -1
            TOY = -(CurrentNR ^ 2 - (TOX - CurrentNI) ^ 2) ^ 0.5 + CurrentNJ
            Call DrawLine(CurrentNX, CurrentNY, TOX, TOY)
            CurrentNX = TOX
            CurrentNY = TOY
          Next TOX
      ElseIf PXY1 = 2 And PXY2 = 3 Then
          For TOY = StartY To Endy
            TOX = -(CurrentNR ^ 2 - (TOY - CurrentNJ) ^ 2) ^ 0.5 + CurrentNI
              Call DrawLine(CurrentNX, CurrentNY, TOX, TOY)
            CurrentNX = TOX
            CurrentNY = TOY
          Next TOY
      ElseIf PXY1 = 3 And PXY2 = 4 Then
          For TOX = StartX To EndX
            TOY = (CurrentNR ^ 2 - (TOX - CurrentNI) ^ 2) ^ 0.5 + CurrentNJ
              Call DrawLine(CurrentNX, CurrentNY, TOX, TOY)
            CurrentNX = TOX
            CurrentNY = TOY
          Next TOX
      ElseIf PXY1 = 4 And PXY2 = 1 Then
          For TOY = StartY To Endy Step -1
            TOX = (CurrentNR ^ 2 - (TOY - CurrentNJ) ^ 2) ^ 0.5 + CurrentNI
              Call DrawLine(CurrentNX, CurrentNY, TOX, TOY)
            CurrentNX = TOX
            CurrentNY = TOY
          Next TOY
      End If
   End If
   Exit Sub
errhand:
 If StopRun = False Then
  MsgBox "程序发生错误,请检查G代码!", vbOKOnly, "错误"
 End If
End Sub
Public Sub GetCenterPoint(ByVal X1 As Single, Y1 As Single, R1 As Single, CircleTime As Boolean, ByRef I As Single, J As Single)   '根据R计算圆心位置的过程
       Dim KOS As Single, CountPoint As Single, MidPointX As Single, MidPointY As Single, CircleCenterX(1) As Single, CircleCenterY(1) As Single
       Dim FirstCenter As Boolean, LastSgn As Single, MidCenter As Boolean
        MidPointX = (CurrentNX + X1) / 2
        MidPointY = (CurrentNY + Y1) / 2
        LastSgn = -2
       If CurrentNX <> X1 Then '计算两圆心
          If CurrentNY = Y1 Then
             If (MidPointX - CurrentNX) ^ 2 + (MidPointY - CurrentNY) ^ 2 = R1 ^ 2 Then
                 CircleCenterX(0) = MidPointX
                 CircleCenterY(0) = MidPointY
                 CircleCenterX(1) = MidPointX
                 CircleCenterY(1) = MidPointY
                 MidCenter = True
                 GoTo NextCount
             End If
             For CountPoint = MidPointY - R1 To MidPointY + R1 Step Sgn(R1) * 0.001
                If Sgn((MidPointX - CurrentNX) ^ 2 + (CountPoint - CurrentNY) ^ 2 - R1 ^ 2) <> LastSgn And LastSgn <> -2 Then
                  If FirstCenter = False Then
                    CircleCenterX(0) = MidPointX
                    CircleCenterY(0) = CountPoint
                    FirstCenter = True
                  ElseIf FirstCenter = True Then
                    CircleCenterX(1) = MidPointX
                    CircleCenterY(1) = CountPoint
                    Exit For
                  End If
                 End If
                 LastSgn = Sgn((MidPointX - CurrentNX) ^ 2 + (CountPoint - CurrentNY) ^ 2 - R1 ^ 2)
             Next CountPoint
          Else
             If (MidPointX - CurrentNX) ^ 2 + (MidPointY - CurrentNY) ^ 2 = R1 ^ 2 Then
                 CircleCenterX(0) = MidPointX
                 CircleCenterY(0) = MidPointY
                 CircleCenterX(1) = MidPointX
                 CircleCenterY(1) = MidPointY
                 MidCenter = True
                 GoTo NextCount
             End If
             KOS = -(X1 - CurrentNX) / (Y1 - CurrentNY)
             For CountPoint = MidPointX - R1 To MidPointX + R1 Step Sgn(R1) * 0.001
                 If Sgn((CountPoint - CurrentNX) ^ 2 + ((KOS * CountPoint + MidPointY - KOS * MidPointX) - CurrentNY) ^ 2 - R1 ^ 2) <> LastSgn And LastSgn <> -2 Then
                  If FirstCenter = False Then
                    CircleCenterX(0) = CountPoint
                    CircleCenterY(0) = (KOS * CountPoint + MidPointY - KOS * MidPointX)
                    FirstCenter = True
                  ElseIf FirstCenter = True Then
                    CircleCenterX(1) = CountPoint
                    CircleCenterY(1) = (KOS * CountPoint + MidPointY - KOS * MidPointX)
                    Exit For
                  End If
                 End If
                 LastSgn = Sgn((CountPoint - CurrentNX) ^ 2 + ((KOS * CountPoint + MidPointY - KOS * MidPointX) - CurrentNY) ^ 2 - R1 ^ 2)
             Next CountPoint
         End If
         
      Else
             If (MidPointX - CurrentNX) ^ 2 + (MidPointY - CurrentNY) ^ 2 = R1 ^ 2 Then
                 CircleCenterX(0) = MidPointX
                 CircleCenterY(0) = MidPointY
                 CircleCenterX(1) = MidPointX
                 CircleCenterY(1) = MidPointY
                 MidCenter = True
                 GoTo NextCount
             End If
             For CountPoint = MidPointX - R1 To MidPointX + R1 Step Sgn(R1) * 0.001
                 If Sgn((CountPoint - CurrentNX) ^ 2 + (MidPointY - CurrentNY) ^ 2 - R1 ^ 2) <> LastSgn And LastSgn <> -2 Then
                  If FirstCenter = False Then
                    CircleCenterX(0) = CountPoint
                    CircleCenterY(0) = MidPointY
                    FirstCenter = True
                  ElseIf FirstCenter = True Then
                    CircleCenterX(1) = CountPoint
                    CircleCenterY(1) = MidPointY
                    Exit For
                  End If
                 End If
                 LastSgn = Sgn((CountPoint - CurrentNX) ^ 2 + (MidPointY - CurrentNY) ^ 2 - R1 ^ 2)
             Next CountPoint
      End If
NextCount:
      Dim TempA As Integer, TempB As Integer  '判断那个是圆心
      If MidCenter = True Then
         I = MidPointX - CurrentNX
         J = MidPointY - CurrentNY
      Else
         If JudgePXY(X1, Y1, MidPointX, MidPointY, CircleTime) = 1 Or JudgePXY(X1, Y1, MidPointX, MidPointY, CircleTime) = 3 Then
            TempA = 3 + Sgn(JudgePXY(X1, Y1, MidPointX, MidPointY, CircleTime) - JudgePXY(CurrentNX, CurrentNY, MidPointX, MidPointY, CircleTime)) * Sgn(R1)
         Else
            TempA = 2 + Sgn(JudgePXY(CurrentNX, CurrentNY, MidPointX, MidPointY, CircleTime) - JudgePXY(X1, Y1, MidPointX, MidPointY, CircleTime)) * Sgn(R1)
         End If
         For TempB = 0 To 1
            If JudgePXY(CircleCenterX(TempB), CircleCenterY(TempB), MidPointX, MidPointY, CircleTime) = TempA Then
               I = CircleCenterX(TempB) - CurrentNX
               J = CircleCenterY(TempB) - CurrentNY
               Exit For
            End If
         Next TempB
      End If
End Sub