PSLine2000Documentation/Modules/CNCTapeRoutines.md

100 KiB

CNCTapeRoutines


VBA Code

Attribute VB_Name = "CNCTapeRoutines"
Option Compare Database   'Use database order for string comparisons
Dim SingleHitTime!, NibbleHitTime!, AccelToMaxDist!, NormalVel!, RepoVel!
Dim BasicToolChange!, ToolToTool!, AccelTime!, accel!, MinDistMoveTime!
Dim MinDistMove!, acceldecelspeed!, HitsPerMinuteNibble!, NumberStations%
Dim tools%(100), cncfiles$(15), FileStatus%(15), Etime!, ETimeParts%, ETimePercent!
Dim MetType$(5), MetThick$(5), MetSize$(5), metLine%(5), lt(5)
Dim lzfiles$(5), Mode$

Sub CalcCNCRunTimes(FL$)
'
' Fl$="900xxxxR"
'
   Dim MainDB As Database, MainSet As Recordset
   Dim MachNamesDB As Database, MachNamesSet As Recordset
   Dim MachQDB As Database, MachQSet As Recordset
   
   Set MainDB = DBEngine.Workspaces(0).Databases(0)
   
   Set MachNamesDB = DBEngine.Workspaces(0).Databases(0)
   Set MachQDB = DBEngine.Workspaces(0).Databases(0)

   Set MachNamesSet = MachNamesDB.OpenRecordset("MachineNames", DB_OPEN_TABLE)   ' Create dynaset.
   Set MachQSet = MachQDB.OpenRecordset("Machines", DB_OPEN_TABLE)   ' Create dynaset.
   Set MainSet = MainDB.OpenRecordset("Process", DB_OPEN_TABLE)   ' Create dynaset.
   
   MainSet.Index = "PrimaryKey"
   MachQSet.Index = "PartNumber"

   PartN$ = currform![PartNumber]
   
   MachQSet.MoveFirst
   MachQSet.Seek ">=", PartN$
         
   If Not (MachQSet.NoMatch) Then
      Do While Trim$(MachQSet!PartNumber) = PartN$
         MachQSet.Delete
         MachQSet.MoveNext
         If (MachQSet.EOF) Then Exit Do
      Loop
   End If
   currform.Refresh

PartN$ = FL$
PartFile$ = revpart$(FL$)
If InStr("0123456789", Left(FL$, 1)) = 0 Then
   Tsdir$ = "\" + Left(FL$, 1)
Else
   Tsdir$ = "\" + Left(FL$, 3)
End If
T1Part = "\" + FL$ + "T1"
T2Part = "\" + FL$ + "T2"
L2Part = "\" + FL$ + "L2"

   Call CNCTapeGenerate(PartFile$)

'TapeDirs$ = "C1 C2 C3 C4 C5 C6 C4 C5 C6 V1 V2 V4 C10 V5 T1 T2 T3 T4 L2 L2P L4 L4P SAL FL1"
'MachName$ = "C1 C2 C3 C4 C5 C6 C7 C8 C9 V1 V2 V4 C10 V5 T1 T2 T3 T4 L2 L2P L4 L4P SAL FL1"

TapeDirs$ = "V1 V2 V4 C10 V5 T1 T2 T3 T4 L2 L2P L4 L4P SAL FL1"
MachName$ = "V1 V2 V4 C10 V5 T1 T2 T3 T4 L2 L2P L4 L4P SAL FL1"


Do While TapeDirs$ <> ""
  
   Call Parsenum(TapeDirs$, d1$)
   TapeDirs$ = Trim$(TapeDirs$)
   Call Parsenum(MachName$, d2$)
   MachName$ = Trim$(MachName$)
   d2$ = Left$(d2$, 1) + "-" + Right$(d2$, 1) + "000"
   d3$ = ""
   If d1$ = "C10" Then d2$ = "C10000"
   direct$ = Directory$ + d1$ + PartFile$
   If d1$ = "T1" Then direct$ = Directory$ + "TC2020" + Tsdir$ + T1Part + ".lst"
   If d1$ = "T2" Then direct$ = Directory$ + "TC2020" + Tsdir$ + T2Part + ".lst"
   If d1$ = "T3" Then direct$ = Directory$ + "TC2020" + Tsdir$ + T1Part + ".lst"
   If d1$ = "T4" Then direct$ = Directory$ + "TC2020" + Tsdir$ + T2Part + ".lst"
   
   If d1$ = "L2" Then
      d2$ = "L-2 3030 FAB W/Load"
      direct$ = Directory$ + "TCL3030" + Tsdir$ + L2Part + ".lst"
   End If
   If d1$ = "L2P" Then
      d2$ = "L-2 3030 POT"
      direct$ = Directory$ + "TCL3030" + Tsdir$ + L2Part + ".lst"
   End If
   
   If d1$ = "L4" Then
      d2$ = "L-4 5030 FAB W/Load"
      direct$ = Directory$ + "TCL3030" + Tsdir$ + L2Part + ".lst"
   End If
   If d1$ = "L4P" Then
      d2$ = "L-4 5030 POT"
      direct$ = Directory$ + "TCL3030" + Tsdir$ + L2Part + ".lst"
   End If
   
   direct1$ = "": direct2$ = ""
   If d1$ = "SAL" Then
      direct1$ = Directory$ + "Salvagnini\syscon\S4_1279\production" + Tsdir$ + "\" + FL$ + ".info"
      direct2$ = Directory$ + "Salvagnini\syscon\P4M_320_1305\production" + Tsdir$ + "\" + FL$ + ".info"
      If Exists(direct2$) Then
         direct$ = direct2$
      End If
      If Exists(direct1$) Then
         direct$ = direct1$
      End If
   End If
   
    If d1$ = "FL1" Then
      d2$ = "FL-1"
      direct$ = Directory$ + "FL3030" + Tsdir$ + "\" + FL$ + ".lst"
   End If
   
   Debug.Print direct$
   
   If Exists%(direct$) Then
      Debug.Print d1$, d2$
      Select Case d1$
      Case "T1", "T2"
         '
         'per Jessie Ford/ agreed by Spud to cut runtimes in half on trumpf CNCs 13-Aug-2009
         '    increased to 60% from 50% 2-sep-2009
         '    increased to 66% from 60% 13-aug-2015 per Joe Sawyer
         Call ReadTrumpfTape(direct$, rtime!, RC%): rtime! = rtime! * 0.66
         '
         '
        Call TrumpfTape(direct$, FL$, d1$, Tsdir$)
      Case "L2", "L1", "L4"
        Call ReadTrumpfTape(direct$, rtime!, RC%)
        Call TrumpfTape(direct$, FL$, d1$, Tsdir$)
      Case "L2P", "L4P"
        Call ReadTrumpfTape(direct$, rtime!, RC%)
      Case "T3", "T4"
         '
         'per Jessie Ford/ agreed by Spud to cut runtimes in half on trumpf CNCs 13-Aug-2009
         '    increased to 60% from 50% 2-sep-2009
         '    increased to 66% from 60% 13-aug-2015 per Joe Sawyer
         Call ReadTrumpfTape(direct$, rtime!, RC%): rtime! = rtime! * 0.66
         '
         '
      
      Case "SAL"
        Call ReadSalvaTape(direct1$, direct2$, rtime!, RC%)
        Select Case RC%
           Case 0
              RC% = -1
           Case 1   '"S4/Shear and Unload"
                                    'fixed runtime of 5 seconds per Jessie and Rusty 30/nov/2009
                                    'Changed to 12.8 Per Rusty 12/Mar/2010 SG = 18Sec after Calculation
                                    'Changed to 32.8 per Rusty 6/Apr/2010 SG = 40Sec after Calculation
                                    'Changed to 51.0 per Rusty 4/May/2010 SG = 60Sec after Calculation
                                    'Changed to 69.1 per Rusty 5/May/2010 SG = 80Sec after Calculation
                                    'Changed to 32.8 per Rusty 20/Jun/2010 SG = 40Sec after Calculation (S4 Only)
                                    'Changed to 5.5 per Spud & Jessie 12/Jul/2010 SG = 10Sec after Calculation (S4 Only)
               RC% = 0
               rtime! = 5.5
               d2$ = "S4/Shear and Unload"
               GoSub AddMachines
               RC% = 0
               d2$ = "S4 and Unload"
           
           Case 2   '"P4 and Unload"
           
                                    'fixed runtime of 5 seconds per Jessie and Rusty 30/nov/2009
                                    'Changed to 12.8 Per Rusty 12/Mar/2010 SG = 18Sec after Calculation
                                    'Changed to 32.8 per Rusty 6/Apr/2010 SG = 40Sec after Calculation
                                    'Changed to 51.0 per Rusty 4/May/2010 SG = 60Sec after Calculation
                                    'Changed to 69.1 per Rusty 5/May/2010 SG = 80Sec after Calculation
                                    'Changed to 51.0 per Rusty 12/Jul/2010 SG = 60Sec after Calculation
               rtime! = 51
               RC% = 0
               d2$ = "P4 and Unload"
           
           Case 3   '"S4/P4 and Unload"
                                    
                                    'fixed runtime of 5 seconds per Jessie and Rusty 30/nov/2009
                                    'Changed to 12.8 Per Rusty 12/Mar/2010 SG = 18Sec after Calculation
                                    'Changed to 32.8 per Rusty 6/Apr/2010 SG = 40Sec after Calculation
                                    'Changed to 51.0 per Rusty 4/May/2010 SG = 60Sec after Calculation
                                    'Changed to 69.1 per Rusty 5/May/2010 SG = 80Sec after Calculation
                                    'Changed to 51.0 per Rusty 12/Jul/2010 SG = 60Sec after Calculation
               rtime! = 51
               RC% = 0
               d2$ = "S4/P4 and Unload"
               GoSub AddMachines
               RC% = 0
               d2$ = "S4/P4 Inline and Unl"
           
           Case Else
         End Select
         
          Case "FL1"
            Call FLReadTrumpfTape(direct$, rtime!, RC%)
            Call TrumpfTape(direct$, FL$, d1$, Tsdir$)
            Call TrumpfTape(direct$, FL$, "FL2", Tsdir$)
      Case Else
        Call CalcTape(d1$, direct$, rtime!, RC%)
      End Select
      
      
      Close
      GoSub AddMachines
   End If
Loop

Exit Sub
search:
   MachQSet.MoveFirst
   MachQSet.Seek "=", PartN$, A$
   If MachQSet.NoMatch Then
      fnd = False
   Else
      fnd = True
   End If
Return

AddMachines:
   If RC% = 0 Then
      MachNamesSet.MoveFirst
      
      
      While Not (MachNamesSet.EOF)
         A$ = d2$
         
         GoSub search
         If (fnd) Then
            MachQSet.Edit
            If d2$ = "S4/Shear and Unload" Then
               MachQSet!Tool = "SHR"
            Else
               MachQSet!Tool = "STD"
            End If
            MachQSet!CycleTime = Format$(rtime!, "#####.0")
         Else
            MachQSet.AddNew
            MachQSet!MachineName = A$
            If d2$ = "S4/Shear and Unload" Then
               MachQSet!Tool = "SHR"
            Else
               MachQSet!Tool = "***"
            End If
            MachQSet!CycleTime = Format$(rtime!, "#####.0")
            MachQSet!PartNumber = PartN$
         End If
         MachQSet.Update
         MachNamesSet.MoveNext
      Wend
   Else
      MachNamesSet.MoveFirst
      While Not (MachNamesSet.EOF)
         A$ = d2$
         GoSub search
         If (fnd) Then
            MachQSet.Edit
            MachQSet!Tool = "ERR"
            MachQSet!CycleTime = Format$(-1, "#####.0")
            MachQSet.Update
         End If
         MachNamesSet.MoveNext
      Wend
   End If
Return
End Sub

Sub CalcLaserRunTimes(FL$)
'
' Fl$="900xxxxR"
'
   Dim MainDB As Database, MainSet As Recordset
   Dim MachNamesDB As Database, MachNamesSet As Recordset
   Dim MachQDB As Database, MachQSet As Recordset
   
   Set MainDB = DBEngine.Workspaces(0).Databases(0)
   Set MachNamesDB = DBEngine.Workspaces(0).Databases(0)
   Set MachQDB = DBEngine.Workspaces(0).Databases(0)

   Set MachNamesSet = MachNamesDB.OpenRecordset("MachineNames", DB_OPEN_TABLE)   ' Create dynaset.
   Set MachQSet = MachQDB.OpenRecordset("Machines", DB_OPEN_TABLE)   ' Create dynaset.
   Set MainSet = MainDB.OpenRecordset("Process", DB_OPEN_TABLE)   ' Create dynaset.
   
   MainSet.Index = "PrimaryKey"
   MachQSet.Index = "PartNumber"

   PartN$ = currform![PartNumber]
   
   MachQSet.MoveFirst
   MachQSet.Seek ">=", PartN$
         
   If Not (MachQSet.NoMatch) Then
      Do While Trim$(MachQSet!PartNumber) = PartN$
         MachQSet.Delete
         MachQSet.MoveNext
         If (MachQSet.EOF) Then Exit Do
      Loop
   End If
   currform.Refresh

PartN$ = FL$

If InStr("0123456789", Left(FL$, 1)) = 0 Then
   Tsdir$ = "\" + Left(FL$, 1)
Else
   Tsdir$ = "\" + Left(FL$, 3)
End If

PartFile$ = revpart$(FL$)
T1Part = "\" + FL$ + "T1"
T2Part = "\" + FL$ + "T2"
   
   Call LaserTapeGenerate(PartFile$, PaperFlag$, RunStd!)

TapeDirs$ = "L1 L2"
MachName$ = "L1 L2"

Do While TapeDirs$ <> ""
  
   Call Parsenum(TapeDirs$, d1$)
   TapeDirs$ = Trim$(TapeDirs$)
   Call Parsenum(MachName$, d2$)
   MachName$ = Trim$(MachName$)
   d2$ = Left$(d2$, 1) + "-" + Right$(d2$, 1) + "000"
   If d1$ = "C10" Then d2$ = "C10000"
   direct$ = Directory$ + d1$ + PartFile$
   If d1$ = "T1" Then direct$ = Directory$ + "TC2020" + Tsdir$ + T1Part + ".lst"
   If d1$ = "T2" Then direct$ = Directory$ + "TC2020" + Tsdir$ + T2Part + ".lst"
   Debug.Print direct$
   
   If Exists%(direct$) Then
      Debug.Print d1$, d2$
      If (d1$ = "T1") Or (d1$ = "T2") Then
         '
         'per Jessie Ford/ agreed by Spud to cut runtimes in half on trumpf CNCs 13-Aug-2009
         '    increased to 60% from 50% 2-sep-2009
         '    increased to 66% from 60% 13-aug-2015 per Joe Sawyer
         Call ReadTrumpfTape(direct$, rtime!, RC%): rtime! = rtime! * 0.66
         '
         '
      Else
        Call CalcTape(d1$, direct$, rtime!, RC%)
      End If
      Close
   
      If RC% = 0 Then
         MachNamesSet.MoveFirst
         
         
         While Not (MachNamesSet.EOF)
            A$ = d2$
            GoSub search
            If (fnd) Then
               MachQSet.Edit
               MachQSet!Tool = "STD"
               MachQSet!CycleTime = Format$(rtime!, "#####.0")
            Else
               MachQSet.AddNew
               MachQSet!MachineName = A$
               MachQSet!Tool = "***"
               MachQSet!CycleTime = Format$(rtime!, "#####.0")
               MachQSet!PartNumber = PartN$
            End If
            MachQSet.Update
            MachNamesSet.MoveNext
         Wend
      Else
         MachNamesSet.MoveFirst
         While Not (MachNamesSet.EOF)
            A$ = d2$
            GoSub search
            If (fnd) Then
               MachQSet.Edit
               MachQSet!Tool = "ERR"
               MachQSet!CycleTime = Format$(-1, "#####.0")
               MachQSet.Update
            End If
            MachNamesSet.MoveNext
         Wend
      End If
   End If
Loop

Exit Sub
search:
   MachQSet.MoveFirst
   MachQSet.Seek "=", PartN$, A$
   If MachQSet.NoMatch Then
      fnd = False
   Else
      fnd = True
   End If
Return

End Sub
Sub ReadSalvaTape(direct1$, direct2$, rtime!, RC%)
   rtime! = 0: Flag = False: RC% = 0
   If Exists(direct1$) Then 'this is the S4 File
      direct$ = direct1$
      GoSub parseSAL
      If fnd Then RC = 1
      If rt2! = 0 Then
         rtime! = 73             'default S4 if  return is 0   (per SG as of 16/nov/2009)
      End If
   End If
   If Exists(direct2$) Then 'this is the P4 File
      direct$ = direct2$
      GoSub parseSAL
      If fnd Then RC = RC + 2
      If rt2! = 0 Then
         rtime! = rtime! + 50    'default P4 if  return is 0   (per SG as of 16/nov/2009)
      End If
   End If
'   If Flag Then rtime! = 300
   Exit Sub
   
parseSAL:
   rt2! = 0
   Open direct$ For Input As #1
   fnd = False
   Do While Not (EOF(1))
      Line Input #1, qx$
      qx$ = Trim(qx$)
      If qx$ <> "" Then
         Call PARSE(qx$, Op$, " ", rx%)
         Call PARSE(qx$, vl$, " ", rx%)
         If Op$ = "50" Then
            fnd = True
            If vl$ = "0" Then Flag = True
            rtime! = rtime! + Val(vl$)
            rt2! = rt2! + Val(vl$)
            Exit Do
         End If
      End If
   Loop
   Close #1
   Return
   
End Sub

Sub ReadTrumpfTape(PartFile$, seconds!, retcd%)
   fLst = "FindRecStruct"
   If Exists(PartFile$) Then
      If UCase(Right(PartFile$, 6)) = "L2.LST" Then
         fld$ = ".1666666666666667"
         fLst = "GotIt"
      Else
         Open PartFile$ For Input As 1
         Do While Not EOF(1)
            Line Input #1, ab$
            Select Case fLst
               Case "FindRecStruct"
                  If Left(ab$, 5) = "ZA,MM" Then
                     Call PARSE(ab$, cmd$, ",", RC%)
                     Call PARSE(ab$, RecTyp$, ",", RC%)
                     Call PARSE(ab$, fc$, ",", RC%)
                     fieldCnt = Val(fc$)
                     FieldSrch = 0
                     fLst = "ReadStruct"
                  End If
               Case "ReadStruct"
                  If Left(ab$, 2) = RecTyp$ Then    'MM,AT,1,  10,1,1,,'Maschine'
                      fieldCnt = fieldCnt - 1
                      FieldSrch = FieldSrch + 1
                      Call PARSE(ab$, cmd$, ",", RC%) 'MM
                      Call PARSE(ab$, cmd$, ",", RC%) 'AT
                      Call PARSE(ab$, cmd$, ",", RC%) '1
                      Call PARSE(ab$, cmd$, ",", RC%) '  10
                      Call PARSE(ab$, cmd$, ",", RC%) '1
                      Call PARSE(ab$, cmd$, ",", RC%) '1
                      Call PARSE(ab$, FieldVl$, ",", RC%) ' 'Maschine'
                      If Trim(FieldVl$) = "'Maschinenzeit'" Then
                         FieldPos = FieldSrch + 1
                         fLst = "FindData"
                      End If
                  End If
               Case "FindData"
                  If Left(ab$, 5) = "ZA,DA" Then
                     fLst = "ReadRec"
                  End If
               Case "ReadRec"
                  If Left(ab$, 2) = "DA" Then    'DA,'L3030S',1,'Sin 840D',1,'FRYMASTER','2000821B','GARRETT',
                     rec$ = ab$
                     fLst = "ReadRest"
                  End If
               Case "ReadRest"
                  If Left(ab$, 2) = "* " Then
                      rec$ = rec$ + Mid(ab$, 4)
                  ElseIf Left(ab, 1) = "C" Then
                      zRec$ = rec$
                      For ix = 1 To FieldPos
                         C = InStr(rec$, ",")
                         If C <> 0 Then
                            fld$ = Left(rec$, C - 1)
                            rec$ = Mid(rec$, C + 1)
                         End If
                      Next
                      fLst = "GotIt"
                      Exit Do
                  End If
               Case Else
            End Select
         Loop
         Close #1
      End If
   End If
   If fLst = "GotIt" Then
      seconds = Val(Trim(fld$)) * 60
      retcd = 0
   Else
      seconds = 99999
      retcd = 1
   End If
End Sub

Sub FLReadTrumpfTape(PartFile$, seconds!, retcd%)
   fLst = "FindRecStruct"
   If Exists(PartFile$) Then
      If UCase(Right(PartFile$, 6)) = "L2.LST" Then
         fld$ = ".1666666666666667"
         fLst = "GotIt"
      Else
         Open PartFile$ For Input As 1
         Do While Not EOF(1)
            Line Input #1, ab$
            Select Case fLst
               Case "FindRecStruct"
                  If Left(ab$, 5) = "ZA,MM" Then
                     Call PARSE(ab$, cmd$, ",", RC%)
                     Call PARSE(ab$, RecTyp$, ",", RC%)
                     Call PARSE(ab$, fc$, ",", RC%)
                     fieldCnt = Val(fc$)
                     FieldSrch = 0
                     fLst = "ReadStruct"
                  End If
               Case "ReadStruct"
                  If Left(ab$, 2) = RecTyp$ Then    'MM,AT,1,  10,1,1,,'Maschine'
                      fieldCnt = fieldCnt - 1
                      FieldSrch = FieldSrch + 1
                      Call PARSE(ab$, cmd$, ",", RC%) 'MM
                      Call PARSE(ab$, cmd$, ",", RC%) 'AT
                      Call PARSE(ab$, cmd$, ",", RC%) '1
                      Call PARSE(ab$, cmd$, ",", RC%) '  10
                      Call PARSE(ab$, cmd$, ",", RC%) '1
                      Call PARSE(ab$, cmd$, ",", RC%) '1
                      Call PARSE(ab$, FieldVl$, ",", RC%) ' 'Maschine'
                      If Trim(FieldVl$) = "'Maschinenzeit'" Then
                         FieldPos = FieldSrch
                         fLst = "FindData"
                      End If
                      If FieldSrch = Val(fc$) Then fLst = "FindRecStruct"
                  
                  End If
               Case "FindData"
                  If Left(ab$, 5) = "ZA,DA" Then
                     fLst = "ReadRec"
                  End If
               Case "ReadRec"
                  If Left(ab$, 2) = "DA" Then    'DA,'L3030S',1,'Sin 840D',1,'FRYMASTER','2000821B','GARRETT',
                     rec$ = ab$
                     fLst = "ReadRest"
                  End If
               Case "ReadRest"
                  If Left(ab$, 2) = "* " Then
                      rec$ = rec$ + Mid(ab$, 4)
                  ElseIf Left(ab, 1) = "C" Then
                      zRec$ = rec$
                      For ix = 0 To FieldPos
                         C = InStr(rec$, ",")
                         If C <> 0 Then
                            fld$ = Left(rec$, C - 1)
                            rec$ = Mid(rec$, C + 1)
                         End If
                      Next
                      fLst = "GotIt"
                      Exit Do
                  End If
               Case Else
            End Select
         Loop
         Close #1
      End If
   End If
   If fLst = "GotIt" Then
      seconds = Val(Trim(fld$)) * 60
      retcd = 0
   Else
      seconds = 99999
      retcd = 1
   End If
End Sub

Sub CalcTape(Turret$, PartFile$, seconds!, retcd%)


     Debug.Print "Processing "; Turret$, PartFile$
lcnt = lcnt + 1

Call InitTurret(Turret$)
pi! = 4 * Atn(1)
Radians! = pi! / 180
Punchtime! = SingleHitTime!
NibbleHitTime! = 60 / HitsPerMinuteNibble!
RepoVel! = NormalVel! / 4
Velocity! = NormalVel!
NibbleFlag! = 0
RepoTime! = 5
RepoFlag! = 0
NoTime! = 0

GoSub ToolInit

LastX! = 0
LastY! = 0
LastT = 0
Beginning = 1
seconds! = 0

Open PartFile$ For Input As #1
While Not EOF(1)
   Line Input #1, A$
   Debug.Print rpad$(A$, 27);
   A$ = UCase$(Trim$(A$))
   If (Left$(A$, 1) = "N") And (Left$(A$, 3) <> "NBL") Then
      Call Parsenum(A$, n$)
   End If
   If (Left$(A$, 1) = "C") And (Left$(A$, 3) <> "CAA") Then
      Call Parsenum(A$, n$)
   End If

   Call RemoveComments(A$)
   If A$ <> "" Then
      GoSub ProcessText
   Else
      GoSub PrintHeader
      lcnt = lcnt + 1
   End If
Wend
Close
Debug.Print PartFile$; "  "; Turret$; seconds!
Exit Sub

ProcessText:
   cmd$ = Left$(A$, 4)
   If ((Right$(cmd$, 1) = "/") Or (Right$(cmd$, 1) = "#")) And (cmd$ <> "MOV/") And (cmd$ <> "REP/") Then
      Select Case cmd$

         Case "NBL/"
            Punchtime! = NibbleHitTime!
            NibbleFlag! = 1
            Debug.Print rpad$(" ", 27);
            Debug.Print
            lcnt = lcnt + 1

         Case "CAA/"
            A$ = Mid$(A$, 5)

            Call getchar(A$, direct$, 1)        ' Direction L, R, Z
          
            Call Parsenum(A$, n$)               ' Length of slot
            dist! = Val(n$)
          
            Call Parsenum(A$, n$)               ' Tool diameter
            ToolDiam! = Val(n$)
          
            Call Parsenum(A$, n$)               ' angle
            angl% = Val(n$)
         
            Call Parsenum(A$, n$)               ' pitch distance per hit
            pitch! = Val(n$)
          
            If pitch! = 0 Then
               Debug.Print "I DIED  ---  invalid pitch parm on CAA cmd"
               seconds! = 0
               retcd% = 1
               Exit Sub
            Else
               hits = (dist! / pitch!) + 0.5
            End If

            ToolDiam! = ToolDiam! / 2

            Sx! = 0
            Sy! = 0
            If direct$ = "L" Then
               Sx! = ToolDiam! * Cos((angl% + 90) * Radians!)
               Sy! = ToolDiam! * Sin((angl% + 90) * Radians!)
            Else
               If direct$ = "R" Then
                  Sx! = ToolDiam! * Cos((angl% - 90) * Radians!)
                  Sy! = ToolDiam! * Sin((angl% - 90) * Radians!)
               End If
            End If

            ToolTime! = RelT!
            x! = Sx! + RelX!
            Y! = Sy! + RelY!
            NibbleFlag! = 0
            GoSub CalculateTime
            NibbleFlag! = 1
            Debug.Print rpad$(" ", 27);

            For H = 1 To hits
               x! = LastX! + pitch! * Cos(angl% * Radians!)
               Y! = LastY! + pitch! * Sin(angl% * Radians!)
               GoSub CalculateTime
               Debug.Print rpad$(" ", 27);
            Next
            Debug.Print
            lcnt = lcnt + 1
            NibbleFlag! = 0
       
         Case "LAA/"
            A$ = Mid$(A$, 5)
            Call Parsenum(A$, n$)
            dist! = Val(n$)
            Call Parsenum(A$, n$)
            angl% = Val(n$)
            Call Parsenum(A$, n$)
            hits = Val(n$)
            For H = 1 To hits
               x! = LastX! + dist! * Cos(angl% * Radians!)
               Y! = LastY! + dist! * Sin(angl% * Radians!)
               GoSub CalculateTime
               Debug.Print rpad$(" ", 27);
            Next
            Debug.Print
            lcnt = lcnt + 1
            NibbleFlag! = 0

         Case "ARC/"
            A$ = Mid$(A$, 5)
            Call Parsenum(A$, n$)
            radius! = Val(n$)
            Call Parsenum(A$, n$)
            angl% = Val(n$)
            Call Parsenum(A$, n$)
            INCR! = Val(n$)
            Call Parsenum(A$, n$)
            hits = Val(n$)
            ToolTime! = RelT!
            For H = 0 To hits - 1
               x! = RelX! + radius! * Cos((angl% + INCR! * H) * Radians!)
               Y! = RelY! + radius! * Sin((angl% + INCR! * H) * Radians!)
               GoSub CalculateTime
               Debug.Print rpad$(" ", 27);
            Next
            Debug.Print
            lcnt = lcnt + 1
            NibbleFlag! = 0

         Case "RAD/"
            OpnN! = NibbleFlag!
            NibbleFlag! = 0
           
            A$ = Mid$(A$, 5)
            Call getchar(A$, IorO$, 1)        ' Inside or Outside

            Call Parsenum(A$, n$)
            radius! = Val(n$)
          
            Call Parsenum(A$, n$)
            ToolDiam! = Val(n$)

            Call Parsenum(A$, n$)
            StartAngle! = Val(n$) * Radians!
          
            Call Parsenum(A$, n$)
            Arc! = Val(n$) * Radians!

            Call Parsenum(A$, n$)
            dist! = Val(n$)
          
            If IorO$ = "O" Then
               radius! = radius! + ToolDiam! / 2
            Else
               radius! = radius! - ToolDiam! / 2
            End If
            ToolTime! = RelT!
            If radius = 0 Then
               Theta! = pi / 2
            Else
               Theta! = Atn(dist! / radius!)
            End If
          
            PunchAngle! = StartAngle!
            Do Until Arc! <= 0
               x! = RelX! + radius! * Cos(PunchAngle!)
               Y! = RelY! + radius! * Sin(PunchAngle!)
               GoSub CalculateTime
               Debug.Print rpad$(" ", 27);
               PunchAngle! = PunchAngle! + Theta!
               Arc! = Arc! - Theta!
               NibbleFlag! = OpnN!
            Loop
            Debug.Print
            lcnt = lcnt + 1
            NibbleFlag! = 0

         Case "OPN/", "HOL/"
            OpnN! = NibbleFlag!
            NibbleFlag! = 0
            Punchtime! = SingleHitTime!
            A$ = Mid$(A$, 5)
            Call Parsenum(A$, n$)
            OpeningRad! = Val(n$) / 2
            Call Parsenum(A$, n$)
            ToolDiam! = Val(n$)
            Call Parsenum(A$, n$)
            pitch! = Val(n$)

            ToolRads! = ToolDiam! / 2
          
            NoOfCircles = 1
            concent = (OpeningRad! / ToolRads!) - 1
          
            ToolTime! = RelT!
            x! = RelX!
            Y! = RelY!
            centX! = x!
            centY! = Y!
            If cmd$ <> "HOL/" Then
               GoSub CalculateTime
               Debug.Print rpad$(" ", 27);
               PunchCount = PunchCount + 1
            
               For i = 1 To concent
                  NoOfCircles = 4 * (i)
                  If NoOfCircles = 0 Then NoOfCircles = 1
                  Theta! = 0
                  vect = i * ToolRads!
                  For j = 0 To NoOfCircles - 1
                     Theta! = Theta! + (360 / NoOfCircles)
                     x! = centX! + Sin(Theta! * (pi! / 180)) * vect
                     Y! = centY! + Cos(Theta! * (pi! / 180)) * vect
                   
                     GoSub CalculateTime
                     Debug.Print rpad$(" ", 27);
                     PunchCount = PunchCount + 1
  
                  Next
               Next
            End If
            BuffRad! = (OpeningRad! - ToolRads!)
            Theta! = Atn(pitch! / BuffRad!)
            If OpnN! = 1 Then
               NibbleFlag! = 1
               Punchtime! = NibbleHitTime!
            End If
            For j = 0 To 2 * pi! Step Theta!
               x! = Sin(j) * BuffRad! + centX!
               Y! = Cos(j) * BuffRad! + centY!

               GoSub CalculateTime
               Debug.Print rpad$(" ", 27);
             
               PunchCount = PunchCount + 1
            Next
            NibbleFlag! = 0
            Debug.Print "Number of hits = "; PunchCount
            lcnt = lcnt + 1

       
         Case "INC/"
            A$ = Mid$(A$, 5)

            Call getchar(A$, direct$, 1)        ' Direction L, R, U, D
            Lr = 0: UD = 0
            Select Case direct$
               Case "L"
                  Lr = -1
               Case "R"
                  Lr = 1
               Case "U"
                  UD = 1
               Case "D"
                  UD = -1
               Case Else
            End Select
            If (Lr = 0) And (UD = 0) Then
               seconds! = 0
               RetCod$ = "Error - INC Command has no direction"
               retcd% = 1
               Exit Sub
            End If

         
            Call Parsenum(A$, n$)
            dist! = Val(n$)
          
            Call Parsenum(A$, n$)
            hits = Val(n$)
          
            ToolTime! = RelT!
            For H = 0 To hits - 1
               x! = LastX! + dist! * Lr
               Y! = LastY! + dist! * UD
               GoSub CalculateTime
               Debug.Print rpad$(" ", 27);
            Next
            Debug.Print
            lcnt = lcnt + 1
            NibbleFlag! = 0
            
         Case "BHC/"
            A$ = Mid$(A$, 5)
            Call Parsenum(A$, n$)
            radius! = Val(n$)
            Call Parsenum(A$, n$)
            angl% = Val(n$)
            Call Parsenum(A$, n$)
            hits = Val(n$)
            ToolTime! = RelT!
            For H = 0 To hits - 1
               x! = RelX! + radius! * Cos((angl% + (360 / hits) * H) * Radians!)
               Y! = RelY! + radius! * Sin((angl% + (360 / hits) * H) * Radians!)
               GoSub CalculateTime
               Debug.Print rpad$(" ", 27);
            Next
            Debug.Print
            lcnt = lcnt + 1
            NibbleFlag! = 0
             
         Case "GRD/"
            A$ = Mid$(A$, 5): A$ = Trim$(A$)
            Call getchar(A$, d1$, 1): A$ = Trim$(A$)
            Call Parsenum(A$, n$)
            dist1! = Val(n$)
            Call Parsenum(A$, n$)
            hits1 = Val(n$)
            Call getchar(A$, d2$, 1): A$ = Trim$(A$)
            Call Parsenum(A$, n$)
            dist2! = Val(n$)
            Call Parsenum(A$, n$)
            hits2 = Val(n$)
            Do Until hits2 = -1
               For hi = 1 To hits1
                  Select Case d1$
                     Case "U"
                        x! = LastX!
                        Y! = LastY! + dist1!
                     Case "D"
                        x! = LastX!
                        Y! = LastY! - dist1!
                     Case "L"
                        x! = LastX! - dist1!
                        Y! = LastY!
                     Case "R"
                        x! = LastX! + dist1!
                        Y! = LastY!
                     Case Else
                        seconds! = 0
                        RetCod$ = "I DIED  ---  INVALID COMMAND 1"
                        retcd% = 1
                        Exit Sub
                     End Select
                  GoSub CalculateTime
                  Debug.Print rpad$(" ", 27);
               Next
               Select Case d2$
                  Case "U"
                     x! = LastX!
                     Y! = LastY! + dist2!
                  Case "D"
                     x! = LastX!
                     Y! = LastY! - dist2!
                  Case "L"
                     x! = LastX! - dist2!
                     Y! = LastY!
                  Case "R"
                     x! = LastX! + dist2!
                     Y! = LastY!
                  Case Else
                     seconds! = 0
                     RetCod$ = "I DIED  ---  INVALID COMMAND 2"
                     retcd% = 1
                     Exit Sub
                  End Select
               Select Case d1$
                     Case "U"
                        d1$ = "D"
                     Case "D"
                        d1$ = "U"
                     Case "L"
                        d1$ = "R"
                     Case "R"
                        d1$ = "L"
                     Case Else
                        RetCod$ = "I DIED  ---  INVALID COMMAND 3"
                        retcd% = 1
                        seconds! = 0
                        Exit Sub
               End Select
               If hits2 <> 0 Then
                  GoSub CalculateTime
               End If
               Debug.Print rpad$(" ", 27);
               hits2 = hits2 - 1
            Loop
            Debug.Print
            lcnt = lcnt + 1
            NibbleFlag! = 0

         Case "OFS/"
            A$ = Mid$(A$, 5)
            Call Parsenum(A$, n$)
            x! = Val(n$)
            Call Parsenum(A$, n$)
            Y! = Val(n$)
            LastX! = LastX! + x!
            LastY! = LastY! + Y!

         Case "FRM/", "MAT/", "MGR/"
            Debug.Print rpad$(" ", 27);
            Debug.Print
            lcnt = lcnt + 1
       
         Case Else
            GoSub Undeveloped
            Exit Sub
      End Select

      If cmd$ <> "NBL/" Then
         Punchtime! = SingleHitTime!
      End If
 
   Else
      
     x! = LastX!
     Y! = LastY!
     CommandTime! = 0
     NoPunch = 0
     ToolTime! = 0
   
     If cmd$ = "MOV/" Then
        A$ = Mid$(A$, 5)
        NoTime! = 1
        NoPunch = 1
     End If
   
     If cmd$ = "REP/" Then
        A$ = Mid$(A$, 5)
     End If
   
  
     Do Until A$ = ""
        Call getchar(A$, v$, 1)
        b$ = A$
        Call Parsenum(A$, n$)
        Select Case v$
           Case "X"
              x! = Val(n$)
           Case "Y"
              Y! = Val(n$)
           Case "D"
              Call getchar(b$, w$, 1)
              Call Parsenum(b$, n$)
              A$ = b$
              If w$ = "X" Then
                 If cmd$ = "REP/" Then
                    n$ = "-" + n$
                 End If
                 x! = LastX! + (Val(n$) * -1)
                 Velocity! = RepoVel!
                 RepoFlag! = 1
              Else
                 Y! = LastY! + Val(n$)
                 NoTime! = 1
              End If
              NoPunch = 1
           Case "T"
              TNumb = Val(n$)
              GoSub ToolChangeTime
           Case "M"
              MNumb = Val(n$)
              NoTime! = 1
              NoPunch = 1
           Case "%"
              NoPunch = 1
           Case Else
        End Select
     Loop
     GoSub CalculateTime
     GoSub CheckLineCount
   End If
Return
CalculateTime:
   If Beginning = 1 Then
      DistX! = 0
      DistY! = 0
      Homing = 2
      HomeX! = x!
      Homey! = Y!
      Beginning = 0
   Else
      DistX! = Abs(x! - LastX!)
      DistY! = Abs(Y! - LastY!)
   End If
   If DistX! > DistY! Then
      dist! = DistX!
   Else
      dist! = DistY!
   End If


   If (x! = HomeX!) And (Y! = Homey!) Then
      dist! = 0
   End If

   If dist! = 0 Or NibbleFlag! = 1 Then
      disttime! = 0
   Else
      If dist! >= AccelToMaxDist! Then
         disttime! = AccelTime! + (dist! - AccelToMaxDist!) / Velocity!
      Else
         If (dist! <= MinDistMove!) And (dist! > 0) Then
            disttime! = MinDistMoveTime!
         Else
             tempdist! = dist! - MinDistMove!
             disttime! = MinDistMoveTime! + (tempdist! * acceldecelspeed!)
         End If
      End If
   End If

 
   If disttime! > ToolTime! Then
      CommandTime! = disttime!
   Else
      CommandTime! = ToolTime!
   End If

   If NoPunch = 0 Then
      CommandTime! = Punchtime! + CommandTime!
      Punching! = Punchtime!
   Else
      CommandTime! = CommandTime!
      Punching! = 0
   End If

   If NoTime! = 1 Then
      Punching! = 0
      disttime! = 0
      CommandTime! = 0
   End If
   If RepoFlag! = 1 Then
      CommandTime! = RepoTime! + disttime!
   End If

   seconds! = seconds! + CommandTime!
   If cmd$ = "MOV/" Then
      'debug.PRINT "##.###~##.###~##.###~.###~#.#~#.####  #.#### ###.####"; x!, Y!, dist!, Punching!, 0!, disttime!, CommandTime!, Seconds!
      Debug.Print x!, Y!, dist!, Punching!, 0!, disttime!, CommandTime!, seconds!
      RelX! = x!
      RelY! = Y!
      RelT! = ToolTime!
   Else
      'debug.PRINT USING "##.###~##.###~##.###~.###~#.#~#.####  #.#### ###.####"; x!, Y!, dist!, Punching!, ToolTime!, disttime!, CommandTime!, Seconds!
      Debug.Print x!, Y!, dist!, Punching!, ToolTime!, disttime!, CommandTime!, seconds!
      LastX! = x!
      LastY! = Y!
   End If
   lcnt = lcnt + 1
   Velocity! = NormalVel!
   ToolTime! = 0
   RepoFlag! = 0
   NoTime! = 0
   NoPunch = 0
   GoSub CheckLineCount
Return


CheckLineCount:
   If lcnt > 20 Then
      GoSub PrintHeader
      lcnt = 0
   End If
Return


PrintHeader:
   Debug.Print "   X      Y     Dis   PT   TT   DT    CMDTIM    SEC's";
Return

Undeveloped:
   RetCod$ = "Unable To Calculate RunTime"
   retcd% = 1
   seconds! = 0
Return


ToolChangeTime:
   NumberStations% = NumberStations%
   TT = tools(TNumb)
   t1 = Abs(TT - LastT)
   T2 = 36 - t1
   ToolTime! = t1 * ToolToTool! + BasicToolChange!
   LastT = TT
Return

ToolInit:
   For t = 1 To 54
      tools(t) = t
   Next
'   FOR t = 18 TO 36
'      tools(t) = t + 1
'   NEXT
'   t = 35
'   t = t + 1: tools(t) = 3
'   t = t + 1: tools(t) = 4
'   t = t + 1: tools(t) = 6
'   t = t + 1: tools(t) = 8
'   t = t + 1: tools(t) = 10
'   t = t + 1: tools(t) = 11
'   t = t + 1: tools(t) = 12
'   t = t + 1: tools(t) = 14
'   t = t + 1: tools(t) = 16
'   t = t + 1: tools(t) = 18
'   t = t + 1: tools(t) = 20 + 1
'   t = t + 1: tools(t) = 21 + 1
'   t = t + 1: tools(t) = 23 + 1
'   t = t + 1: tools(t) = 25 + 1
'   t = t + 1: tools(t) = 27 + 1
'   t = t + 1: tools(t) = 28 + 1
'   t = t + 1: tools(t) = 29 + 1
'   t = t + 1: tools(t) = 31 + 1
'   t = t + 1: tools(t) = 33 + 1

Return


End Sub

Function Center$(st$, l%)
   st$ = RTrim$(LTrim$(st$))
   If l% > 0 Then
      x% = l% - Len(st$)
      If x% > 0 Then
         x% = Int(x% / 2)
         C$ = Left$(Space$(x%) + st$ + Space$(l%), l%)
      Else
         C$ = Left$(st$, l%)
      End If
      Center$ = C$
   Else
      Center$ = ""
   End If
End Function

Sub CNCTapeGenerate(Part2Build$)
   'pt$ = Left$(part2Build$, 7) + "." + Right$(part2Build$, 1)
   'Rev$ = Right$(part2Build$, 1)
   currform!CNCRemoval.Caption = " "
   Close
   
   MetalName$ = currform!Field113.Column(0)
   
   Dim MainDB As Database, MainSet As Recordset
   Set MainDB = DBEngine.Workspaces(0).Databases(0)
   
   pt$ = Part2Build$
   rg1% = 1: rg2% = 1
   TrumpP = 0
   VirtPart$ = Directory$ + "VT1" + pt$
   Set MainSet = MainDB.OpenRecordset("TurretC1-C2", DB_OPEN_TABLE)   ' Create dynaset.
   If Not (Exists%(VirtPart$)) Then
      VirtPart$ = Directory$ + "VT2" + pt$
      Set MainSet = MainDB.OpenRecordset("TurretC3-C9", DB_OPEN_TABLE)   ' Create dynaset.
      rg1% = 1: rg2% = 14  '14 WAS 13 S.G.
      If Not (Exists%(VirtPart$)) Then
         VirtPart$ = Directory$ + "TRUMPSRC" + pt$ + ".lst"
         If (Exists%(VirtPart$)) Then
            GoSub TrumpMaker
         End If
         Exit Sub
      End If
   End If
   
   MainSet.Index = "PrimaryKey"
   cncfiles$(1) = Directory$ + "C1\" + pt$
   cncfiles$(2) = Directory$ + "C2\" + pt$
   cncfiles$(3) = Directory$ + "C3\" + pt$
   cncfiles$(4) = Directory$ + "C4\" + pt$
   cncfiles$(5) = Directory$ + "C5\" + pt$
   cncfiles$(6) = Directory$ + "C6\" + pt$
   cncfiles$(7) = Directory$ + "C7\" + pt$
   cncfiles$(8) = Directory$ + "C8\" + pt$
   cncfiles$(9) = Directory$ + "C9\" + pt$
   cncfiles$(10) = Directory$ + "V1\" + pt$
   cncfiles$(11) = Directory$ + "V2\" + pt$
   cncfiles$(12) = Directory$ + "V4\" + pt$
   cncfiles$(13) = Directory$ + "C10\" + pt$
   cncfiles$(14) = Directory$ + "V5\" + pt$  'ADDED V5 S.G.

   For fileno% = 1 To 14 '14 WAS 13 S.G.
      FileStatus%(fileno%) = 0
   Next

   For i = 0 To 5

      If InStr(MetalName$, "S/S") > 0 Then
         MetType$(i) = "6"
      Else
         MetType$(i) = "1"
      End If
      
      MetSize$(i) = ""
      metLine%(i) = 0
      lt(i) = 0
   Next
   
   Open VirtPart$ For Input As #15
   If rg1% = 1 Then
      Open cncfiles$(1) For Output As #1
'   Else
      Open cncfiles$(2) For Output As #2
      Open cncfiles$(3) For Output As #3
      Open cncfiles$(4) For Output As #4
      Open cncfiles$(5) For Output As #5
      Open cncfiles$(6) For Output As #6
      Open cncfiles$(7) For Output As #7
      Open cncfiles$(8) For Output As #8
      Open cncfiles$(9) For Output As #9
      Open cncfiles$(10) For Output As #10
      Open cncfiles$(11) For Output As #11
      Open cncfiles$(12) For Output As #12
      Open cncfiles$(13) For Output As #13
      Open cncfiles$(14) For Output As #14  'ADDED V5 S.G.
   End If

   Do While Not (EOF(15))
      Line Input #15, A$
      Debug.Print A$
      C$ = A$
      GoSub GetTurret
      For fileno% = rg1% To rg2%
         If FileStatus%(fileno%) = 0 Then
            If TurretRC% = True Then
               GoSub SearchVirtTable
               If fnd% = True Then
                  GoSub ReplaceTool
               Else
                  Debug.Print turr$, fileno%
                        q$ = fileno%
        
                        If q$ = 1 Then
                            q$ = "==>C-1"
                        ElseIf q$ = 2 Then
                                q$ = "==>C-2"
                        ElseIf q$ = 3 Then
                                q$ = "==>C-3"
                        ElseIf q$ = 4 Then
                                q$ = "==>C-4"
                        ElseIf q$ = 5 Then
                                q$ = "==>C-5"
                        ElseIf q$ = 6 Then
                                q$ = "==>C-6"
                        ElseIf q$ = 7 Then
                                q$ = "==>C-7"
                        ElseIf q$ = 8 Then
                                q$ = "==>C-8"
                        ElseIf q$ = 9 Then
                                q$ = "==>C-9"
                        ElseIf q$ = 10 Then
                                q$ = "==>V-1"
                        ElseIf q$ = 11 Then
                                q$ = "==>V-2"
                        ElseIf q$ = 12 Then
                                q$ = "==>V-4"
                        ElseIf q$ = 13 Then
                                q$ = "==>C-10"
                        ElseIf q$ = 14 Then
                                q$ = "==>V-5"
                        End If
                                                                                                         '+ "==>C" +
                  currform!CNCRemoval.Caption = Trim$(currform!CNCRemoval.Caption + "    " + Trim$(turr$) + q$) ' + Trim$(Str$(Fileno%)))
                  Debug.Print A$
                  Debug.Print Des$
                  GoSub CloseFile
               End If
            End If
            If fileno% = 1 Then     'C1
               If InStr(C$, "M03") <> 0 Then
                  Call PARSE(C$, xv$, " ", RC%)
                  yval = Val(Mid$(C$, 3))
                  If yval > 39.37 Then yval = 39.37
                  Call PARSE(C$, xv$, " ", RC%)
                  yv$ = " Y" + Format(yval, "0.000") + " "
                  C$ = "X39.370" + yv$ + C$
               End If
               If InStr(C$, "SHEET X,Y") <> 0 Then
                  tty$ = Mid$(C$, InStr(C$, ":") + 1)
                  Call PARSE(tty$, xv$, " ", RC%)
                  xxx = Val(xv$)
                  Call PARSE(tty$, yv$, " ", RC%)
                  yyy = Val(yv$)
                  If xxx > 39.37 Then
                     GoSub CloseFile
                  End If
                  If yyy > 39.37 Then
                     GoSub CloseFile
                  End If
               End If
               '
               '
               '
               If (TurretRC% = True) Then
                  If Trim$(turr$) = "T36" Then
                     watchforC = True
                     replc00$ = "T16"
                     replc45$ = "T18"
                  ElseIf Trim$(turr$) = "T18" Then
                     watchforC = True
                     replc00$ = "T01"
                  Else
                     watchforC = False
                  End If
                     
               End If
               If watchforC Then
                  xx = InStr(C$, "C")
                  If xx <> 0 Then
                     If Left(C$, xx - 1) = "" Then
                        C$ = ""
                     Else
                        cP$ = Mid(C$, xx)
                        Call PARSE(cP$, tuV$, " ", RC%)
                        
                        Select Case Val(Mid(tuV$, 2))
                           Case 90, 270
                              TurRpl$ = replc00$
                           Case 0, 180
                              If Trim$(turr$) = "T18" Then GoSub CloseFile
                              TurRpl$ = replc00$
                           Case 45, 135, 225, 315
                              If Trim$(turr$) = "T18" Then GoSub CloseFile
                              TurRpl$ = replc45$
                           Case Else
                              GoSub CloseFile
                        End Select
                        xx2 = InStr(C$, "T")
                        If xx2 <> 0 Then
                           If xx2 < xx Then xx = xx2
                        End If
                        If xx <> 0 Then
                           C$ = Left(C$, xx - 1) + TurRpl$
                           If C$ = TurRpl$ Then C$ = ""
                        End If
                     End If
                  End If
               End If
               '
               '
               '
            End If
            If fileno% = 2 Then     'C2
               If InStr(C$, "M03") <> 0 Then
                  Call PARSE(C$, xv$, " ", RC%)
                  yval = Val(Mid$(C$, 3))
                  If yval > 39.37 Then yval = 39.37
                  Call PARSE(C$, xv$, " ", RC%)
                  yv$ = " Y" + Format(yval, "0.000") + " "
                  C$ = "X49.213" + yv$ + C$
               End If
               
               If InStr(C$, "SHEET X,Y") <> 0 Then
                  tty$ = Mid$(C$, InStr(C$, ":") + 1)
                  Call PARSE(tty$, xv$, " ", RC%)
                  xxx = Val(xv$)
                  Call PARSE(tty$, yv$, " ", RC%)
                  yyy = Val(yv$)
                  If xxx > 49.213 Then
                     GoSub CloseFile
                  End If
                  If yyy > 49.213 Then
                     GoSub CloseFile
                  End If
               End If
            
            End If
            If (fileno% >= 10) Then
               GoSub Vectrum
            End If
               
            GoSub WriteLine
         End If
         C$ = A$
      Next
   Loop
   Close






   pt$ = Part2Build$
   VirtPart$ = Directory$ + "VT3" + pt$

   If Exists%(VirtPart$) Then


      currform!CNCRemoval.Caption = " "
      
      MetalName$ = currform!Field113.Column(0)
      

      Set MainDB = DBEngine.Workspaces(0).Databases(0)
      rg1% = 6: rg2% = 14  '14 WAS 13 S.G.
      
      Set MainSet = MainDB.OpenRecordset("TurretC3-C9", DB_OPEN_TABLE)   ' Create dynaset.
      
      MainSet.Index = "PrimaryKey"
      cncfiles$(1) = Directory$ + "C1\" + pt$
      cncfiles$(2) = Directory$ + "C2\" + pt$
      cncfiles$(3) = Directory$ + "C3\" + pt$
      cncfiles$(4) = Directory$ + "C4\" + pt$
      cncfiles$(5) = Directory$ + "C5\" + pt$
      cncfiles$(6) = Directory$ + "C6\" + pt$
      cncfiles$(7) = Directory$ + "C7\" + pt$
      cncfiles$(8) = Directory$ + "C8\" + pt$
      cncfiles$(9) = Directory$ + "C9\" + pt$
      cncfiles$(10) = Directory$ + "V1\" + pt$
      cncfiles$(11) = Directory$ + "V2\" + pt$
      cncfiles$(12) = Directory$ + "V4\" + pt$
      cncfiles$(13) = Directory$ + "C10\" + pt$
      cncfiles$(14) = Directory$ + "V5\" + pt$  'ADDED V5 S.G.
   
      For fileno% = 1 To 14 'changed 14 from 13 S.G.
         FileStatus%(fileno%) = 1
      Next
   
      For i = 0 To 5
   
         If InStr(MetalName$, "S/S") > 0 Then
            MetType$(i) = "6"
         Else
            MetType$(i) = "1"
         End If
         
         MetSize$(i) = ""
         metLine%(i) = 0
      Next
      
      Open VirtPart$ For Input As #15
         
      Open cncfiles$(6) For Output As #6
      FileStatus%(6) = 1
      Open cncfiles$(10) For Output As #10
      FileStatus%(10) = 1
      Open cncfiles$(11) For Output As #11
      FileStatus%(11) = 1
      Open cncfiles$(12) For Output As #12
      FileStatus%(12) = 1
      Open cncfiles$(13) For Output As #13
      FileStatus%(13) = 1
      Open cncfiles$(14) For Output As #14  'ADDED 14 S.G.
      FileStatus%(14) = 1
      
      
      Do While Not (EOF(15))
         Line Input #15, A$
         C$ = A$
         GoSub GetTurret
         For fileno% = rg1% To rg2%
            If FileStatus%(fileno%) = 0 Then
               If TurretRC% = True Then
                  GoSub SearchVirtTable
                  If fnd% = True Then
                     GoSub ReplaceTool
                  Else
                     Debug.Print turr$, fileno%
                        q$ = fileno%
        
                        If q$ = 1 Then
                            q$ = "==>C-1"
                        ElseIf q$ = 2 Then
                                q$ = "==>C-2"
                        ElseIf q$ = 3 Then
                                q$ = "==>C-3"
                        ElseIf q$ = 4 Then
                                q$ = "==>C-4"
                        ElseIf q$ = 5 Then
                                q$ = "==>C-5"
                        ElseIf q$ = 6 Then
                                q$ = "==>C-6"
                        ElseIf q$ = 7 Then
                                q$ = "==>C-7"
                        ElseIf q$ = 8 Then
                                q$ = "==>C-8"
                        ElseIf q$ = 9 Then
                                q$ = "==>C-9"
                        ElseIf q$ = 10 Then
                                q$ = "==>V-1"
                        ElseIf q$ = 11 Then
                                q$ = "==>V-2"
                        ElseIf q$ = 12 Then
                                q$ = "==>V-4"
                        ElseIf q$ = 13 Then
                                q$ = "==>C-10"
                        ElseIf q$ = 14 Then
                                q$ = "==>V-5"
                        End If
                                                                                                         '+ "==>C" +
                  currform!CNCRemoval.Caption = Trim$(currform!CNCRemoval.Caption + "    " + Trim$(turr$) + q$) ' + Trim$(Str$(Fileno%)))
                     Debug.Print A$
                     Debug.Print Des$
                     GoSub CloseFile
                  End If
               End If
               If (fileno% >= 10) Then
                  GoSub Vectrum
               End If
                  
               GoSub WriteLine
            End If
            C$ = A$
         Next
      Loop
      Close
   End If
Exit Sub
GetTurret:
'
'This routine searches the command line for the turret command
'
'   TurretRC% = indicates whether the line command has a turret.
'       TCmd% = indicates where the turret command is.
'
   TurretRC% = False
   b$ = A$
   tcmd% = InStr(b$, "T")
   If tcmd% <> 0 Then
      n1$ = Mid$(b$, tcmd% + 1, 1)
      n2$ = Mid$(b$, tcmd% + 2, 1)
      n3$ = "0123456789"
      If (InStr(n3$, n1$) <> 0) And (InStr(n3$, n2$) <> 0) Then
         TurretRC% = True
         turr$ = Mid$(A$, tcmd%, 6)
      End If
   End If
Return
SearchVirtTable:
'
'This routine searches the VTable for the tool in the VFile
'
'   fnd% = indicates whether the search was sucessful
'  Turr$ = VTool
' Ntool$ = New Tool
'
   tu% = InStr(turr$, " ")
   If tu% <> 0 Then
      turr$ = Left$(turr$, tu% - 1) + Mid$(turr$, tu% + 1)
   End If
   turr$ = rpad$(turr$, 5)
   turr$ = rpad$(Left$(turr$, 1) + Trim$(Str$(Val(Mid$(turr$, 2)))), 5)

   fnd% = False
   MainSet.Seek "=", turr$
   If Not (MainSet.NoMatch) Then
      If Not (MainSet.EOF) Then
         fnd% = True
         Des$ = MainSet!Description
         Select Case fileno%
            Case 1
               Ntool$ = itsaNull$(MainSet!C1)
            Case 2
               Ntool$ = itsaNull$(MainSet!c2)
            Case 3
               Ntool$ = itsaNull$(MainSet!C3)
            Case 4
               Ntool$ = itsaNull$(MainSet!C4)
            Case 5
               Ntool$ = itsaNull$(MainSet!C5)
            Case 6
               Ntool$ = itsaNull$(MainSet!C6)
            Case 7
               Ntool$ = itsaNull$(MainSet!C7)
            Case 8
               Ntool$ = itsaNull$(MainSet!C8)
            Case 9
               Ntool$ = itsaNull$(MainSet!C9)
            Case 10
               Ntool$ = itsaNull$(MainSet!V1)
            Case 11
               Ntool$ = itsaNull$(MainSet!V2)
            Case 12
               Ntool$ = itsaNull$(MainSet!V4)
            Case 13
               Ntool$ = itsaNull$(MainSet!C10)
            Case 14
               Ntool$ = itsaNull$(MainSet!V5) 'ADDED CASE 14 S.G.
            Case Else
               Ntool$ = ""
         End Select
         If Ntool$ = "" Then
            fnd% = False
         End If
      End If
   End If
   
Return
ReplaceTool:
'
'This routine replaces the tool in the VFile with the from the VTable.
'
   C$ = A$
   If Val(Mid$(turr$, 2)) > 99 Then
      rp% = 6
   Else
      rp% = 3
   End If
   Mid$(C$, tcmd%, rp%) = rpad$(Ntool$, rp%)
   Debug.Print C$
Return
WriteLine:
'
'This routine writes out the new line of CNC code
'
'
   Debug.Print "C$ - >"; C$
   If Trim(C$) <> "" Then
      If FileStatus%(fileno%) = 0 Then
         Select Case fileno%
            Case 1
               Print #1, C$
            Case 2
               Print #2, C$
            Case 3
               Print #3, C$
            Case 4
               Print #4, C$
            Case 5
               Print #5, C$
            Case 6
               Print #6, C$
            Case 7
               Print #7, C$
            Case 8
               Print #8, C$
            Case 9
               Print #9, C$
            Case 10
               Print #10, C$
            Case 11
               Print #11, C$
            Case 12
               Print #12, C$
            Case 13
               Print #13, C$
            Case 14
               Print #14, C$ 'ADDED CASE 14 S.G.
            Case Else
         End Select
      End If
   End If
Return

Vectrum:
'
'   This routine analyzes the vectrum tapes
'
   vect = fileno% - 10
   LineDescr$ = Left$(C$, 15): linedata$ = Trim$(Mid$(C$, 16))
   Select Case LineDescr$
           '123456789012345
      Case "(MAT. THICK  : "
         linedata$ = Left$(linedata$, Len(linedata$) - 1)
         MetThick$(vect) = linedata$
      Case "(SHEET X,Y   : "
         linedata$ = Left$(linedata$, Len(linedata$) - 1)
         l$ = "X" + Trim$(linedata$)
         j% = InStr(l$, " ")
         If j% <> 0 Then
            l$ = Left$(l$, j%) + "Y" + Mid$(l$, j% + 1)
         End If
         MetSize$(vect) = l$
      Case Else
         If Left$(LineDescr$, 3) = "X78" And Right$(Trim$(C$), 3) = "M03" Then
            If Val(Mid$(LineDescr$, 2, 7)) = 78.74 Then
               If metLine%(vect) = 0 Then
                  metLine%(vect) = 1
                  C$ = "MAT/B" + MetType$(vect) + " H" + MetThick$(vect) + " " + MetSize$(vect)
               Else
                  C$ = "X78.740 Y54.000 M03"
               End If
            End If
         End If
         tx = InStr(LineDescr$, " T")
         If tx <> 0 Then
            tx = tx + 1
            lastd$ = Mid$(LineDescr$, tx, 4) + " "
            Call PARSE(lastd$, lasttool$, " ", RC%)
            lt(vect) = Val(Mid$(lasttool$, 2))
         End If
   End Select
'
' removed per Chris Brown 14-Aug-2009
'
'   If Right$(c$, 3) = "M03" Then
'      If (lt(vect) >= 31) And (lt(vect) <= 54) Then
'         m3$ = "T01 M03"
'      Else
'         m3$ = "M03"
'      End If
'      c$ = Left$(c$, Len(c$) - 3) + m3$
'   End If
Return


CloseFile:
'
'This routine closes the file
'
   Select Case fileno%
      Case 1
         Close #1
      Case 2
         Close #2
      Case 3
         Close #3
      Case 4
         Close #4
      Case 5
         Close #5
      Case 6
         Close #6
      Case 7
         Close #7
      Case 8
         Close #8
      Case 9
         Close #9
      Case 10
         Close #10
      Case 11
         Close #11
      Case 12
         Close #12
      Case 13
         Close #13
      Case 14         'ADDED CASE 14 S.G.
         Close #14
      Case Else
   End Select
   If (fileno% >= 1) And (fileno% <= 14) Then '14 WAS 13 S.G.
      If Exists%(cncfiles$(fileno%)) Then
         Kill cncfiles$(fileno%)
         FileStatus%(fileno%) = 1
      End If
   End If
Return

TrumpMaker:
   Open Directory$ + "T1\" + pt$ + ".lst" For Output As #1
   Open VirtPart$ For Input As #15
   While Not EOF(15)
      Line Input #15, C$
      
      If Left$(C$, 1) = "N" Then
         xp = InStr(C$, "LOAD SHEET")
         If xp <> 0 Then
            lno = Val(Mid(C$, 2)) - 5
            cx$ = "N" + Trim(Str(lno)) + " TOPOFPART:"
            C$ = cx$ + Chr$(13) + Chr$(10) + C$
         End If
         xp2 = InStr(C$, "TC_SHEET_UNLOAD")
         If xp2 <> 0 Then
            lno = Val(Mid(C$, 2)) - 5
            cx$ = "N" + Trim(Str(lno)) + " GOTOB TOPOFPART"
            C$ = cx$ + Chr$(13) + Chr$(10) + C$
         End If
      End If
      Print #1, C$
   Wend
   Close #1
   Close #15
Return
End Sub

Function Exists%(A$)
On Error GoTo BadExists
   z$ = Dir$(A$)
   If z$ = "" Or A$ = "" Then
      e% = False
   Else
      e% = True
   End If
   Exists% = e%
Exit Function
BadExists:
   e% = False
   z$ = ""
   Resume Next
End Function

Function Front$(A$, x)
   lena = Len(A$)
   If lena <= x Then
      f$ = ""
   Else
      f$ = Left$(A$, lena - x)
   End If
   Front$ = f$
End Function

Sub getchar(A$, b$, i%)
   b$ = Left$(A$, i%)
   A$ = Mid$(A$, i% + 1)
End Sub

Sub InitTurret(Turret$)
   Mach$ = "C1*C2*C3*C4*C5*C6*C7*C8*C9*V1*V2*V4*C10*V5"  'ADDED V5 S.G.
   turr$ = "4  3  2  1  1  1  1  1  1  5  5  5  5   5"
   t$ = RTrim$(Mid$(turr$, InStr(Mach$, Turret$), 3))
Select Case t$
   Case "1"      'C4,C5,C6,
            NormalVel! = 41.994
                accel! = 488.2
           ToolToTool! = 0.1
        SingleHitTime! = 0.128
      BasicToolChange! = 2.7
            AccelTime! = 0.172
      MinDistMoveTime! = 0.279
  HitsPerMinuteNibble! = 500
       AccelToMaxDist! = 3.61
          MinDistMove! = 0.5
      acceldecelspeed! = 0.0344129
       NumberStations% = 54
  
   Case "2"      'C-3000
            NormalVel! = 41.994
                accel! = 488.2
           ToolToTool! = 0.1
        SingleHitTime! = 0.128
      BasicToolChange! = 2.7
            AccelTime! = 0.172
      MinDistMoveTime! = 0.279
  HitsPerMinuteNibble! = 500
       AccelToMaxDist! = 3.61
          MinDistMove! = 0.5
      acceldecelspeed! = 0.0344129
       NumberStations% = 40
  
   Case "3"      'C-2000

            NormalVel! = 32.8
                accel! = 275.5
           ToolToTool! = 0.218
        SingleHitTime! = 0.128
      BasicToolChange! = 3.36
            AccelTime! = 0.238
      MinDistMoveTime! = 0.164
  HitsPerMinuteNibble! = 410
       AccelToMaxDist! = 3.901
          MinDistMove! = 1
      acceldecelspeed! = -0.025481481
       NumberStations% = 22


   Case "4"      'C1000

            NormalVel! = 32.8
                accel! = 275.5
           ToolToTool! = 0.2
        SingleHitTime! = 0.161
      BasicToolChange! = 3.368
            AccelTime! = 0.238
      MinDistMoveTime! = 0.139
  HitsPerMinuteNibble! = 350
       AccelToMaxDist! = 3.905
          MinDistMove! = 1
      acceldecelspeed! = -0.034074047
       NumberStations% = 20
   
   Case "5"      'V1 V2 V4 C10
            NormalVel! = 41.994
                accel! = 488.2
           ToolToTool! = 0.1
        SingleHitTime! = 0.128
      BasicToolChange! = 2.7
            AccelTime! = 0.172
      MinDistMoveTime! = 0.279
  HitsPerMinuteNibble! = 500
       AccelToMaxDist! = 3.61
          MinDistMove! = 0.5
      acceldecelspeed! = 0.0344129
       NumberStations% = 54

  Case Else
End Select

End Sub
Sub TrumpfTape(source$, PFile$, folder$, Tsdir$)
'direct$, FL$, d1$
   If Exists(source$) Then
      Dest$ = Directory + folder$ + Tsdir$ + "\" + PFile$ + ".lst"
      'dest2$ = Directory + "L4" + Tsdir$ + "\" + PFile$ + ".lst"
      Open source$ For Input As 1
      Open Dest$ For Output As #2
      'Open dest2$ For Output As #3
      
      remov$ = PFile$ + folder$
      Do While Not EOF(1)
         Line Input #1, ab$
         ac$ = Replace(ab$, remov$, PFile$)
         ad$ = Replace(ac$, "L3030S", "L5030S")
         If folder <> "L4" Then
            Print #2, ac$
         Else
            Print #2, ad$
         End If
      Loop
      'Close #3
      Close #2
      Close #1
   End If
End Sub

Sub LaserTapeGenerate(Part2Build$, PaperFlag$, RunStd!)
   'pt$ = Left$(part2Build$, 7) + "." + Right$(part2Build$, 1)
   'Rev$ = Right$(part2Build$, 1)
'   Close
   
   
   Dim MainDB As Database, MainSet As Recordset
   Set MainDB = DBEngine.Workspaces(0).Databases(0)
   
   G84String$ = "M98 PD:\CNCLSR32\PROGRAM\700."
   
   tsubd$ = "\" + Left(Part2Build$, 3)
   
   If InStr("0123456789", Left(Part2Build$, 1)) = 0 Then
      tsubd$ = "\" + Left(Part2Build$, 1)
   Else
      tsubd$ = "\" + Left(Part2Build$, 3)
   End If
   
   pt$ = revpart$(Part2Build$)
   VirtPart$ = Directory$ + "VLT1" + pt$
   Set MainSet = MainDB.OpenRecordset("MaterialFeedRate", DB_OPEN_TABLE)   ' Create dynaset.
   If (Exists%(VirtPart$)) Then
      
   
   
   MainSet.Index = "PrimaryKey"
   
      lzfiles$(1) = Directory$ + "CL7" + pt$
      lzfiles$(2) = Directory$ + "CL707" + pt$
   
      For fileno% = 1 To 2
         FileStatus%(fileno%) = 0
      Next
      
      lookforM47 = 0
      Open VirtPart$ For Input As #16
      Open lzfiles$(1) For Output As #1
      Open lzfiles$(2) For Output As #2
      Line Input #16, A$
      PrevCmd$ = A$
      fileno% = 1: GoSub WriteLazerLine
      fileno% = 2: GoSub WriteLazerLine
      Line Input #16, CurrCmd$
      mfr = 100000
      ETimeParts = 1
      Do
         Line Input #16, Nextcmd$
         A$ = CurrCmd$
         Debug.Print A$
         C$ = A$
         For fileno% = 1 To 2
            If fileno% = 1 Then FR = 4242 Else FR = 25000
            GoSub ProcessCommand
            GoSub WriteLazerLine
            A$ = C$
         Next
         PrevCmd$ = CurrCmd$
         CurrCmd$ = Nextcmd$
         If EOF(16) Then
            A$ = Nextcmd$
            fileno% = 1: GoSub WriteLazerLine
            fileno% = 2: GoSub WriteLazerLine
            Exit Do
         End If
      Loop
      Close #16
      Close #1
      Close #2
      RunStd! = Etime! * ETimeParts
      RunStd! = RunStd * ETimePercent!
      Call InsertLasertag(Part2Build$, "CL7 FAB", RunStd!)
      Call InsertLasertag(Part2Build$, "CL707 FAB", RunStd!)
      
   End If
   If Right(Part2Build$, 2) = "L2" Then
      direct$ = Directory$ + "TCL3030" + tsubd$ + "\" + Part2Build$ + ".lst"
      outf$ = Directory$ + "L2" + tsubd$ + "\" + Part2Build$ + ".lst"
      Call ReadTrumpfTape(direct$, RunStd!, RC%)
      If RC% <> 1 Then
         Call TrumpfTape(direct$, outf$, "L2", tsubd$)
         Call InsertLasertag(Part2Build$, "L-2 3030 FAB W/Load", RunStd!)
         Call InsertLasertag(Part2Build$, "L-2 3030 POT", RunStd!)
      End If
   

   Else     'L1
      direct$ = Directory$ + "TCL3030" + tsubd$ + "\" + Part2Build$ + ".lst"
      outf$ = Directory$ + "L1" + tsubd$ + "\" + Part2Build$ + ".lst" 'L-1
      outf3$ = Directory$ + "L3" + tsubd$ + "\" + Part2Build$ + ".lst" 'L-3
      Call ReadTrumpfTape(direct$, RunStd!, RC%)
      If RunStd! = 0 Then
        Call FLReadTrumpfTape(direct$, RunStd!, RC%)
      End If
      If RC% <> 1 Then
         Call FileCopy(direct$, outf$)  'L-1
         Call FileCopy(direct$, outf3$) 'L-3
         For ix = 1 To 9
            xn$ = Trim(Str(ix))
            direct$ = Directory$ + "TCL3030" + tsubd$ + "\" + Part2Build$ + xn$ + ".lst"
            outf$ = Directory$ + "L1" + tsubd$ + "\" + Part2Build$ + xn$ + ".lst"
            outf3$ = Directory$ + "L3" + tsubd$ + "\" + Part2Build$ + xn$ + ".lst"
            If Exists(direct$) Then
               Call FileCopy(direct$, outf$)  'L-1
               Call FileCopy(direct$, outf3$) 'L-3
            End If
         Next
         Call InsertLasertag(Part2Build$, "L-2 3030 FAB", RunStd!)
         Call InsertLasertag(Part2Build$, "L-3 3030 FAB", RunStd!)
      End If
   End If
Exit Sub

WriteLazerLine:
'
'This routine writes out the new line of CNC code
'
'
   If Trim$(A$) <> "" Then
      Debug.Print "A$ - >"; A$
      If FileStatus%(fileno%) = 0 Then
         Select Case fileno%
            Case 1
               Print #1, A$
            Case 2
               Print #2, A$
            Case Else
         End Select
      End If
   End If
Return

ProcessCommand:
   A$ = UCase$(Trim$(A$))
   If Left(A$, 15) = "(ESTIMATED TIME" Then
      '(ESTIMATED TIME    : 0 MIN. 44 SEC.)
      z$ = Mid(A$, InStr(A$, ":") + 1)
      mm = Val(z$) * 60
      z$ = Mid(A$, InStr(A$, "MIN.") + 4)
      Etime = mm + Val(z$)
   End If
   If Left(A$, 4) = "#119" Then
      '#119=6        (# OF Y PARTS - MULT.)
      z$ = Mid(A$, InStr(A$, "=") + 1)
      ETimeParts = Val(z$)
   End If
   If Left(A$, 4) = "#116" Then
      mm = Val(Mid(A$, InStr(A$, "=") + 1))
      If mm = 8 Or mm = 9 Then
        ETimePercent = 1.15
      Else
        ETimePercent = 1.1
      End If
   End If
   GoSub RemoveMcmds
   If A$ <> "" Then
      cmd$ = Left$(A$, 3)
      If Left$(cmd$, 1) = "#" Then
         cmd$ = Mid$(A$, 2, 3)
      End If
      If (Left$(cmd$, 1) = "G") Then
         Mode$ = ""
      End If
   Else
      cmd$ = ""
   End If
   Select Case cmd$
      Case "G03", "G02"
         Mode$ = "G"
         ival = scan(A$, "I")
         jval = scan(A$, "J")
         Fvalue = Sqr(Sqr((ival ^ 2 + jval ^ 2)) * 0.001) * FR
         If fileno% = 1 Then Maxfr = Fr1 Else Maxfr = FR2
         If Fvalue > Maxfr Then
            Fvalue = Maxfr
         End If
         Fval$ = Trim$(Format$(Fvalue, "0.0"))
         Fval$ = Front$(Fval$, 2)
         GoSub Replace
      Case "G01"
         If fileno% = 1 Then Maxfr = Fr1 Else Maxfr = FR2
         Fvalue = Maxfr
         Fval$ = Trim$(Format$(Fvalue, "0.0"))
         Fval$ = Front$(Fval$, 2)
         GoSub Replace
      Case "M99"
         If lookforM47 = 1 Then
            If PrevCmd$ = "M35" Then
               C$ = A$
               A$ = "M47"              ' insert a M47 command
               GoSub WriteLazerLine
               A$ = C$
            End If
         End If
      Case "111"
         If Mid$(A$, 6, 1) = "1" Then
            lookforM47 = 1
         End If
      Case "116"
         mfr = Val(Mid$(A$, 6, 3))
         MainSet.MoveFirst
         
         If Not (MainSet.NoMatch) Then
            Do While Trim$(MainSet!MaterialGaugeType) <> mfr
               MainSet.MoveNext
                If (MainSet.EOF) Then Exit Do
            Loop
            Fr1 = MainSet!MaxFeedRateCl7
            FR2 = MainSet!MaxFeedRateCl707

        End If
        C$ = A$
        A$ = "#139=" + PaperFlag$ + "       (S/S W/PAPER 0=NO/1=YES)"
        GoSub WriteLazerLine
        A$ = C$
      Case "G84", Left$(G84String$, 3)
         If fileno% = 1 Then     'CL7
            A$ = "G84"
         Else                    'CL707
            A$ = G84String$
         End If
        
      Case "M#5"
         If fileno% = 1 Then     'CL7
            Line Input #16, bv$
            Line Input #16, Nextcmd$
            A$ = "G84"
            If (Trim$(PrevCmd$) = "G84") Or (Trim$(Nextcmd$) = "G84") Then
               A$ = ""
            End If
            CurrCmd$ = A$
            C$ = A$
         End If

      Case Else
   End Select
   If (Left$(cmd$, 1) = "X") Or (Left$(cmd$, 1) = "Y") Then
      If Mode$ = "G" Then
         ival = scan(A$, "I")
         jval = scan(A$, "J")
         Fvalue = Sqr(Sqr((ival ^ 2 + jval ^ 2)) * 0.001) * FR
         If fileno% = 1 Then Maxfr = Fr1 Else Maxfr = FR2
         If Fvalue > Maxfr Then
            Fvalue = Maxfr
         End If
         Fval$ = Trim$(Format$(Fvalue, "0.0"))
         Fval$ = Front$(Fval$, 2)
         GoSub Replace
      End If
   
   End If
   needAg09 = 0
   If Left$(Nextcmd$, 3) = "M35" Then
      needAg09 = 1
   End If
   If Left$(PrevCmd$, 3) = "G84" Then
      needAg09 = 1
   End If
   If Left$(PrevCmd$, 5) = "M#502" Then
      needAg09 = 1
   End If
   If needAg09 = 1 Then
      If InStr(A$, "G09") = 0 Then
         A$ = A$ + " G09"
      End If
   End If
Return
RemoveMcmds:
   i% = InStr(A$, "M48")
   If i% > 0 Then
      A$ = Left$(A$, i% - 1) + Mid$(A$, i% + 3)
   End If
   i% = InStr(A$, "M49")
   If i% > 0 Then
      A$ = Left$(A$, i% - 1) + Mid$(A$, i% + 3)
   End If
   i% = InStr(A$, "#125")
   If i% > 0 Then
      A$ = ""
   End If
Return
Replace: '(A$, "F", FVal$)
   iv% = InStr(A$, "F")
   If iv% > 0 Then
      stp% = Len(A$)
      For iw% = iv% To Len(A$)
         If Mid$(A$, iw%, 1) = " " Then
            stp% = iw%
            Exit For
         End If
      Next
      A$ = Left$(A$, iv%) + Fval$ + Mid$(A$, stp% + 1)
   Else
      A$ = A$ + " F" + Fval$

   End If
Return

   
End Sub

Sub InsertLasertag(PartN$, MName$, rtime!)

   Dim MachNamesDB As Database, MachNamesSet As Recordset
   Dim MachQDB As Database, MachQSet As Recordset
   
   Set MachNamesDB = DBEngine.Workspaces(0).Databases(0)
   Set MachQDB = DBEngine.Workspaces(0).Databases(0)

   Set MachNamesSet = MachNamesDB.OpenRecordset("MachineNames", DB_OPEN_TABLE)   ' Create dynaset.
   Set MachQSet = MachQDB.OpenRecordset("Machines", DB_OPEN_TABLE)   ' Create dynaset.
   
   MachQSet.Index = "PartNumber"
   
   MachQSet.MoveFirst
   MachQSet.Seek ">=", PartN$

   
         MachNamesSet.MoveFirst
         While Not (MachNamesSet.EOF)
            A$ = MName$
            GoSub search
            If (fnd) Then
               MachQSet.Edit
               MachQSet!Tool = "STD"
               MachQSet!CycleTime = Format$(rtime!, "#####.0")
            Else
               MachQSet.AddNew
               MachQSet!MachineName = A$
               MachQSet!Tool = "***"
               MachQSet!CycleTime = Format$(rtime!, "#####.0")
               MachQSet!PartNumber = PartN$
            End If
            MachQSet.Update
            MachNamesSet.MoveNext
         Wend

Exit Sub
search:
   MachQSet.MoveFirst
   MachQSet.Seek "=", PartN$, A$
   If MachQSet.NoMatch Then
      fnd = False
   Else
      fnd = True
   End If
Return

End Sub

Function LastStr%(st1$, st2$)
'
' This routine finds the last occurence of a string in a string
'
dumy$ = String$(Len(st2$), Chr$(1))
If st2$ = dumy$ Then dumy$ = String$(Len(st2$), Chr$(2))

x% = 1: b% = -1: dd$ = st1$: A% = 0
While b% <> 0
   b% = InStr(dd$, st2$)
   If b% <> 0 Then
      Mid$(dd$, b%, Len(st2$)) = dumy$
      A% = b%
   End If
Wend
LastStr% = A%
End Function

Sub Lowercaser(direct$)
'
'  This routine converts the files specified by
'  direct$ to lowercase file names.
'
A% = LastStr(direct$, "\")
pth$ = Left$(direct$, A%)

dd$ = Dir$(direct$)
While dd$ <> ""
   lc1$ = "xxxx" + LCase$(dd$)
   lc$ = LCase$(dd$)
   Name pth$ + dd$ As pth$ + lc1$
   Name pth$ + lc1$ As pth$ + lc$
   dd$ = Dir$
Wend
End Sub


Sub PARSE(LineToParse$, NextWord$, Delimiter$, ReturnCode%)
      ' **---------------------------------------------------** '
      ' ** PARSE                                             ** '
      ' ** This routine Parses a String in search of the     ** '
      ' ** Delimiters Specified.                             ** '
      ' **                                                   ** '
      ' ** Delimiter$  Contains the Delimiters to look for.  ** '
      ' **                                                   ** '
      ' ** LineToParse$ Contains the String to be parsed.    ** '
      ' **                                                   ** '
      ' ** NextWord$   Returns the string parsed out of      ** '
      ' **             LineToParse$.                         ** '
      ' **                                                   ** '
      ' ** ReturnCode  Returns the status of the parse       ** '
      ' **             Operation.                            ** '
      ' **     Where:                                        ** '
      ' **                                                   ** '
      ' **    -1       NO Data in LineToParse$               ** '
      ' **                (NextWord$ is empty)               ** '
      ' **                                                   ** '
      ' **     0       NO DELIMITERS in LineToParse$         ** '
      ' **                                                   ** '
      ' **   >=1       Delimiter Found!!! This is which one  ** '
      ' **                of the delimiters was found.       ** '
      ' **---------------------------------------------------** '

      NextWord$ = ""
      ReturnCode = -1
      l = Len(LineToParse$)

      If l = 0 Then GoTo ThruParse

      ReturnCode = 0
      Start = 0
      For i = 1 To l
         k$ = Mid$(LineToParse$, i, 1)
         If InStr(Delimiter$, k$) = 0 Then
            Start = i
            Exit For
         Else
            ReturnCode = InStr(Delimiter$, k$)
         End If
      Next i
      If Start = 0 Then
         ReturnCode = -1
         GoTo ThruParse
      End If
      For i = Start To l
         k$ = Mid$(LineToParse$, i, 1)
         If InStr(Delimiter$, k$) <> 0 Then Exit For
      Next i
      NextWord$ = Mid$(LineToParse$, Start, i - Start)
      LineToParse$ = Mid$(LineToParse$, i)
ThruParse:
   End Sub

Sub Parsenum(A$, b$)
   Call PARSE(A$, b$, " ", ReturnCode%)
   b$ = Trim$(b$)
   A$ = Trim$(A$)
End Sub

Sub RemoveComments(A$)
   b$ = A$
   v% = InStr(A$, "(")
   If v% <> 0 Then
      A$ = Left$(b$, v% - 1)
   End If
   A$ = Trim$(A$)
End Sub

Function scan(A$, b$)
   i% = InStr(A$, b$)
   If i% >= 0 Then
      M$ = Mid$(A$, i% + 1)
      scan = Val(M$)
   End If
End Function


What it does

Chunk 1

Failed to generate documentation with Ollama

Chunk 2

Failed to generate documentation with Ollama

Chunk 3

Failed to generate documentation with Ollama

Chunk 4

VBA Code Description

This VBA code is designed to process tape data for Trumpf CNC machines. It appears to be part of a larger application that manages machine settings and cycle times.

Section 1: File Path Construction

If d1$ = "T2" Then direct$ = Directory$ + "TC2020" + Tsdir$ + T2Part + ".lst"
Debug.Print direct$
  • Constructs a file path based on input d1$ and stores it in the variable direct$.
  • Prints the constructed file path to the Immediate window for debugging purposes.

Section 2: File Existence Check and Cycle Time Calculation

If Exists%(direct$) Then
Debug.Print d1$, d2$
If (d1$ = "T1") Or (d1$ = "T2") Then
    Call ReadTrumpfTape(direct$, rtime!, RC%): rtime! = rtime! * 0.66
Else
    Call CalcTape(d1$, direct$, rtime!, RC%)
End If
Close
  • Checks if the file specified by direct$ exists.
  • Prints input values to the Immediate window for debugging purposes.
  • Based on the value of d1$, either calls the ReadTrumpfTape subroutine with a 66% runtime reduction factor or the CalcTape subroutine.

Section 3: Machining Record Update

If RC% = 0 Then
MachNamesSet.MoveFirst

While Not (MachNamesSet.EOF)
    A$ = d2$
    GoSub search
    If (fnd) Then
        MachQSet.Edit
        MachQSet!Tool = "STD"
        MachQSet!CycleTime = Format$(rtime!, "#####.0")
    Else
        MachQSet.AddNew
        MachQSet!MachineName = A$
        MachQSet!Tool = "***"
        MachQSet!CycleTime = Format$(rtime!, "#####.0")
        MachQSet!PartNumber = PartN$
    End If
    MachQSet.Update
    MachNamesSet.MoveNext
    Wend
Else
    MachNamesSet.MoveFirst
    While Not (MachNamesSet.EOF)
        A$ = d2$
        GoSub search
        If (fnd) Then
            MachQSet.Edit
            MachQSet!Tool = "ERR"
            MachQSet!CycleTime = Format$(-1, "#####.0")
            MachQSet.Update
        End If
        MachNamesSet.MoveNext
        Wend
    End If
End If
  • Checks if RC% is 0 and, if so, moves the first record in the MachNamesSet.
  • Iterates through each record in the MachNamesSet.
  • For each record, calls the search subroutine to determine if a matching machine setting exists.
  • If a match is found, updates the corresponding machine record with the calculated cycle time and tool specification.
  • If no match is found, adds a new machine record.

Section 4: Search Subroutine

search:
MachQSet.MoveFirst
MachQSet.Seek "=", PartN$, A$
If MachQSet.NoMatch Then
    fnd = False
Else
    fnd = True
End If
Return
  • Moves the first record in the MachQSet.
  • Seeks to a specific part number (PartN$) within the MachQSet.
  • Checks if the search resulted in a match.
  • Sets the fnd variable accordingly and returns from the subroutine.

Chunk 5

Here is a detailed Markdown description of the VBA code:

Sub ReadSalvaTape

This subroutine reads data from two types of files: S4 and P4 files. It extracts relevant information from the files and calculates a time value (rtime!) based on the content of the files.

Parameters

  • direct1$ and direct2$: file paths to the S4 and P4 files, respectively
  • rtime!: output variable to store the calculated time value
  • RC%: output variable to store a return code (not used in this subroutine)

Logic

  1. Check if the S4 file exists. If it does:
    • Set direct$ to the path of the S4 file and call the parseSAL subroutine.
    • If the file is successfully parsed, set RC% to 1.
    • Calculate the initial value of rtime! based on the return code from the file. If the return code is 0, set rtime! to a default S4 value (73).
  2. Check if the P4 file exists. If it does:
    • Set direct$ to the path of the P4 file and call the parseSAL subroutine.
    • If the file is successfully parsed, add 2 to the return code (RC%) from the S4 file.
    • Calculate the additional value for rtime! based on the return code from the file. If the return code is 0, add a default P4 value (50) to rtime!.
  3. Return control to the calling subroutine if a flag (Flag) is set.

parseSAL Subroutine

This subroutine reads the contents of the specified file and extracts relevant information.

  1. Open the file in input mode.
  2. Read the file line by line using Line Input #1, qx$.
  3. Trim each line and check if it contains non-empty text (If qx$ \u003c\u003e "" Then).
  4. Parse the line using the PARSE subroutine (not shown in this code snippet).
  5. Extract relevant values from the parsed data and update fnd, rtime!, and rt2!.
  6. Repeat steps 2-5 until the end of the file is reached.
  7. Close the file.

Sub ReadTrumpfTape

This subroutine reads a Trumpf tape file and extracts relevant information.

Parameters

  • PartFile$: file path to the Trumpf tape file
  • seconds!: output variable to store the extracted time value
  • retcd%: output variable to store a return code (not used in this subroutine)

Logic

  1. Check if the file exists.
  2. If the file is an L2.LST file, set fLst to "GotIt" and open the file in input mode.
  3. Read the file line by line using Line Input #1, ab$.
  4. Use a Select Case statement to determine which part of the file processing to perform based on the current value of fLst.
  5. If fLst is "GotIt", extract relevant data from the previous lines and calculate the time value (seconds!) based on the extracted data.
  6. Return control to the calling subroutine.

Sub FLReadTrumpfTape

This subroutine appears to be a modified version of Sub ReadTrumpfTape, but with some differences in logic and variable names. The main difference is that it uses a different approach to extract relevant data from the file.

  1. Check if the file exists.
  2. If the file is an L2.LST file, set fLst to "GotIt" and open the file in input mode.
  3. Read the file line by line using Line Input #1, ab$.
  4. Use a Select Case statement to determine which part of the file processing to perform based on the current value of fLst.
  5. If fLst is "GotIt", extract relevant data from the previous lines and parse it using the PARSE subroutine (not shown in this code snippet).
  6. Return control to the calling subroutine.

Note that some parts of the code, such as the PARSE subroutine, are not shown in this snippet. These subroutines are likely defined elsewhere in the program and perform additional processing on the extracted data.

Chunk 6

VBA Code Explanation

This VBA code is divided into two main subroutines: PARSE and CalcTape. The latter seems to be a more complex and longer function.

PARSE Subroutine

The PARSE subroutine appears to parse a line of text based on specific rules. Here's a breakdown of its functionality:

  • The subroutine takes four parameters:
    • ab: the input string
    • RecTyp: the type of record (e.g., "MM" for Machine)
    • fc$: the field count
    • RC%: reference code percentage
  • It calls itself recursively with different command types (cmd$) to parse the fields in the line.
  • Based on the first two characters of ab, it determines whether it's a "ReadStruct" or "FindData" case.
  • In the "ReadStruct" case, it checks if the next field is a specific value ("Maschinenzeit") and sets the file list (fLst) accordingly.
  • If the file list is set to "GotIt," it exits the loop.
  • The subroutine also handles other cases (e.g., "FindData", "ReadRec", "ReadRest") but these are not fully explained in the provided code.

CalcTape Subroutine

The CalcTape subroutine appears to calculate parameters for a tape calculation. Here's a breakdown of its functionality:

  • It takes five input parameters:
    • Turret$: turret name
    • PartFile$: part file path
    • seconds!: seconds value
    • retcd%: return code percentage
  • The subroutine initializes various variables, including velocities and time values.
  • It opens the specified part file for input and reads each line using a While...Loop structure.
  • For each line, it checks if the first character is "N" or "C" and calls the Parsenum function to parse the number.
  • If the command is not an invalid format (e.g., "NBL/", "CAA/"), it executes different actions based on the command type (e.g., calculating punchtime, setting flag values).
  • The subroutine also increments a counter (lcnt) for each processed line and prints the file path, turret name, and seconds value to the debug output.

Notes

  • This code appears to be designed for a specific application or system that uses VBA as its scripting language.
  • Some parts of the code seem incomplete or require additional context to fully understand their functionality.
  • The code could benefit from improved organization, comments, and error handling to make it more maintainable and reliable.

Chunk 7

VBA Code Explanation

This VBA code appears to be part of a larger program, likely related to CNC machining or precision cutting. The code is responsible for calculating and plotting the path of a tool along a circular or arc trajectory.

Initialization

Debug.Print "I DIED  ---  invalid pitch parm on CAA cmd"
seconds! = 0
retcd% = 1
Exit Sub

The code starts by printing an error message indicating that there is an issue with the pitch parameter. It then sets two variables to their initial values: seconds! and retcd%. The Exit Sub statement exits the subroutine immediately.

Basic Calculations

ToolDiam! = ToolDiam! / 2

Sx! = 0
Sy! = 0
If direct$ = "L" Then
Sx! = ToolDiam! * Cos((angl% + 90) * Radians!)
Sy! = ToolDiam! * Sin((angl% + 90) * Radians!)
Else
If direct$ = "R" Then
Sx! = ToolDiam! * Cos((angl% - 90) * Radians!)
Sy! = ToolDiam! * Sin((angl% - 90) * Radians!)
End If

The code calculates the tool diameter and initializes two variables Sx! and Sy! to zero. It then uses conditional statements to calculate the x- and y-coordinates of the tool based on the direct$ variable, which determines the direction of the tool (left or right). The calculations use trigonometric functions.

Looping Through Hits

ToolTime! = RelT!
x! = Sx! + RelX!
Y! = Sy! + RelY!
NibbleFlag! = 0
GoSub CalculateTime

The code sets the tool time to RelT! and initializes two variables x! and y! to the calculated coordinates. It then resets a flag variable NibbleFlag! to zero and calls the CalculateTime subroutine.

Looping Through Hits (Conditional Statements)

For H = 1 To hits
    x! = LastX! + pitch! * Cos(angl% * Radians!)
    Y! = LastY! + pitch! * Sin(angl% * Radians!)
    GoSub CalculateTime
    Debug.Print rpad$(" ", 27);
Next

Debug.Print

The code loops through a specified number of hits, updating the x! and y! variables based on the current angle and pitch. It calls the CalculateTime subroutine for each hit and prints a newline character followed by 27 spaces.

Conditional Statements for Different Commands

Case "LAA/"
...
Case "ARC/"
...
Case "RAD/"
...

The code uses conditional statements to determine which set of commands to execute based on the command prefix. Each set of commands is responsible for calculating and plotting the path of a tool along a specific trajectory.

Example: LAA/ Command

A$ = Mid$(A$, 5)
Call Parsenum(A$, n$)
dist! = Val(n$)
Call Parsenum(A$, n$)
angl% = Val(n$)
Call Parsenum(A$, n$)
hits = Val(n$)
For H = 1 To hits
    x! = LastX! + dist! * Cos(angl% * Radians!)
    Y! = LastY! + dist! * Sin(angl% * Radians!)
    GoSub CalculateTime
    Debug.Print rpad$(" ", 27);
Next

Debug.Print

The code extracts the relevant values from a string A$ and calls various functions to parse and convert the values to numerical types. It then calculates the x- and y-coordinates of the tool for each hit, calls the CalculateTime subroutine, and prints the results.

Example: ARC/ Command

A$ = Mid$(A$, 5)
Call Parsenum(A$, n$)
Radius! = Val(n$)
Call Parsenum(A$, n$)
pitch! = Val(n$)

ToolTime! = RelT!
x! = 0
Y! = Radius!

The code extracts the relevant values from a string A$ and calls various functions to parse and convert the values to numerical types. It then calculates the x- and y-coordinates of the tool for each hit, sets the tool time to RelT!, and initializes two variables x! and y! to zero.

Example: RAD/ Command

A$ = Mid$(A$, 5)
Call Parsenum(A$, n$)
OpeningRad! = Val(n$) / 2

ToolTime! = RelT!
x! = OpeningRad!
Y! = OpeningRad!

The code extracts the relevant values from a string A$ and calls various functions to parse and convert the values to numerical types. It then calculates the x- and y-coordinates of the tool for each hit, sets the tool time to RelT!, and initializes two variables x! and y! to half of the opening radius.

Example: OpeningRad/ Command

A$ = Mid$(A$, 5)
Call Parsenum(A$, n$)
OpeningRad! = Val(n$) / 2

ToolTime! = RelT!
x! = 0
Y! = OpeningRad!

The code extracts the relevant values from a string A$ and calls various functions to parse and convert the values to numerical types. It then calculates the x- and y-coordinates of the tool for each hit, sets the tool time to RelT!, and initializes two variables x! and y! to zero.

Example: HOL/ Command

A$ = Mid$(A$, 5)
Call Parsenum(A$, n$)
OpeningRad! = Val(n$) / 2

ToolTime! = RelT!
x! = OpeningRad!
Y! = OpeningRad!

The code extracts the relevant values from a string A$ and calls various functions to parse and convert the values to numerical types. It then calculates the x- and y-coordinates of the tool for each hit, sets the tool time to RelT!, and initializes two variables x! and y! to half of the opening radius.

Note that this is just a summary of the code and may not cover all the details or nuances of the program.

Chunk 8

VBA Code Overview

This VBA code is designed to process various commands related to a punching machine, likely used in metal fabrication or manufacturing. The code consists of multiple cases that handle different commands and perform calculations based on user input.

Command Handling

The code uses a case-based approach to handle different commands:

  • INC/: Handles the "INC" command with optional direction (L, R, U, D). It calculates the punch time and updates relevant variables.
  • BHC/: Handles the "BHC" command with parameters for radius and angle. It calculates the punch time and updates relevant variables.
  • GRD/: Handles the "GRD" command with parameters for two distances (dist1 and dist2) and directions (d1 and d2). It calculates the punch time and updates relevant variables.

Punch Time Calculation

The code uses a CalculateTime subroutine to calculate the punch time for each command. This subroutine is not shown in this code snippet, but it likely involves trigonometric calculations based on the user input parameters.

Variable Updates

The code updates various variables, including:

  • PunchCount: incremented by 1 for each command processed
  • ToolTime!, RelT!: updated with the calculated punch time
  • BuffRad!, Theta!: used in calculations for some commands
  • NibbleFlag!: set to 0 after each command is processed

Error Handling

The code includes error handling for cases where invalid input is provided. For example, if an invalid direction is specified with the "INC" command, the code sets an error message and exits.

Code Structure

The code is organized into case-based statements, which are executed based on the value of the A$ variable (the first parameter of each command). Each case includes the following elements:

  • Command-specific parameters (e.g., dist!, hits, radius!)
  • Calculations and updates for relevant variables
  • Error handling for invalid input

Conclusion

This VBA code is a complex piece of software that handles multiple commands related to a punching machine. Its structure and organization make it easy to understand and modify, but its functionality requires careful attention to detail and trigonometric calculations.

Chunk 9

VBA Code Description

This VBA code is designed to control a robotic arm, likely in a simulation or game environment. The code reads input commands from the console and calculates the time required for each command to be executed.

Overview

The code consists of several main sections:

  1. Command Handling: This section reads input commands from the console and determines which action to take based on the command prefix (e.g., "OFS/", "FRM/", etc.).
  2. Parameter Extraction: When a valid command is received, this section extracts relevant parameters from the input string using the Parsenum function.
  3. Command Execution: This section executes the actual command based on its type and parameters.

Code Structure

The code uses a combination of If-Select statements, GoSubs, and Loop constructs to manage the flow of execution.

  • The code starts by setting up initial variables and checking if there are any pending commands.
  • It then enters a loop that continues until all commands have been processed.
  • Within the loop, the code checks the command prefix and executes the corresponding action.
  • If an invalid command is received, it calls the Undeveloped subroutine.

Command Handling

The code handles the following command prefixes:

  • "OFS/", "FRM/", "MAT/", and "MGR/": These commands seem to be related to moving the robotic arm. The code extracts parameters such as x and y coordinates and updates relevant variables.
  • "MOV/": This command moves the robotic arm to a specified position. It also sets up additional variables for calculations.
  • "REP/": This command repeats the previous action (moving the arm). However, this section seems incomplete or commented out.

Parameter Extraction

The code uses the Parsenum function to extract parameters from input strings. This function is not shown in the provided code snippet but is likely a custom implementation for parsing numerical values from strings.

Command Execution

When a valid command is executed, the code performs the following actions:

  • Calculates the distance required to reach the destination position using the CalculateTime subroutine.
  • Updates relevant variables such as disttime!, ToolTime!, and Punching!.
  • Adjusts CommandTime! based on various conditions.

Calculation Subroutines

The code includes two calculation subroutines:

  • CalculateTime: Calculates the distance required to reach a destination position.
  • ToolChangeTime: This subroutine is called when the tool type changes (e.g., from "X" to "Y"). However, its implementation is not shown in the provided code snippet.

Debugging and Logging

The code includes several debug printing statements using the Debug.Print function. These statements are likely used for logging purposes or to visualize the state of variables during execution.

Overall, this VBA code appears to be a basic framework for controlling a robotic arm within a simulation or game environment. However, some sections seem incomplete or commented out, and additional implementation details may be required for full functionality.

Chunk 10

Failed to generate documentation with Ollama

Chunk 11

Failed to generate documentation with Ollama

Chunk 12

Failed to generate documentation with Ollama

Chunk 13

VBA Code Documentation

Overview

This VBA code appears to be a part of an application that generates and edits CNC (Computer Numerical Control) code. The code is organized into several routines, each with its own specific functionality.

Search for Turret Command


The GetTurret routine searches the command line for the turret command.

' This routine searches the command line for the turret command
'
'TurretRC% = indicates whether the line command has a turret.
'TCmd% = indicates where the turret command is.

TurretRC% = False
b$ = A$
tcmd% = InStr(b$, "T")
If tcmd% \u003c\u003e 0 Then
    n1$ = Mid$(b$, tcmd% + 1, 1)
    n2$ = Mid$(b$, tcmd% + 2, 1)
    n3$ = "0123456789"
    If (InStr(n3$, n1$) \u003c\u003e 0) And (InStr(n3$, n2$) \u003c\u003e 0) Then
        TurretRC% = True
        turr$ = Mid$(A$, tcmd%, 6)
    End If
End If

Search for Tool in VTable


The SearchVirtTable routine searches the VTable for the tool specified in the command line.

' This routine searches the VTable for the tool in the VFile

fnd% = False
MainSet.Seek "=", turr$
If Not (MainSet.NoMatch) Then
    If Not (MainSet.EOF) Then
        fnd% = True
        Des$ = MainSet!Description
        Select Case fileno%
            Case 1
                Ntool$ = itsaNull$(MainSet!C1)
            Case 2
                Ntool$ = itsaNull$(MainSet!c2)
            ...

Replace Tool in VTable with CNC Code


The ReplaceTool routine replaces the tool specified in the command line with the corresponding CNC code from the VTable.

' This routine replaces the tool in the VFile with the from the VTable.

C$ = A$
If Val(Mid$(turr$, 2)) \u003e 99 Then
    rp% = 6
Else
    rp% = 3
End If
Mid$(C$, tcmd%, rp%) = rpad$(Ntool$, rp%)
Debug.Print C$

Write New Line of CNC Code


The WriteLine routine writes out the new line of CNC code to the corresponding file.

' This routine writes out the new line of CNC code

Debug.Print "C$ - \u003e"; C$
If Trim(C$) \u003c\u003e "" Then
    If FileStatus%(fileno%) = 0 Then
        Select Case fileno%
            Case 1
                Print #1, C$
            Case 2
                Print #2, C$
            ...

Loop and Close Files


The code includes a loop that iterates over various file numbers and calls the WriteLine routine to write out new CNC code. After each iteration, it closes the files using the Close statement.

Loop
    Close
End If
Exit Sub

Note that this is not an exhaustive list of all the routines and functionality in the VBA code. The provided documentation focuses on the main sections of the code.

Chunk 14

Failed to generate documentation with Ollama

Chunk 15

Turret Configuration Initialization VBA Code

Purpose

This VBA code initializes turret configurations for various machine guns in a game, setting properties such as velocity, acceleration, and tool change times.

Variables and Constants

  • A$: The input string to be truncated.
  • i%: An integer variable used to determine the start position of the Mid$(A$, i% + 1) operation.
  • Mach$, turr$, and t$: Strings containing machine gun configurations and turret settings.
  • NormalVel!, accel!, ToolToTool!, etc.: Variables storing numerical values for various turret properties.

Code Explanation

The code consists of two main sections:

  1. String Trimming: The first section trims the input string turr$ to extract a specific value using RTrim$(Mid$(...). This value is then used to determine which turret configuration to apply.
  2. Turret Configuration Initialization: The second section uses a Select Case statement to apply different turret configurations based on the extracted value from turr$.

Each case in the Select Case statement corresponds to a specific machine gun model (e.g., "C1", "C-3000", etc.). For each model, the code sets various numerical values for properties such as velocity, acceleration, and tool change times.

Turret Configuration Models

The code supports the following turret configuration models:

  • C4, C5, C6: A standard machine gun with specific settings.
  • C-3000: An upgraded version of the standard machine gun with slightly different settings.
  • C-2000: Another variant of the standard machine gun with distinct settings.
  • C1000: A specialized machine gun with unique properties.
  • V1 V2 V4 C10: A turret configuration that uses a combination of velocity, acceleration, and tool change times.

Notes

  • The code assumes that the input string turr$ is in a specific format, which may need to be adjusted depending on the actual data being used.
  • The numerical values for each turret property are hardcoded in the code, which might make it difficult to modify or extend the configuration without rewriting the code.
  • The use of Select Case and RTrim$(Mid$(...)) operations makes the code somewhat verbose and prone to errors. Consider exploring alternative approaches, such as using a data-driven approach with arrays or dictionaries.

Chunk 16

Failed to generate documentation with Ollama

Chunk 17

Failed to generate documentation with Ollama

Chunk 18

Failed to generate documentation with Ollama

Chunk 19

PARSE Subroutine

Overview

The PARSE subroutine is designed to parse a given string (LineToParse$) in search of specific delimiters specified in the Delimiter$ variable. It returns the parsed word and a status code indicating the outcome of the parsing operation.

Input Parameters

  • LineToParse$: The string to be parsed.
  • NextWord$: The output variable that will contain the parsed word.
  • Delimiter$: A string containing the delimiters to look for in LineToParse$.
  • ReturnCode%: An integer output variable indicating the status of the parsing operation.

Return Codes

The ReturnCode will be one of the following:

  • -1: No data found in LineToParse$. (NextWord$ is empty.)
  • 0: No delimiters found in LineToParse$.
  • \u003e= 1: Delimiter found. The value indicates which delimiter was found.

Code Explanation

The code begins by initializing the ReturnCode to -1 and setting an empty string for NextWord$. It then checks if the length of LineToParse$is zero, in which case it skips the parsing operation and jumps to the labelThruParse`.

If LineToParse$ has a non-zero length, the code sets ReturnCode to 0, indicating that no delimiters were found. It then iterates through each character in LineToParse$, checking if it matches any of the delimiters specified in Delimiter$. If a match is found, the code updates ReturnCodewith the index of the delimiter inDelimiter$. Once all characters have been checked, the code exits the loop and checks if Startwas set to zero. If so, it returns-1`, indicating that no delimiters were found.

If Start was not set to zero, the code iterates from Start to the end of LineToParse$, skipping any characters that match a delimiter. Once all non-delimiter characters have been skipped, the code updates NextWord$ with the remaining text and sets ReturnCode to the value specified in the comment above this loop.

Finally, the subroutine exits the outer loop and returns from the parsing operation by jumping to the label ThruParse.

Supporting Subroutines

The PARSE subroutine has two supporting subroutines:

  • Parsenum(A$, b$): Calls the PARSE subroutine with default delimiter " ", trims both input strings, and assigns the result to the output variables.
  • RemoveComments(A$): Removes comments from a given string by searching for opening parentheses and trimming the text before them.

Supporting Function

The code also includes a supporting function:

  • scan(A$, b%): Scans a string for a specific value and returns its numeric equivalent if found.
# Example Usage

Example usage of the PARSE subroutine:

Sub Main()
    Dim LineToParse$ As String, NextWord$ As String, Delimiter$ As String
    Dim ReturnCode% As Integer
    
    LineToParse$ = "Hello world!"
    NextWord$ = ""
    Delimiter$ = " "
    
    PARSE LineToParse$, NextWord$, Delimiter$, ReturnCode%
    
    If ReturnCode \u003c 0 Then
        MsgBox "No data found in LineToParse$", vbInformation
    ElseIf ReturnCode = 0 Then
        MsgBox "No delimiters found in LineToParse$", vbInformation
    Else
        MsgBox "Delimiter found at position " \u0026 ReturnCode \u0026 vbCrLf \u0026 NextWord$
    End If
End Sub

This example demonstrates how to use the PARSE subroutine to parse a string and extract the first word, using a default delimiter " ". The result is then printed to the Immediate window.