# CNCTapeRoutines Analysis generated on: 4/1/2025 5:14:10 PM --- ## VBA Code ```vba 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 ```markdown 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 ```markdown 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 ```markdown 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 ```markdown 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 ```markdown 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 ```markdown 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 ```markdown 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) ```markdown 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 ```markdown 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 ```markdown 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 ```markdown 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 ```markdown 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 ```markdown 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 ```markdown 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, `GoSub`s, 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. ```markdown ' 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. ```markdown ' 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. ```markdown ' 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. ```markdown ' 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. ```markdown 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 label `ThruParse`. 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 `ReturnCode` with the index of the delimiter in `Delimiter$`. Once all characters have been checked, the code exits the loop and checks if `Start` was 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. ```markdown # Example Usage ``` Example usage of the `PARSE` subroutine: ```vba 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.