Cybernomad
/
PSLine2000Documentation
1
0
Fork 0
Code Issues 1 Pull Requests Packages Projects 1 Releases Wiki Activity
PSLine2000Documentation/Modules/CNCTapeRoutines.md

3164 lines
101 KiB
Markdown
Raw Blame History

# 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.
Reference in New Issue View Git Blame Copy Permalink