API tools faq
paste
View difference between Paste ID: iWRDuGPM and Sv5qZ6XZ
SHOW: | | - or go back to the newest paste.
1-
'Prd Interna
1+
'Tooling
2
3-
Sub PROG_MAC_S4()

3+
Function T_RECT1(ByVal XS As Double, ByVal XD As Double, ByVal YI As Double, ByVal YS As Double) As String

4
5-
VPRSS = 0

5+
6-
str_no_repet = ""

6+
N1 = Round(XS, 2)

7
N2 = Round(XD, 2)

8-
For CFL = 1 To NM_DT

8+
N3 = Round(YI, 2)

9
N4 = Round(YS, 2)

10-
ACT_MOD = ""

10+
11-
'PROGRAMMI EMZ

11+
If XS > XD Then

12-
If INFO_DAT(CFL, 0, 6) = "9999999" Then Call S_9999999(CFL)

12+
XS = N2

13
XD = N1

14-
If VAR_ACCORP = True And InStr(1, STR_VR_ACC, INFO_DAT(CFL, 0, 6)) = 0 Then GoTo NO_PROD_INT

14+
15-
If VAR_ACCORP = True And InStr(1, STR_VR_FIBRA, INFO_DAT(CFL, 0, 6)) > 0 Then GoTo NO_PROD_INT

15+
16
If YI > YS Then

17-
'**************************COPRIFESSURA

17+
YI = N4

18-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1014688A" Then Call S_1014688A(CFL)

18+
YS = N3

19-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1007069A" Then Call S_1007069A(CFL)

19+
20-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "10288740" Then Call S_10288740(CFL)

20+
21-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1026845A" Then Call S_1026845A(CFL)

21+
''********************

22
'If YI < -4 Then

23-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "10328000" Then Call S_10328000(CFL)

23+
'YI = -4

24-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "10269010" Then Call S_10269010(CFL)

24+
'End If

25-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1026901A" Then Call S_1026901A(CFL)

25+
''********************

26-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "10287960" Then Call S_10287960(CFL)

26+
27
28-
'************************************** RINFORZI/COMPONENTI

28+
XC = (XS + XD) / 2

29-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "10228760" Then Call S_10228760(CFL)

29+
YC = (YI + YS) / 2

30-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1006718A" Then Call S_1006718A(CFL)

30+
WDTJ = Abs(XS - XD)

31-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1006718B" Then Call S_1006718B(CFL)

31+
HGTJ = Abs(YI - YS)

32-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "10068200" Then Call S_10068200(CFL)

32+
33-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1006820A" Then Call S_1006820A(CFL)

33+
34-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1026716A" Then Call S_1026716A(CFL)

34+
T_RECT1 = T_RECT2(XC, YC, WDTJ, HGTJ)

35-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1026716B" Then Call S_1026716A(CFL)

35+
36-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1027588A" Then Call S_1027588A(CFL)

36+
37-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1027588C" Then Call S_1027588C(CFL)

37+
38-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1026699A" Then Call S_1026699A(CFL)

38+
If T_RECT1 = "" Then MsgBox ("ATTENZIONE ERRORE SPACCO RETTANGOLARE SU") & " " & ACT_MOD

39-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "10280840" Then Call S_10280840(CFL)

39+
40-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "10277620" Then Call S_10277620(CFL)

40+
End Function

41-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1011069A" Then Call S_1011069A(CFL)

41+
42-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1020085B" Then Call S_1020085B(CFL)

42+
43-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1020085C" Then Call S_1020085B(CFL)

43+
44-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1019999A" Then Call S_1019999A(CFL)

44+
Function T_RECT2(ByVal XC As Double, ByVal YC As Double, ByVal WDT As Double, ByVal HGT As Double) As String

45-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "10067200" Then Call S_10067200(CFL)

45+
46-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1013300C" Then Call S_1013300C(CFL)

46+
'ESEGUE UNA LAVORAZIONE RETTANGOLARE

47-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1017690A" Then Call S_1017690A(CFL)

47+
'XC = X CENTRO RETTANGOLO    YC= Y CENTRO RETTANGOLO

48-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1017690B" Then Call S_1017690B(CFL)

48+
'WDT = LARGHEZZA RETTANGOLO  HGT= ALTEZZA RETTANGOLO

49-
If INFO_DAT(CFL, 0, 6) = "3201155358" Then Call S_3201155358(CFL)

49+
50-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "10163900" Then Call S_10163900(CFL)

50+
WDT = Round(WDT, 2)

51-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1016517A" Then Call S_1016517A(CFL)

51+
HGT = Round(HGT, 2)

52-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1016517B" Then Call S_1016517B(CFL)

52+
53-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1016517C" Then Call S_1016517C(CFL)

53+
XC = Round(XC, 2)

54-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1016517D" Then Call S_1016517C(CFL)

54+
YC = Round(YC, 2)

55-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1016517E" Then Call S_1016517E(CFL)

55+
56-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "10174520" Then Call S_10174520(CFL)

56+
XSX = XC - WDT / 2

57-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "10357360" Then Call S_10357360(CFL)

57+
YLW = YC - HGT / 2

58-
'**************************************

58+
59
If XSX <= 0 Then LSX = 1 Else LSX = 0

60
If YLW <= 0 Then LNF = 1 Else LNF = 0

61-
'**********************ANTE

61+
62-
NHD = 17

62+
63-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1006616A" Then Call S_1006616A(CFL)

63+
TX = LAB_2(WDT, HGT)

64-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1006619A" Then Call S_1006619A(CFL)

64+
65-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1006629E" Then Call S_1006629E(CFL)

65+
TXQ = LAB_7(WDT, HGT)

66-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1006632B" Then Call S_1006632B(CFL)

66+
67-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1006702A" Then Call S_1006702A(CFL)

67+
' --------------------------- COMPARIAMO I RISULTATI FRA QUADRI E RETTANGOLI:

68-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1006704A" Then Call S_1006704A(CFL)

68+
RQ = 0

69-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1006707B" Then Call S_1006707A(CFL)

69+
If TX <> "" Then RQ = ((1 * Right(TX, InStr(1, StrReverse(TX), " ", vbTextCompare) - 1)) ^ 2) / (WDT * HGT) ' INDICE DELLA LAVORAZIONE COL QUADRO

70-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1006711A" Then Call S_1006711A(CFL)

70+
71-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "10128290" Then Call S_10128290(CFL)

71+
If TXQ <> "" Then

72-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "10130960" Then Call S_10130960(CFL)

72+
MLR = Right(TXQ, Len(TXQ) - InStr(1, TXQ, " ", vbBinaryCompare))

73-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1015353A" Then Call S_1015353A(CFL)

73+
MDX = NUM(Right(MLR, InStr(1, StrReverse(MLR), " ", vbTextCompare) - 1))

74-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1015390A" Then Call S_1015390A(CFL)

74+
MSX = NUM(Left(MLR, InStr(1, MLR, " ", vbTextCompare)))

75-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1015448C" Then Call S_1015448C(CFL)

75+
76-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1015607C" Then Call S_1015607C(CFL)

76+
77-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1015627A" Then Call S_1015627A(CFL)

77+
78-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1015591A" Then Call S_1015591A(CFL)

78+
79-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1017011A" Then Call S_1017011A(CFL)

79+
RR = 0

80-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1017132A" Then Call S_1017132A(CFL)

80+
RR = (MDX * MSX) / (WDT * HGT)    ' INDICE DELLA PRESTAZIONE CON RETTANGOLO

81-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "10253920" Then Call S_1025392A(CFL)

81+
82-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1025682A" Then Call S_1025682A(CFL)

82+
If ACT_MOD = "1006715" And InStr(1, TXQ, "30 5") > 0 Then 'ELIMINARE

83-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1025392A" Then Call S_1025392A(CFL)

83+
RR = 0

84-
'**************************

84+
85
If ACT_MOD = "1014657" And InStr(1, TXQ, "32,6 22,6") > 0 Then 'ELIMINARE

86-
'**************************PIASTRONI

86+
RR = 0

87-
NHD = 15 'CAMBIO TESTA PER PIASTRONI E PARAMENTI

87+
88-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1005784C" Then Call S_1005784C(CFL)

88+
89-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1005784D" Then Call S_1005784C(CFL)

89+
If TX & TXQ = "" Then GoTo UUUUUU

90-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1005784E" Then Call S_1005784E(CFL)

90+
91-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1005785A" Then Call S_1005785A(CFL)

91+
If RQ > RR Then

92-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1005785B" Then Call S_1005785B(CFL)

92+
TLBL = Left(TX, InStr(1, TX, " ", vbBinaryCompare) - 1)                 'ETICHETTA DELL'UTENSILE QUADRO SELEZIONATO

93-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1006615C" Then Call S_1006615C(CFL)

93+
SQRV = Right(TX, Len(TX) - InStr(1, TX, " ", vbBinaryCompare))          'LATO DELL'UTENSILE QUADRO SELEZIONATO

94-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1006615D" Then Call S_1006615E(CFL)

94+
MIN_LAT = -(WDT * (WDT <= HGT) + HGT * (WDT > HGT))                     'LATO MINIMO DEL RETTANGOLO

95-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1006615E" Then Call S_1006615E(CFL)

95+
96-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1006615F" Then Call S_1006615F(CFL)

96+
DIFF = MIN_LAT - SQRV

97-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1006615G" Then Call S_1006615G(CFL)

97+
98-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1006615H" Then Call S_1006615H(CFL)

98+
99-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1006715D" Then Call S_1006715D(CFL)

99+
Select Case DIFF

100-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1006715E" Then Call S_1006715E(CFL)

100+
101-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1006715F" Then Call S_1006715F(CFL)

101+
    Case Is > 0                'RODITURA X-Y

102-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "0902895D" Then Call S_0902895D(CFL)

102+
    NPX = WDT / SQRV

103-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "0902895E" Then Call S_0902895E(CFL)

103+
    If NPX > 1 Then

104-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "0902895F" Then Call S_0902895F(CFL)

104+
    NPX = Int(NPX)

105-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "0902895G" Then Call S_0902895G(CFL)

105+
    PX = Round((WDT - SQRV) / NPX, 2)

106-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "0902895J" Then Call S_0902895J(CFL)

106+
    End If

107-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "0902920C" Then Call S_0902920C(CFL)

107+
    

108-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "0902920D" Then Call S_0902920D(CFL)

108+
    NPY = HGT / SQRV

109-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "0902920F" Then Call S_0902920F(CFL)

109+
    If NPY > 1 Then

110-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "0902935C" Then Call S_0902935C(CFL)

110+
    NPY = Int(NPY)

111-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "0902935D" Then Call S_0902935D(CFL)

111+
    PY = Round((HGT - SQRV) / NPY, 2)

112-
'***********************************

112+
    End If

113-
'**************************PARAMENTI

113+
    

114-
If INFO_DAT(CFL, 0, 6) = "1007305" Then Call S_1007305(CFL)

114+
    

115-
If INFO_DAT(CFL, 0, 6) = "1007303" Then Call S_1007303(CFL)

115+
    Select Case LSX & LNF

116-
If INFO_DAT(CFL, 0, 6) = "1007236" Then Call S_1007236(CFL)

116+
    

117-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1023836A" Then Call S_1023836A(CFL)

117+
    Case "00"               ' SCANTONATURA DX ALTA

118-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1023836B" Then Call S_1023836B(CFL)

118+
    XPC = XC + (WDT / 2 - SQRV / 2)

119-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1006951B" Then Call S_1006951(CFL)

119+
    YPC = YC + (HGT / 2 - SQRV / 2)

120-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1006951C" Then Call S_1006951C(CFL)

120+
    G90 = "G90/X" & XPC & "/Y" & YPC & "/" & TLBL & "/*SQI*/>"

121-
'***********************************

121+
    G37 = "G37/I-" & PX & "/P" & NPX & "/J-" & PY & "/K" & NPY & "/" & TLBL & "/*SQ*/>"

122-
'****************************ENTRANCE -->attesa utensile asola

122+
    

123-
NHD = 16 'CAMBIO TESTA PER ENTRANCE

123+
    Case "11"               ' SCANTONATURA SX BASSA

124-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1012500B" Then Call S_1012500(CFL)

124+
    XPC = XC - (WDT / 2 - SQRV / 2)

125-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1012499B" Then Call S_1012499(CFL) 'OK GALLONI

125+
    YPC = YC - (HGT / 2 - SQRV / 2)

126-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1011908B" Then Call S_1011908(CFL)

126+
    G90 = "G90/X" & XPC & "/Y" & YPC & "/" & TLBL & "/*SQI*/>"

127-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1011067E" Then Call S_1011067(CFL) 'OK GALLONI

127+
    G37 = "G37/I" & PX & "/P" & NPX & "/J" & PY & "/K" & NPY & "/" & TLBL & "/*SQ*/>"

128-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1011060C" Then Call S_1011060(CFL) 'OK GALLONI

128+
129
    Case "10"               ' SCANTONATURA SX ALTA

130-
'If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1037319B" Then Call S_1037319B(CFL)

130+
    XPC = XC - (WDT / 2 - SQRV / 2)

131-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1037258B" Then Call S_1037258B(CFL)

131+
    YPC = YC + (HGT / 2 - SQRV / 2)

132-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1037258C" Then Call S_1037258C(CFL)

132+
    G90 = "G90/X" & XPC & "/Y" & YPC & "/" & TLBL & "/*SQI*/>"

133-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1037258D" Then Call S_1037258C(CFL)

133+
    G37 = "G37/I" & PX & "/P" & NPX & "/J-" & PY & "/K" & NPY & "/" & TLBL & "/*SQ*/>"

134-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1037258E" Then Call S_1037258E(CFL)

134+
    

135-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1037258F" Then Call S_1037258F(CFL)

135+
    Case "01"               ' SCANTONATURA DX BASSA

136-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1042991A" Then Call S_1042991A(CFL)

136+
    XPC = XC + (WDT / 2 - SQRV / 2)

137-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1042991C" Then Call S_1042991C(CFL)

137+
    YPC = YC - (HGT / 2 - SQRV / 2)

138-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1042991C01" Then Call S_1042991C(CFL)

138+
    G90 = "G90/X" & XPC & "/Y" & YPC & "/" & TLBL & "/*SQI*/>"

139-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1042991D" Then Call S_1042991D(CFL)

139+
    G37 = "G37/I-" & PX & "/P" & NPX & "/J" & PY & "/K" & NPY & "/" & TLBL & "/*SQ*/>"

140-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1036865A" Then Call S_1036865A(CFL)

140+
    

141-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1036865B" Then Call S_1036865B(CFL)

141+
    End Select

142-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1036865C" Then Call S_1036865C(CFL)

142+
    

143-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "10483620" Then Call S_10483620(CFL)

143+
    T_RECT2 = ST64(Jcdf(G90)) & ST64(Jcdf(G37))

144-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1048362A" Then Call S_1048362A(CFL)

144+
      

145-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "10429030" Then Call S_10429030(CFL)

145+
      

146-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "10429030-MOD" Then Call S_10429030(CFL)

146+
Case Is = 0

147-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1042903B" Then Call S_1042903B(CFL)

147+
    If HGT - WDT = 0 Then     'COLPO SINGOLO

148-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1036714A" Then Call S_1036714A(CFL)

148+
    XPC = XC

149-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1036714B" Then Call S_1036714A(CFL)

149+
    YPC = YC

150-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "10428730" Then Call S_10428730(CFL)

150+
    G90 = "G90/X" & XPC & "/Y" & YPC & "/" & TLBL & "/>"

151-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1042873A" Then Call S_1042873A(CFL)

151+
    T_RECT2 = ST64(Jcdf(G90))

152-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1042873A02" Then Call S_1042873A(CFL)

152+
    Else

153
    

154-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1036629A" Then Call S_1036629A(CFL)

154+
    If WDT > HGT Then         'RODITURA X

155-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1036629B" Then Call S_1036629A(CFL)

155+
    NPX = WDT / SQRV

156-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1036629D" Then Call S_1036629D(CFL)

156+
    If NPX > 1 Then

157-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1036629E" Then Call S_1036629E(CFL)

157+
    NPX = Int(NPX)

158-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1036629F" Then Call S_1036629F(CFL)

158+
    PX = Round((WDT - SQRV) / NPX, 2)

159-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "10414310" Then Call S_10414310(CFL)

159+
    End If

160-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1041431A" Then Call S_1041431A(CFL)

160+
   

161-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1041431B" Then Call S_1041431B(CFL)

161+
    If LSX = 1 Then           '-------DA DX A SX  <<<<<<

162-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1041431C" Then Call S_1041431C(CFL)

162+
    XPC = Round(XC - (WDT / 2 - SQRV / 2), 2)

163-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1041431D" Then Call S_1041431D(CFL)

163+
    YPC = Round(YC, 2)

164-
NHD = 14

164+
    REP_X = XPC - 2000

165-
'************************************

165+
    G90 = "G90/X" & XPC & "/Y" & YPC & "/" & TLBL & "/*SQI*/>"

166
    G28 = "G28/I" & PX & "/J0./K" & NPX & "/" & TLBL & "/*SQ*/>"

167
    T_RECT2 = ST64(Jcdf(G90)) & ST64(Jcdf(G28))

168-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "10068260" Then Call S_10068260(CFL)

168+
    

169-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1006897B" Then Call S_1006897C(CFL)

169+
    Else                     '-------DA SX A DX  >>>>>>>

170-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1006897C" Then Call S_1006897C(CFL)

170+
    XPC = Round(XC + (WDT / 2 - SQRV / 2), 2)

171-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1006897D" Then Call S_1006897D(CFL)

171+
    YPC = Round(YC, 2)

172-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1006897E" Then Call S_1006897E(CFL)

172+
    REP_X = XPC - 2000

173-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1006897H" Then Call S_1006897H(CFL)

173+
    G90 = "G90/X" & XPC & "/Y" & YPC & "/" & TLBL & "/*SQI*/>"

174-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1007098C" Then Call S_1007098C(CFL)

174+
    G28 = "G28/I" & PX & "/J180./K" & NPX & "/" & TLBL & "/*SQ*/>"

175-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1007098D" Then Call S_1007098D(CFL)

175+
    T_RECT2 = ST64(Jcdf(G90)) & ST64(Jcdf(G28))

176-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1007098E" Then Call S_1007098D(CFL)

176+
    End If

177-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1010304B" Then Call S_1010304B(CFL)

177+
    

178-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1010304C" Then Call S_1010304C(CFL)

178+
    

179-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "10130980" Then Call S_10130980(CFL)

179+
    Else                      'RODITURA Y

180-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1014657D" Then Call S_1014657D(CFL)

180+
    NPY = HGT / SQRV

181-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1014657E" Then Call S_1014657E(CFL)

181+
    If NPY > 1 Then

182-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "10519690" Then Call S_10519690(CFL)

182+
    NPY = Int(NPY)

183-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "10153570" Then Call S_10153570(CFL)

183+
    PY = Round((HGT - SQRV) / NPY, 2)

184-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1015357A" Then Call S_10153570(CFL)

184+
    End If

185-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "10155310" Then Call S_10155310(CFL)

185+
    

186-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "10155340" Then Call S_10155340(CFL)

186+
    If LNF = 1 Then           '------DALL'BASSO ALL'ALTO

187-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1016400A" Then Call S_1016400A(CFL)

187+
    XPC = Round(XC, 2)

188-
'If INFO_DAT(cfl, 0, 6) & INFO_DAT(cfl, 0, 9) = "1016520A" Then Call S_1016520A(cfl) 'fondello -- fare dxf

188+
    YPC = Round(YC - (HGT / 2 - SQRV / 2), 2)

189-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1020374B" Then Call S_1020374B(CFL)

189+
    G90 = "G90/X" & XPC & "/Y" & YPC & "/" & TLBL & "/*SQI*/>"

190-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1020374C" Then Call S_1020374B(CFL)

190+
    G28 = "G28/I" & PY & "/J90./K" & NPY & "/" & TLBL & "/*SQ*/>"

191-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1020445A" Then Call S_1020445A(CFL)

191+
    T_RECT2 = ST64(Jcdf(G90)) & ST64(Jcdf(G28))

192-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1020445B" Then Call S_1020445B(CFL)

192+
    

193-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1020445C" Then Call S_1020445B(CFL)

193+
    Else                      '-------DALL'ALTO AL BASSO

194-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "10202990" Then Call S_10202990(CFL)

194+
    XPC = Round(XC, 2)

195-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1020299A" Then Call S_1020299A(CFL)

195+
    YPC = Round(YC + HGT / 2 - SQRV / 2, 2)

196-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1020299B" Then Call S_1020299B(CFL)

196+
    G90 = "G90/X" & XPC & "/Y" & YPC & "/" & TLBL & "/*SQI*/>"

197-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "10206680" Then Call S_10206680(CFL)

197+
    G28 = "G28/I" & PY & "/J-90./K" & NPY & "/" & TLBL & "/*SQ*/>"

198-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1020668B" Then Call S_1020668B(CFL)

198+
    T_RECT2 = ST64(Jcdf(G90)) & ST64(Jcdf(G28))

199-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1020668C" Then Call S_1020668B(CFL)

199+
    End If

200-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "10206400" Then Call S_10206400(CFL)

200+
    

201-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1020640A" Then Call S_10206400(CFL)

201+
    End If

202-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1020237A" Then Call S_10202370(CFL)

202+
    End If

203-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1020092A" Then Call S_1020092A(CFL)

203+
    

204-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "10229750" Then Call S_10229750(CFL)

204+
    Case Is < 0

205-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "10257410" Then Call S_10257410(CFL)

205+
206-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "10275400" Then Call S_10275400(CFL)

206+
    End Select

207-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "10339350" Then Call S_10339350(CFL)

207+
    

208-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1033935A" Then Call S_1033935A(CFL)

208+
    

209-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "10339220" Then Call S_10339220(CFL)

209+
    

210-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1033922A" Then Call S_1033922A(CFL)

210+
Else    '---------------------- DEFINIAMO LA LAVORAZIONE FATTA DI RETTANGOLO

211-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "10269750" Then Call S_10269750(CFL)

211+
   

212-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "10284540" Then Call S_10284540(CFL)

212+
213-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "10285220" Then Call S_10285220(CFL)

213+
UTE = Left(TXQ, InStr(1, TXQ, " ", vbBinaryCompare) - 1)

214-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1028522A" Then Call S_10285220(CFL)

214+
ANG = Right(UTE, InStr(1, StrReverse(UTE), "_", vbBinaryCompare) - 1)

215-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1026712A" Then Call S_1026712A(CFL)

215+
TLBL = Left(UTE, InStr(1, UTE, "_", vbBinaryCompare) - 1)

216-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1026633A" Then Call S_1026633A(CFL)

216+
217-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1026633B" Then Call S_1026633A(CFL)

217+
If Right(ANG, 1) = "I" Then TLBL = TLBL & "C" & Replace(ANG, "I", "") & "."

218
219-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "10458640" Then Call S_10458640(CFL)

219+
220-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1045864A" Then Call S_1045864A(CFL)

220+
MLR = Right(TXQ, Len(TXQ) - InStr(1, TXQ, " ", vbBinaryCompare))

221-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1045864B" Then Call S_1045864A(CFL)

221+
222
223-
'If INFO_DAT(cfl, 0, 6) = "1007233" Then Call S_1007233(cfl)

223+
Select Case ANG

224-
'If INFO_DAT(cfl, 0, 6) = "1007253" Then Call S_1007253(cfl)

224+
225-
'If INFO_DAT(cfl, 0, 6) & INFO_DAT(cfl, 0, 9) = "1007889C" Then Call S_1007889C(cfl)

225+
Case "0", "0I"

226-
'If INFO_DAT(cfl, 0, 6) & INFO_DAT(cfl, 0, 9) = "1007896B" Then Call S_1007896B(cfl)

226+
XXX = NUM(Left(MLR, InStr(1, MLR, " ", vbTextCompare)))

227-
'If INFO_DAT(cfl, 0, 6) & INFO_DAT(cfl, 0, 9) = "1007909G" Then Call S_1007909G(cfl)

227+
YYY = NUM(Right(MLR, InStr(1, StrReverse(MLR), " ", vbTextCompare) - 1))

228-
'If INFO_DAT(cfl, 0, 6) & INFO_DAT(cfl, 0, 9) = "1007093D" Then Call S_1007093D(cfl)

228+
229-
'If INFO_DAT(cfl, 0, 6) & INFO_DAT(cfl, 0, 9) = "1006927A" Then Call S_1006927A(cfl)

229+
Case "90", "90I"

230-
'If INFO_DAT(cfl, 0, 6) = "1011763" Then Call S_1011763(cfl)

230+
231-
'If INFO_DAT(cfl, 0, 6) & INFO_DAT(cfl, 0, 9) = "1014512C" Then Call S_1014512C(cfl)

231+
XXX = NUM(Right(MLR, InStr(1, StrReverse(MLR), " ", vbTextCompare) - 1))

232-
'If INFO_DAT(cfl, 0, 6) = "1014700" Then Call S_1014700(cfl)

232+
YYY = NUM(Left(MLR, InStr(1, MLR, " ", vbTextCompare)))

233-
'If INFO_DAT(cfl, 0, 6) & INFO_DAT(cfl, 0, 9) = "1016416D" Then Call S_1016416D(cfl)

233+
234-
'If INFO_DAT(cfl, 0, 6) & INFO_DAT(cfl, 0, 9) = "1016428B" Then Call S_1016428B(cfl)

234+
Case Else

235
MsgBox "ERROR RECT TOOL ANGLE"

236
End Select

237
   

238-
'********************************OUTPUT DXF ***********************

238+
   

239
RX = "0"

240-
If InStr(1, str_no_repet, INFO_DAT(CFL, 0, 3)) = 0 Then

240+
RY = "0"

241
  

242-
cd_dxf = "_1006908_1006914_1006930_1007161_1007886_1011060_1011067_1011908_1011069_1012499_1012500_1007909_1016416_1016428_1007253_1020145_1022168_1020979_1020899_1023837_1023240_"

242+
If WDT > XXX Then RX = "1"

243-
cd_dxf = cd_dxf & "_1045862_1045866_1045872_1046016_1014512_1016520_1007896_1078916_1078917_1016517_"

243+
If HGT > YYY Then RY = "1"

244-
cd_mag = "_3212155519_"

244+
245-
If InStr(1, cd_dxf, INFO_DAT(CFL, 0, 6)) > 0 Or InStr(1, cd_mag, INFO_DAT(CFL, 0, 6)) > 0 Then

245+
246-
str_no_repet = str_no_repet & "-" & INFO_DAT(CFL, 0, 3) & "_"

246+
Select Case RX & RY

247
248
Case "00"   'COLPO   -------------------------------------------------------------------------------------

249-
If INFO_DAT(CFL, 0, 6) = "1006908" And INFO_DAT(CFL, 0, 19) = 0 Then Call MODEL_SUB(CFL, 1)

249+
    XPC = XC

250-
If INFO_DAT(CFL, 0, 6) = "1006914" And INFO_DAT(CFL, 0, 19) = 0 Then Call MODEL_SUB(CFL, 1)

250+
    YPC = YC

251-
If INFO_DAT(CFL, 0, 6) = "1006930" And INFO_DAT(CFL, 0, 19) = 0 Then Call MODEL_SUB(CFL, 1)

251+
    G90 = "G90/X" & XPC & "/Y" & YPC & "/" & TLBL & "/>"

252-
If INFO_DAT(CFL, 0, 6) = "1007161" And INFO_DAT(CFL, 0, 19) = 0 Then Call MODEL_SUB(CFL, 1)

252+
    T_RECT2 = ST64(Jcdf(G90))

253-
If INFO_DAT(CFL, 0, 6) = "1007886" And INFO_DAT(CFL, 0, 19) = 0 Then Call MODEL_SUB(CFL, 1)

253+
254
255-
''If INFO_DAT(CFL, 0, 6) = "1011060" And INFO_DAT(CFL, 0, 19) = 0 Then Call MODEL_SUB(CFL, 1) 'ENTRANCE

255+
Case "11"   'RODITURA XY  -------------------------------------------------------------------------------------

256-
''If INFO_DAT(CFL, 0, 6) = "1011067" And INFO_DAT(CFL, 0, 19) = 0 Then Call MODEL_SUB(CFL, 1)

256+
257-
''If INFO_DAT(CFL, 0, 6) = "1011908" And INFO_DAT(CFL, 0, 19) = 0 Then Call MODEL_SUB(CFL, 1)

257+
    NPX = WDT / XXX

258-
''If INFO_DAT(CFL, 0, 6) = "1012499" And INFO_DAT(CFL, 0, 19) = 0 Then Call MODEL_SUB(CFL, 1)

258+
    If NPX > 1 Then

259-
''If INFO_DAT(CFL, 0, 6) = "1012500" And INFO_DAT(CFL, 0, 19) = 0 Then Call MODEL_SUB(CFL, 1)

259+
    NPX = Int(NPX)

260
    PX = Round((WDT - XXX) / NPX, 3)

261-
'If INFO_DAT(CFL, 0, 6) = "1007909" And INFO_DAT(CFL, 0, 19) = 0 Then Call MODEL_SUB(CFL, 1)

261+
    End If

262-
'If INFO_DAT(CFL, 0, 6) = "1016416" And INFO_DAT(CFL, 0, 19) = 0 Then Call MODEL_SUB(CFL, 1)

262+
    

263-
If INFO_DAT(CFL, 0, 6) = "1007253" And INFO_DAT(CFL, 0, 19) = 0 Then Call MODEL_SUB(CFL, 1)

263+
    NPY = HGT / YYY

264
    If NPY > 1 Then

265
    NPY = Int(NPY)

266-
If INFO_DAT(CFL, 0, 6) = "1020145" And INFO_DAT(CFL, 0, 19) = 0 Then Call MODEL_SUB(CFL, 1)

266+
    PY = Round((HGT - YYY) / NPY, 3)

267-
If INFO_DAT(CFL, 0, 6) = "1022168" And INFO_DAT(CFL, 0, 19) = 0 Then Call MODEL_SUB(CFL, 1)

267+
    End If

268-
If INFO_DAT(CFL, 0, 6) = "1020979" And INFO_DAT(CFL, 0, 19) = 0 Then Call MODEL_SUB(CFL, 1)

268+
269-
If INFO_DAT(CFL, 0, 6) = "1020899" And INFO_DAT(CFL, 0, 19) = 0 Then Call MODEL_SUB(CFL, 1)

269+
270-
If INFO_DAT(CFL, 0, 6) = "1023837" And INFO_DAT(CFL, 0, 19) = 0 Then Call MODEL_SUB(CFL, 1)

270+
    Select Case LSX & LNF

271
    

272-
If INFO_DAT(CFL, 0, 6) = "1016520" And INFO_DAT(CFL, 0, 19) = 0 Then Call MODEL_SUB(CFL, 1)

272+
    Case "00"               ' SCANTONATURA DX ALTA

273
    XPC = XC + (WDT / 2 - XXX / 2)

274-
If INFO_DAT(CFL, 0, 6) = "1045862" And INFO_DAT(CFL, 0, 19) = 0 Then Call MODEL_SUB(CFL, 1)

274+
    YPC = YC + (HGT / 2 - YYY / 2)

275-
If INFO_DAT(CFL, 0, 6) = "1045866" And INFO_DAT(CFL, 0, 19) = 0 Then Call MODEL_SUB(CFL, 1)

275+
    G90 = "G90/X" & XPC & "/Y" & YPC & "/" & TLBL & "/*SQI*/>"

276-
If INFO_DAT(CFL, 0, 6) = "1045872" And INFO_DAT(CFL, 0, 19) = 0 Then Call MODEL_SUB(CFL, 1)

276+
    G37 = "G37/I-" & PX & "/P" & NPX & "/J-" & PY & "/K" & NPY & "/" & TLBL & "/*SQ*/>"

277-
If INFO_DAT(CFL, 0, 6) = "1046016" And INFO_DAT(CFL, 0, 19) = 0 Then Call MODEL_SUB(CFL, 1)

277+
    

278-
If INFO_DAT(CFL, 0, 6) = "1078916" And INFO_DAT(CFL, 0, 19) = 0 Then Call MODEL_SUB(CFL, 1)

278+
    Case "11"               ' SCANTONATURA SX BASSA

279-
If INFO_DAT(CFL, 0, 6) = "1078917" And INFO_DAT(CFL, 0, 19) = 0 Then Call MODEL_SUB(CFL, 1)

279+
    XPC = XC - (WDT / 2 - XXX / 2)

280
    YPC = YC - (HGT / 2 - YYY / 2)

281
    G90 = "G90/X" & XPC & "/Y" & YPC & "/" & TLBL & "/*SQI*/>"

282
    G37 = "G37/I" & PX & "/P" & NPX & "/J" & PY & "/K" & NPY & "/" & TLBL & "/*SQ*/>"

283
284-
If InStr(1, str_no_repet, INFO_DAT(CFL, 0, 3)) = 0 Then 'CHECK SU MODULO O DXF MANCANTE

284+
    Case "10"               ' SCANTONATURA SX ALTA

285-
If ACT_MOD = "" Then MsgBox ("MODULO " & INFO_DAT(CFL, 0, 6) & " MANCANTE")

285+
    XPC = XC - (WDT / 2 - XXX / 2)

286
    YPC = YC + (HGT / 2 - YYY / 2)

287
    G90 = "G90/X" & XPC & "/Y" & YPC & "/" & TLBL & "/*SQI*/>"

288-
ACT_MOD = ""

288+
    G37 = "G37/I" & PX & "/P" & NPX & "/J-" & PY & "/K" & NPY & "/" & TLBL & "/*SQ*/>"

289-
NO_PROD_INT:

289+
    

290
    Case "01"               ' SCANTONATURA DX BASSA

291-
Next CFL

291+
    XPC = XC + (WDT / 2 - XXX / 2)

292
    YPC = YC - (HGT / 2 - YYY / 2)

293
    G90 = "G90/X" & XPC & "/Y" & YPC & "/" & TLBL & "/*SQI*/>"

294-
VPRSS = 1

294+
    G37 = "G37/I-" & PX & "/P" & NPX & "/J" & PY & "/K" & NPY & "/" & TLBL & "/*SQ*/>"

295-
For CFL = 1 To NM_DT

295+
    

296
    End Select

297-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1014688A" Then Call V_1014688A(CFL)

297+
    

298-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1016428C" Then Call V_1016428C(CFL)

298+
    T_RECT2 = ST64(Jcdf(G90)) & ST64(Jcdf(G37))

299-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1014512C" Then Call V_1014512C(CFL)

299+
300-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "10339490" Then Call V_10339490(CFL)

300+
301-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1016416E" Then Call V_1016416E(CFL)

301+
302-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "10339850" Then Call V_1033985B(CFL)

302+
Case "01"  'RODITURA IN Y

303-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1033985B" Then Call V_1033985B(CFL)

303+
304-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1006951B" Then Call V_1006951(CFL)

304+
305-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1006951C" Then Call V_1006951C(CFL)

305+
NPY = HGT / YYY

306-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1023836A" Then Call V_1023836A(CFL)

306+
    If NPY > 1 Then

307-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1007889B" Then Call V_1007889B(CFL)

307+
    NPY = Int(NPY)

308-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1007889E" Then Call V_1007889E(CFL)

308+
    PY = Round((HGT - YYY) / NPY, 2)

309
    End If

310-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1007233" Then Call V_1007233(CFL)

310+
    

311-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1007236" Then Call V_1007236(CFL)

311+
    If LNF = 1 Then           '------DALL'BASSO ALL'ALTO

312-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1007253" Then Call V_1007253(CFL)

312+
    XPC = Round(XC, 2)

313-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1007303" Then Call V_1007303(CFL)

313+
    YPC = Round(YC - (HGT / 2 - YYY / 2), 2)

314-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1007305" Then Call V_1007305(CFL)

314+
    G90 = "G90/X" & XPC & "/Y" & YPC & "/" & TLBL & "/*SQI*/>"

315-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1007896B" Then Call V_1007896B(CFL)

315+
    G28 = "G28/I" & PY & "/J90./K" & NPY & "/" & TLBL & "/*SQ*/>"

316-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1007896C" Then Call V_1007896C(CFL)

316+
    T_RECT2 = ST64(Jcdf(G90)) & ST64(Jcdf(G28))

317-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1011763" Then Call V_1011763(CFL)

317+
    

318-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1007909H" Then Call V_1007909H(CFL)

318+
    Else                      '-------DALL'ALTO AL BASSO

319-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1006927A" Then Call V_1006927A(CFL)

319+
    XPC = Round(XC, 2)

320-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1007093D" Then Call V_1007093D(CFL)

320+
    YPC = Round(YC + HGT / 2 - YYY / 2, 2)

321
    G90 = "G90/X" & XPC & "/Y" & YPC & "/" & TLBL & "/*SQI*/>"

322-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1016416F" Then Call V_1016416F(CFL)

322+
    G28 = "G28/I" & PY & "/J-90./K" & NPY & "/" & TLBL & "/*SQ*/>"

323-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1016428D" Then Call V_1016428D(CFL)

323+
    T_RECT2 = ST64(Jcdf(G90)) & ST64(Jcdf(G28))

324-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1007909J" Then Call V_1007909J(CFL)

324+
    End If

325-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1007909M" Then Call V_1007909M(CFL)

325+
326-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1007909M-MOD" Then Call V_1007909J(CFL)

326+
327-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1007909N" Then Call V_1007909M(CFL)

327+
Case "10"

328-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1007889F" Then Call V_1007889F(CFL)

328+
329-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1007889G" Then Call V_1007889H(CFL)

329+
    NPX = WDT / XXX

330-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1007889H" Then Call V_1007889H(CFL)

330+
    If NPX > 1 Then

331
    NPX = Int(NPX)

332
    PX = Round((WDT - XXX) / NPX, 2)

333
    End If

334-
'If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1014700" Then Call V_1014700(CFL)

334+
   

335-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1014700C" Then MsgBox ("chiedere dxf a Galloni cod. " & INFO_DAT(CFL, 0, 6))

335+
    If LSX = 1 Then           '-------DA DX A SX  <<<<<<

336-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1023837A" Then MsgBox ("chiedere dxf a Galloni cod. " & INFO_DAT(CFL, 0, 6)) 'Call S_1023837A(CFL)

336+
    XPC = Round(XC - (WDT / 2 - XXX / 2), 2)

337-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1014660A" Then MsgBox ("chiedere dxf a Galloni cod. " & INFO_DAT(CFL, 0, 6))

337+
    YPC = Round(YC, 2)

338-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1023240B" Then MsgBox ("chiedere dxf a Galloni cod. " & INFO_DAT(CFL, 0, 6))

338+
    REP_X = XPC - 2000

339-
If INFO_DAT(CFL, 0, 6) & INFO_DAT(CFL, 0, 9) = "1023240C" Then MsgBox ("chiedere dxf a Galloni cod. " & INFO_DAT(CFL, 0, 6))

339+
    G90 = "G90/X" & XPC & "/Y" & YPC & "/" & TLBL & "/*SQI*/>"

340
    G28 = "G28/I" & PX & "/J0./K" & NPX & "/" & TLBL & "/*SQ*/>"

341-
Next CFL

341+
    T_RECT2 = ST64(Jcdf(G90)) & ST64(Jcdf(G28))

342
    

343
    Else                     '-------DA SX A DX  >>>>>>>

344-
End Sub

344+
    XPC = Round(XC + (WDT / 2 - XXX / 2), 2)

345
    YPC = Round(YC, 2)

346
    REP_X = XPC - 2000

347
    G90 = "G90/X" & XPC & "/Y" & YPC & "/" & TLBL & "/*SQI*/>"

348
    G28 = "G28/I" & PX & "/J180./K" & NPX & "/" & TLBL & "/*SQ*/>"

349
    T_RECT2 = ST64(Jcdf(G90)) & ST64(Jcdf(G28))

350
351
    End If

352
353
354
355
356
Case "11"

357
MsgBox "ERROR RECT NIBBLING", vbCritical

358
Case Else

359
360
361
MsgBox "ERROR RECT NIBBLING", vbCritical

362
End Select

363
364
   

365
End If

366
   

367
If T_RECT2 = "" Then MsgBox "T_RECT2 FAILED  ON DRAWING " & ACT_MOD, vbCritical

368
Exit Function

369
UUUUUU:

370
371
T_RECT2 = ""

372
If T_RECT2 = "" Then MsgBox "T_RECT2 FAILED  ON DRAWING " & ACT_MOD, vbCritical

373
374
375
End Function

376
377
378
379
Function T_RECT3(ByVal XC As Double, ByVal YC As Double, ByVal WDT As Double, ByVal HGT As Double) As String

380
381
'ESEGUE UNA LAVORAZIONE RETTANGOLARE A COLPO SINGOLO

382
'XC = X CENTRO RETTANGOLO    YC= Y CENTRO RETTANGOLO

383
'WDT = LARGHEZZA RETTANGOLO  HGT= ALTEZZA RETTANGOLO

384
385
For i = 1 To 46

386
387
If UCase(TOOL_VAR(NHD, i, 6)) = "RETTANGOLO" Then

388
If (TOOL_VAR(NHD, i, 3) = WDT And TOOL_VAR(NHD, i, 4) = HGT) Then

389
TX = TOOL_VAR(NHD, i, 1)

390
Exit For

391
End If

392
End If

393
Next i

394
 

395
T_RECT3 = ST64("G90/X" & XC & "/Y" & YC & "/" & TX & "/>")

396
397
If TX = "" Then

398
MsgBox ("ERRORE SU SPACCO RETTANGOLARE A COLPO SINGOLO"), vbCritical

399
T_RECT3 = ""

400
End If

401
402
403
End Function

404
405
406
407
Function T_CIRC(ByVal X As Double, ByVal Y As Double, ByVal DIAMETER As String) As String

408
'ESEGUE UNA LAVORAZIONE CIRCOLARE A COLPO SINGOLO

409
410
If DIAMETER = "10" Then DIAMETER = "10.1"

411
If DIAMETER = "20" Then DIAMETER = "20.2"

412
If DIAMETER = "7" Then DIAMETER = "7.2"

413
If DIAMETER = "4,5" Then DIAMETER = "4.2"

414
If DIAMETER = "4" Then DIAMETER = "4.2"

415
If DIAMETER = "6.1" Then DIAMETER = "6"

416
417
LAB_TOOL = LAB_1(DIAMETER)

418
419
420
If LAB_TOOL = "" Then

421
422
423
'If DIAMETER = "36,5" Then

424
'T_CIRC = T_SECTOR(X, Y, DIAMETER)

425
'GoTo END_TCIRC:

426
'End If

427
    

428
429
MsgBox ("RODITURA CIRCOLARE DI DIAMETRO " & DIAMETER)

430
DIAM_RID = Round(Val(DIAMETER) * 0.75, 1) + 0.1

431
432
For kk = 1 To 10000

433
LAB_TOOL = LAB_1(DIAM_RID)

434
If LAB_TOOL <> "" Then Exit For

435
DIAM_RID = DIAM_RID - 0.05

436
DIAM_RID = Round(DIAM_RID, 2)

437
438
If DIAM_RID < 0.55 * Val(DIAMETER) Then

439
MsgBox "RODITURA CIRCOLARE FALLITA SU " & ACT_MOD

440
T_CIRC = ""

441
Exit Function

442
End If

443
444
Next kk

445
446
If Val(DIAM_RID) < 8 Then QLR = 0.6 Else QLR = 2 'QUALITA' RODITURA

447
448
G90 = "G90/G72/X" & X & "/Y" & Y & "/*SQI*/>"

449
G68 = "G68/I" & Val(DIAMETER) / 2 & "/J180./K-360./P-" & DIAM_RID & "/Q" & QLR & "./" & LAB_TOOL & "/*SQ*/>"  'CONTROLLO VAL

450
T_CIRC = ST64(Jcdf(G90)) & ST64(Jcdf(G68))

451
    

452
453
Else

454
455
G90 = "G90/X" & X & "/Y" & Y & "/" & LAB_TOOL & "/>"

456
T_CIRC = ST64(Jcdf(G90))

457
458
End If

459
460
461
End Function

462
463
464
465
Function T_SECTOR(ByVal X As Double, ByVal Y As Double, ByVal DIAM As Double) ' LAVORAZIONE CIRCOLARE DI 48, DI 36.5 O DI 30

466
467
'PER AUMENTARE I COLPI ANDARE AD AGIRE SULL'ARCO

468
469
470
Select Case DIAM

471
472
473
Case 36.5

474
ANGL = 270

475
DST = 12

476
ARCO = 73 'GRADI

477
MsgBox "CONTROLLARE DIAMETRO " & DIAM, vbCritical

478
479
Case 48

480
ANGL = 90

481
DST = 12

482
ARCO = 55 'GRADI

483
'MsgBox "CONTROLLARE DIAMETRO " & DIAM, vbCritical

484
485
Case 50

486
ANGL = 90

487
DST = 12

488
ARCO = 55 'GRADI

489
MsgBox "CONTROLLARE DIAMETRO " & DIAM, vbCritical

490
491
492
Case Else

493
MsgBox ("ERROR OF ANGLE IN THE FUNCTION T_SECTOR")

494
End Select

495
496
N_RP = (360 / ARCO)

497
If Int(N_RP) <> N_RP Then N_RP = Int(N_RP) + 1 Else N_RP = Int(N_RP)

498
499
PIG = 3.14159265358 'PIGRECO

500
UTLS = "BI_RAD"

501
502
For RP = 1 To N_RP

503
RADN = (ARCO * (RP - 1) * 2 * PIG) / 360

504
If ANGL > 360 Then ANGL = ANGL - 360

505
SCT1 = SCT1 & T_SPECIAL(X + (DIAM / 2 - DST) * Cos(RADN), Y + (DIAM / 2 - DST) * Sin(RADN), UTLS, "C" & ANGL & ".")

506
ANGL = ANGL + ARCO

507
Next RP

508
509
510
511
T_SECTOR = SCT1

512
513
514
End Function

515
516
517
Function T_HEX(ByVal X As Double, ByVal Y As Double, ByVal LARG As Double) As String

518
'ESEGUE UNA LAVORAZIONE ESAGONALE A COLPO SINGOLO

519
LARG = Int(LARG)

520
521
BG_LAB:

522
523
Key = "SPECIALE"

524
LAB_TOOL = ""

525
For i = 1 To 46

526
If UCase(TOOL_VAR(NHD, i, 6)) = Key Then

527
    If Replace(TOOL_VAR(NHD, i, 3), ",", ".") = Replace(LARG, ",", ".") & "EX" Then

528
    LAB_TOOL = TOOL_VAR(NHD, i, 1)

529
    Exit For

530
    End If

531
    End If

532
Next i

533
534
If LAB_TOOL = "" Then

535
MsgBox ("NON TROVATO UTENSILE ESAGONALE") & " !!!!!!!!!", vbCritical

536
Else

537
G90 = "G90/X" & X & "/Y" & Y & "/" & LAB_TOOL & "/>"

538
T_HEX = ST64(Jcdf(G90))

539
End If

540
541
End Function

542
543
544
Function T_SLOT(ByVal X As Double, ByVal Y As Double, ByVal LENG As String, ByVal HGT As String, ByVal ROT As Single) As String

545
'ESEGUE UNA LAVORAZIONE AD ASOLA IN COLPO SINGOLO O RODITURA

546
'If HGT = "7,2" Then HGT = "7" 'da eliminare

547
If HGT = "5,5" And LENG = "8" And ROT = 0 Then

548
'5 COLPI CON IL TONDO DI 5.5

549
T_SLOT = T_CIRC(X, Y, 5.5) & T_CIRC(X + 1.25, Y, 5.5) & T_CIRC(X - 1.25, Y, 5.5) & T_CIRC(X + 0.625, Y, 5.5) & T_CIRC(X - 0.625, Y, 5.5)

550
Exit Function

551
End If

552
553
554
LENG = Jcdf(LENG)

555
HGT = Jcdf(HGT)

556
RODITURA = 0

557
BG_LAB:

558
Key = "Asola"

559
560
'******************************* CERCA UN'ASOLA FISSA

561
LAB_TOOL = ""

562
For i = 1 To 46

563
If TOOL_VAR(NHD, i, 6) = Key Then

564
565
    If TOOL_VAR(NHD, i, 3) = LENG And TOOL_VAR(NHD, i, 4) = HGT & "A" Then

566
    If TOOL_VAR(NHD, i, 5) = Trim(STR(ROT)) Then

567
    LAB_TOOL = TOOL_VAR(NHD, i, 1)

568
    G90 = "G90/X" & X & "/Y" & Y & "/" & LAB_TOOL & "/>"

569
    T_SLOT = ST64(Jcdf(G90))

570
    Exit For

571
    End If

572
    End If

573
574
If RODITURA = 0 And (Val(Jcdf(TOOL_VAR(NHD, i, 3))) < Val(LENG) And TOOL_VAR(NHD, i, 4) = HGT & "A") Then

575
    If TOOL_VAR(NHD, i, 5) = Trim(STR(ROT)) Then

576
LAB_TOOL = TOOL_VAR(NHD, i, 1)

577
578
PMAX = Val(TOOL_VAR(NHD, i, 3)) - Val(TOOL_VAR(NHD, i, 4))

579
XX = ((Vbdf(LENG)) - Val(Vbdf(TOOL_VAR(NHD, i, 3)))) / PMAX

580
If XX > Int(XX) Then XX = Int(XX) + 1

581
PP = (Vbdf(LENG) - TOOL_VAR(NHD, i, 3)) / XX

582
DST = XX / 2 * PP

583
PPJ = Jcdf(PP)

584
585
Select Case ROT

586
Case 0

587
G90 = "G90/X" & X - DST & "/Y" & Y & "/" & LAB_TOOL & "/>"

588
G28 = ST64("G28/I" & PPJ & "/J0./K" & XX & "/" & LAB_TOOL & "/>")

589
Case 90

590
G90 = "G90/X" & X & "/Y" & Y - DST & "/" & LAB_TOOL & "/>"

591
G28 = ST64("G28/I" & PPJ & "/J90./K" & XX & "/" & LAB_TOOL & "/>")

592
593
Case Else

594
GoTo NLAB

595
End Select

596
597
T_SLOT = ST64(Jcdf(G90)) & ST64(Jcdf(G28))

598
599
    

600
    End If

601
    End If

602
    

603
    End If

604
Next i

605
606
'******************************* CERCA UN'ASOLA ROTANTE

607
If LAB_TOOL = "" Then

608
For i = 1 To 46

609
If TOOL_VAR(NHD, i, 6) = Key Then

610
    If TOOL_VAR(NHD, i, 3) = LENG And TOOL_VAR(NHD, i, 4) = HGT & "A" Then

611
    If TOOL_VAR(NHD, i, 5) = "0I" Then

612
    LAB_TOOL = TOOL_VAR(NHD, i, 1)

613
    G90 = "G90/X" & X & "/Y" & Y & "/" & LAB_TOOL & "C" & ROT & "./>"

614
    T_SLOT = ST64(Jcdf(G90))

615
    Exit For

616
    End If

617
    End If

618
    

619
    If RODITURA = 0 And (Val(Jcdf(TOOL_VAR(NHD, i, 3))) < Val(LENG) And TOOL_VAR(NHD, i, 4) = HGT & "A") Then 'AGGIUNTA RODITURA CON ASOLA ROTANTE

620
    If TOOL_VAR(NHD, i, 5) = "0I" Then

621
    LAB_TOOL = TOOL_VAR(NHD, i, 1)

622
623
    PMAX = Val(TOOL_VAR(NHD, i, 3)) - Val(TOOL_VAR(NHD, i, 4))

624
    XX = ((Vbdf(LENG)) - Val(Vbdf(TOOL_VAR(NHD, i, 3)))) / PMAX

625
    If XX > Int(XX) Then XX = Int(XX) + 1

626
    PP = (Vbdf(LENG) - TOOL_VAR(NHD, i, 3)) / XX

627
    DST = XX / 2 * PP

628
    PPJ = Jcdf(PP)

629
630
    Select Case ROT

631
    Case 0

632
    G90 = "G90/X" & X - DST & "/Y" & Y & "/" & LAB_TOOL & "C" & ROT & "/>"

633
    G28 = ST64("G28/I" & PPJ & "/J" & ROT & "./K" & XX & "/" & LAB_TOOL & "/>")

634
    Case 90

635
    G90 = "G90/X" & X & "/Y" & Y - DST & "/" & LAB_TOOL & "C" & ROT & "/>"

636
    G28 = ST64("G28/I" & PPJ & "/J" & ROT & "./K" & XX & "/" & LAB_TOOL & "/>")

637
    End Select

638
639
640
    

641
    T_SLOT = ST64(Jcdf(G90)) & ST64(Jcdf(G28))

642
    End If

643
    End If                                                                          'FINE AGGIUNTA RODITURA CON ASOLA ROTANTE

644
        

645
    End If

646
647
Next i

648
649
End If

650
651
652
If RODITURA = 1 Then GoTo NLAB

653
If LAB_TOOL = "" Then

654
RODITURA = 1

655
GoTo BG_LAB

656
End If

657
658
NLAB:

659
660
661
662
663
If LAB_TOOL = "" Then

664
MsgBox ("NON TROVATO UTENSILE ASOLA") & " " & LENG & " x " & HGT & " - " & ROT & " " & ("INSERIRE ALTRO VALORE")

665
LENG = InputBox("LENG")

666
HGT = InputBox("HGT")

667
GoTo BG_LAB

668
End If

669
670
671
672
End Function

673
674
675
676
Function T_SPECIAL(ByVal X As Double, ByVal Y As Double, ByVal TL_LAB As String, ByVal STR_IND As String) As String

677
'ESEGUE UNA LAVORAZIONE SPECIALE A COLPO SINGOLO

678
679
BG_LAB:

680
LAB_TOOL = LAB_3(TL_LAB, STR_IND)

681
If LAB_TOOL = "" Then

682
MsgBox ("NON TROVATO UTENSILE SPECIALE"), vbCritical

683
Exit Function

684
End If

685
686
G90 = "G90/X" & X & "/Y" & Y & "/" & LAB_TOOL & STR_IND & "/>"

687
T_SPECIAL = ST64(Jcdf(G90))

688
689
End Function

690
691
Function LAB_1(ByVal DIAM As String) As String

692
'DEFINISCE UTENSILE X LAVORAZIONE TONDA A COLPO SINGOLO

693
694
Key = "Tondo"

695
LAB_1 = ""

696
For i = 1 To 46

697
If TOOL_VAR(NHD, i, 6) = Key Then

698
    If Replace(TOOL_VAR(NHD, i, 3), ",", ".") = Replace(DIAM, ",", ".") Then

699
    LAB_1 = TOOL_VAR(NHD, i, 1)

700
    Exit For

701
    End If

702
    End If

703
Next i

704
705
End Function

706
707
708
Function LAB_2(ByVal X As Double, ByVal Y As Double) As String

709
'DEFINISCE L'UTENSILE QUADRO X LAVORAZIONE RETTANGOLARE    LAB_2= <ETICHETTA LATOUTENSILE>

710
711
Key = "Quadro"

712
SQRV = -(X * (X <= Y) + Y * (X > Y))

713
If X < 13 Or Y < 13 Then SVP = 10 Else SVP = 20                    'PERCENTUALE SOVRAPPOSIZIONE MINIMA COLPI RODITURA

714
715
Dim NDX(100) As String

716
Dim LTR(100) As Double

717
718
719
RRT = 0

720
For i = 1 To 46

721
If TOOL_VAR(NHD, i, 6) = Key And TOOL_VAR(NHD, i, 5) <> "45" Then

722
If TOOL_VAR(NHD, i, 5) = "0I" Then AGG = "C0." Else AGG = ""

723
RRT = RRT + 1

724
NDX(RRT) = TOOL_VAR(NHD, i, 1) & AGG

725
LTR(RRT) = Val(TOOL_VAR(NHD, i, 3))

726
727
End If

728
Next i

729
730
COUNT_T = RRT

731
732
SRCL2:                            'BLOCCO CHE ORDINA IN MODO DECRESCENTE DI DIMENSIONE GLI UTENSILI QUADRI

733
For i = 1 To COUNT_T - 1

734
If LTR(i) < LTR(i + 1) Then

735
LTR(0) = LTR(i)

736
LTR(i) = LTR(i + 1)

737
LTR(i + 1) = LTR(0)

738
NDX(0) = NDX(i)

739
NDX(i) = NDX(i + 1)

740
NDX(i + 1) = NDX(0)

741
GoTo SRCL2

742
End If

743
Next i

744
745
For i = 1 To COUNT_T

746
DFR = LTR(i) - SQRV

747
Select Case DFR

748
Case Is > 0

749
If i = COUNT_T Then

750
'MsgBox "ERRORE UTENSILE SPACCO RETTANGOLARE  " & ACT_MOD, vbCritical

751
752
Exit For

753
End If

754
Case Is = 0

755
LAB_2 = NDX(i) & " " & LTR(i)

756
Exit For

757
Case Is < 0

758
If SQRV / LTR(i) >= 1 + SVP / 100 Then

759
LAB_2 = NDX(i) & " " & LTR(i)

760
Exit For

761
End If

762
End Select

763
Next i

764
765
Erase NDX, LTR

766
End Function

767
768
Function LAB_3(ByVal TL_LAB As String, ByVal STR_IND As String) As String

769
'DEFINISCE UTENSILE X LAVORAZIONE SPECIALE A COLPO SINGOLO

770
771
LAB_3 = ""

772
For i = 1 To 46

773
If TOOL_VAR(NHD, i, 3) = TL_LAB Then

774
If InStr(1, TOOL_VAR(NHD, i, 3), "RD", vbBinaryCompare) = 0 Then GoTo LLL

775
If TOOL_VAR(NHD, i, 5) = Mid(STR_IND, 2, InStr(1, STR_IND, ".") - 2) Then

776
LLL:

777
LAB_3 = TOOL_VAR(NHD, i, 1)

778
Exit For

779
End If

780
End If

781
Next i

782
783
End Function

784
785
786
Function LAB_4(ByVal WDT As Double, ByVal LGT As Double, ByVal DRZ As String) As String

787
'DEFINISCE UTENSILE RETTANGOLARE

788
789
Dim LAB_LAB(10) As String

790
NN = 0

791
Key = "RETTANGOLO"

792
LAB_4 = ""

793
L4 = ""

794
795
For i = 1 To 46

796
L4 = ""

797
If UCase(TOOL_VAR(NHD, i, 6)) = Key Then

798
799
    If (TOOL_VAR(NHD, i, 3) = WDT And TOOL_VAR(NHD, i, 4) <= LGT) Or (TOOL_VAR(NHD, i, 4) = WDT And TOOL_VAR(NHD, i, 3) <= LGT) Then

800
    If TOOL_VAR(NHD, i, 3) = WDT Then LL = TOOL_VAR(NHD, i, 4)

801
    If TOOL_VAR(NHD, i, 4) = WDT Then LL = TOOL_VAR(NHD, i, 3)

802
    LB_ANG = TOOL_VAR(NHD, i, 5)

803
    LB_IND = TOOL_VAR(NHD, i, 2)

804
805
    Select Case DRZ

806
    Case "X+", "X-"

807
    If LB_ANG = "0I" Then L4 = TOOL_VAR(NHD, i, 1) & "C0." & "*" & LL

808
    If LB_ANG = "0" Then L4 = TOOL_VAR(NHD, i, 1) & "*" & LL

809
810
    Case "Y+", "Y-"

811
    If LB_ANG = "0I" Then L4 = TOOL_VAR(NHD, i, 1) & "C90." & "*" & LL

812
    If LB_ANG = "90" Then L4 = TOOL_VAR(NHD, i, 1) & "*" & LL

813
    Case Else

814
    MsgBox ("ERRORE SU RODITURA RETTANGOLARE")

815
    End Select

816
817
    If L4 <> "" Then

818
    NN = NN + 1

819
    LAB_LAB(NN) = L4

820
End If

821
    End If

822
    End If

823
824
Next i

825
826
827
828
If NN = 1 Then LAB_4 = LAB_LAB(1)

829
If NN > 1 Then

830
831
LAB_4 = ""

832
AAAAAA:

833
For SSRY = 1 To NN - 1 'METTO IN FILA DAL PIù CORTO AL PIù LUNGO

834
If Val(Right(LAB_LAB(SSRY), InStr(1, StrReverse(LAB_LAB(SSRY)), "*", vbBinaryCompare) - 1)) > Val(Right(LAB_LAB(SSRY + 1), InStr(1, StrReverse(LAB_LAB(SSRY + 1)), "*", vbBinaryCompare) - 1)) Then

835
ZFRTY = LAB_LAB(SSRY)

836
LAB_LAB(SSRY) = LAB_LAB(SSRY + 1)

837
LAB_LAB(SSRY + 1) = ZFRTY

838
GoTo AAAAAA

839
End If

840
Next SSRY

841
842
NN = 2

843
For SSRX = 1 To NN

844
If LGT > Val(Right(LAB_LAB(SSRY), InStr(1, StrReverse(LAB_LAB(SSRY)), "*", vbBinaryCompare) - 1)) Then LAB_4 = LAB_LAB(SSRX)

845
Next SSRX

846
847
End If

848
849
850
End Function

851
852
853
Function LAB_5(ByVal X As Double, ByVal Y As Double) As String

854
'DEFINISCE L'UTENSILE X LAVORAZIONE RETTANGOLARE    LAB_2= <ETICHETTA LATOUTENSILE>

855
856
Key = "Rettangolo"

857
858
Dim NDX(100) As String

859
Dim LTR(100) As Double

860
861
RRT = 0

862
For i = 1 To 46

863
If TOOL_VAR(NHD, i, 6) = Key And TOOL_VAR(NHD, i, 5) = "0" Then

864
If TOOL_VAR(NHD, i, 3) = X And TOOL_VAR(NHD, i, 4) = Y Then

865
RRT = RRT + 1

866
LAB_5 = TOOL_VAR(NHD, i, 1)

867
End If

868
End If

869
Next i

870
871
If LAB_5 = "" Then

872
RRT = 0

873
For i = 1 To 46

874
If TOOL_VAR(NHD, i, 6) = Key And TOOL_VAR(NHD, i, 5) = "90" Then

875
If TOOL_VAR(NHD, i, 3) = Y And TOOL_VAR(NHD, i, 4) = X Then

876
RRT = RRT + 1

877
LAB_5 = TOOL_VAR(NHD, i, 1)

878
End If

879
End If

880
Next i

881
End If

882
883
If LAB_5 = "" Then

884
RRT = 0

885
For i = 1 To 46

886
If TOOL_VAR(NHD, i, 6) = Key And TOOL_VAR(NHD, i, 5) = "0I" Then

887
If TOOL_VAR(NHD, i, 3) = Y And TOOL_VAR(NHD, i, 4) = X Then

888
RRT = RRT + 1

889
LAB_5 = TOOL_VAR(NHD, i, 1)

890
End If

891
End If

892
Next i

893
End If

894
895
896
Erase NDX, LTR

897
End Function

898
899
900
Function LAB_6(ByVal LATO As String) As String

901
'DEFINISCE UTENSILE QUADRO A 45

902
903
Key = "Quadro"

904
LAB_6 = ""

905
For i = 1 To 46

906
If TOOL_VAR(NHD, i, 6) = Key Then

907
    If Replace(TOOL_VAR(NHD, i, 3), ",", ".") = Replace(LATO, ",", ".") Then

908
    If TOOL_VAR(NHD, i, 5) = "0I" Then

909
    LAB_6 = TOOL_VAR(NHD, i, 1)

910
    Exit For

911
    End If

912
    End If

913
    End If

914
Next i

915
916
End Function

917
918
919
Function LAB_7(ByVal X As Double, ByVal Y As Double) As String

920
'DEFINISCE L'UTENSILE X LAVORAZIONE RETTANGOLARE    LAB_2= <ETICHETTA LATOUTENSILE>

921
922
Key = "Rettangolo"

923
924
Dim NDX(100, 6) As String

925
926
927
RRT = 0

928
929
For i = 1 To 46

930
931
If TOOL_VAR(NHD, i, 6) = Key And TOOL_VAR(NHD, i, 5) = "0" Then

932
If NUM(TOOL_VAR(NHD, i, 3)) <= X And NUM(TOOL_VAR(NHD, i, 4)) <= Y Then

933
RRT = RRT + 1

934
NDX(RRT, 1) = i

935
NDX(RRT, 2) = TOOL_VAR(NHD, i, 5)

936
NDX(RRT, 3) = TOOL_VAR(NHD, i, 3)

937
NDX(RRT, 4) = TOOL_VAR(NHD, i, 4)

938
End If

939
End If

940
Next i

941
942
943
For i = 1 To 46

944
If TOOL_VAR(NHD, i, 6) = Key And TOOL_VAR(NHD, i, 5) = "90" Then

945
If NUM(TOOL_VAR(NHD, i, 3)) <= Y And NUM(TOOL_VAR(NHD, i, 4)) <= X Then

946
RRT = RRT + 1

947
NDX(RRT, 1) = i

948
NDX(RRT, 2) = TOOL_VAR(NHD, i, 5)

949
NDX(RRT, 3) = TOOL_VAR(NHD, i, 4)

950
NDX(RRT, 4) = TOOL_VAR(NHD, i, 3)

951
End If

952
End If

953
Next i

954
955
956
957
958
For i = 1 To 46

959
If TOOL_VAR(NHD, i, 6) = Key And TOOL_VAR(NHD, i, 5) = "0I" Then   'INDEXRR A 0 GRADI

960
If NUM(TOOL_VAR(NHD, i, 3)) <= X And NUM(TOOL_VAR(NHD, i, 4)) <= Y Then

961
RRT = RRT + 1

962
NDX(RRT, 1) = i

963
NDX(RRT, 2) = TOOL_VAR(NHD, i, 5)

964
NDX(RRT, 3) = TOOL_VAR(NHD, i, 3)

965
NDX(RRT, 4) = TOOL_VAR(NHD, i, 4)

966
End If

967
End If

968
Next i

969
970
971
972
For i = 1 To 46

973
If TOOL_VAR(NHD, i, 6) = Key And TOOL_VAR(NHD, i, 5) = "0I" Then   'INDEXRR

974
If NUM(TOOL_VAR(NHD, i, 3)) <= Y And NUM(TOOL_VAR(NHD, i, 4)) <= X Then

975
RRT = RRT + 1

976
NDX(RRT, 1) = i

977
NDX(RRT, 2) = "90I"

978
NDX(RRT, 3) = TOOL_VAR(NHD, i, 3)

979
NDX(RRT, 4) = TOOL_VAR(NHD, i, 4)

980
End If

981
End If

982
Next i

983
984
985
986
987
NDX(0, 1) = 0  ' VARIABILE IN CUI REGISTRO IL VALORE DI COPERTURA PIU'ALTO

988
NDX(0, 2) = 0  ' VARIABILE IN CUI REGISTRO L'INDICE CHE GENERA IL VALORE DI COPERTURA PIU'ALTO

989
990
If RRT > 0 Then

991
992
993
For RGQ = 1 To RRT

994
995
996
Select Case NDX(RGQ, 2)

997
998
Case "0", "90", "0I"

999
XXX = NUM(NDX(RGQ, 3)) 'INGOMBRO X DELL UTENSILE

1000
YYY = NUM(NDX(RGQ, 4)) 'INGOMBRO Y DELL UTENSILE

1001
Case "90I"

1002
YYY = NUM(NDX(RGQ, 3)) 'INGOMBRO X DELL UTENSILE

1003
XXX = NUM(NDX(RGQ, 4)) 'INGOMBRO Y DELL UTENSILE

1004
Case Else

1005
1006
MsgBox "FUNCTION LAB_7: ANGLE ERROR", vbCritical

1007
End Select

1008
1009
svpq = 1.27 'percentuale di sovrapposizione

1010
FX = (X / XXX)

1011
FY = (Y / YYY)

1012
If FX = 1 Or FY = 1 Then GoTo FAI_LAVR

1013
If FX > svpq And FY > svpq Then

1014
FAI_LAVR:

1015
1016
NDX(RGQ, 5) = (XXX * YYY) / (X * Y)

1017
1018
If InStr(1, STIPITI, ACT_MOD) > 0 Or InStr(1, STIPITI_PORTALI, ACT_MOD) > 0 Then 'aggiunta

1019
If XXX = 50 And YYY = 5 Then NDX(RGQ, 5) = 0

1020
End If

1021
1022
If (X = 112 And Y = 6.7) Or (X = 7.3 And Y = 112) Or (X = 6.7 And Y = 112) Then GoTo no_bislunghi

1023
If Val(XXX) / Val(YYY) > 7 Or Val(YYY) / Val(XXX) > 7 Then If XXX <> X And YYY <> Y Then NDX(RGQ, 5) = 0   ' UTENSILI BISLUNGHI VIETATI NELLE RODITURE

1024
no_bislunghi:

1025
1026
If 1 * NDX(RGQ, 5) > 1 * NDX(0, 1) Then

1027
NDX(0, 1) = NDX(RGQ, 5)

1028
NDX(0, 2) = NDX(RGQ, 1)

1029
NDX(0, 3) = NDX(RGQ, 3)

1030
NDX(0, 4) = NDX(RGQ, 4)

1031
NDX(0, 5) = NDX(RGQ, 2)

1032
Else

1033
If 1 * NDX(RGQ, 5) = 1 * NDX(0, 1) Then

1034
If XXX = X Or YYY = Y Then

1035
NDX(0, 1) = NDX(RGQ, 5)

1036
NDX(0, 2) = NDX(RGQ, 1)

1037
NDX(0, 3) = NDX(RGQ, 3)

1038
NDX(0, 4) = NDX(RGQ, 4)

1039
NDX(0, 5) = NDX(RGQ, 2)

1040
Else

1041
1042
'*************   VA A VEDERE L'ANGOLAZIONE CON LA MIGLIORE SOVRAPPOSIZIONE  *****************

1043
If NDX(RGQ, 5) > 0 Then

1044
If NDX(0, 3) <> "" And NDX(0, 4) <> "" Then

1045
If NDX(0, 3) <> X And NDX(0, 4) <> Y And NDX(0, 4) <> X And NDX(0, 3) <> Y Then

1046
SVRPP = 0

1047
If NDX(0, 5) = "0I" Then SVRPP = ((X / Val(NDX(0, 3))) + (Y / Val(NDX(0, 4))))

1048
If NDX(0, 5) = "90I" Then SVRPP = ((X / Val(NDX(0, 4))) + (Y / Val(NDX(0, 3))))

1049
If (FX + FY) > SVRPP Then

1050
NDX(0, 1) = NDX(RGQ, 5)

1051
NDX(0, 2) = NDX(RGQ, 1)

1052
NDX(0, 3) = NDX(RGQ, 3)

1053
NDX(0, 4) = NDX(RGQ, 4)

1054
NDX(0, 5) = NDX(RGQ, 2)

1055
End If

1056
End If

1057
End If

1058
End If

1059
'**********************************************************************

1060
1061
End If

1062
End If

1063
End If

1064
End If

1065
1066
Next RGQ

1067
1068
1069
If NDX(0, 1) > 0 Then LAB_7 = TOOL_VAR(NHD, NDX(0, 2), 1) & "_" & NDX(0, 5) & " " & TOOL_VAR(NHD, NDX(0, 2), 3) & " " & TOOL_VAR(NHD, NDX(0, 2), 4)

1070
1071
End If

1072
1073
1074
1075
Erase NDX

1076
End Function

1077
1078
1079
Function MR_Y(ByVal VALORE As Double, ByVal DY As Double, ByVal ACT As Byte) As Double

1080
1081
Select Case ACT

1082
Case 1

1083
MR_Y = VALORE

1084
Case 2

1085
MR_Y = DY - VALORE

1086
Case Else

1087
MsgBox ("ERRORE"), vbCritical, ("MR_Y")

1088
End Select

1089
1090
End Function

1091
1092
1093
Function MR_X(ByVal VALORE As Double, ByVal DX As Double, ByVal ACT As Byte) As Double

1094
1095
Select Case ACT

1096
Case 1

1097
MR_X = VALORE

1098
Case 2

1099
MR_X = DX - VALORE

1100
Case Else

1101
MsgBox ("ERRORE"), vbCritical, ("MR_X")

1102
End Select

1103
1104
End Function

1105
1106
Function T_BLQ(ByVal XI As Double, ByVal YI As Double, ByVal Xf As Double, ByVal YF As Double, ByVal SVPI As Double, ByVal SVPF As Double) As String

1107
'FUNZIONE PER IL TAGLIO OBLIQUO DA FARE E VERIFICARE

1108
1109
1110
T_BLQ = TG_R(7.5, XI, YI, Xf, YF, SVPI, SVPF)

1111
1112
'If ind = 0 Then

1113
'G90 = "G90/X" & X & "/Y" & Y & "/" & LAB_TOOL & "/>"

1114
'Else

1115
'G90 = "G90/X" & X & "/Y" & Y & "/" & LAB_TOOL & "C" & ind & "./>"

1116
'End If

1117
1118
1119
End Function

1120
1121
1122
Function TG_R(ByVal DU As Double, ByVal XI As Double, ByVal YI As Double, ByVal Xf As Double, ByVal YF As Double, ByVal SVPI As Double, ByVal SVPF As Double) As String

1123
'DU  = LATO DELL'UTENSILE QUADRO UTILIZZATO PER IL TAGLIO OBLIQUO    ; SI GIRA INTORNO AL PUNZONE IN SENSO ANTIORARIO

1124
1125
1126
Select Case DU

1127
Case 7.5

1128
LAB = LAB_3("7SQ", 0) '45

1129
Case 20

1130
LAB = LAB_2(20, 20)

1131
Case Else

1132
MsgBox ("ERRORE UTENSILE QUADRO X TAGLIO OBLIQUO"), vbCritical

1133
End Select

1134
1135
ANG = 9999

1136
If Xf > XI And YI = YF Then ANG = 0

1137
If Xf = XI And YI < YF Then ANG = 90

1138
If Xf < XI And YI = YF Then ANG = 180

1139
If Xf = XI And YI > YF Then ANG = 270

1140
If Not ANG = 9999 Then GoTo NNG

1141
1142
EEA = (YF - YI) / (Xf - XI)

1143
ANG = (Atn(EEA) * 180) / 3.14159265358979

1144
ANG = Round(ANG, 5)

1145
1146
If Xf > XI And YF > YI Then ANG = ANG

1147
If Xf < XI And YF > YI Then ANG = 180 + ANG

1148
If Xf < XI And YF < YI Then ANG = ANG + 180

1149
If Xf > XI And YF < YI Then ANG = 360 + ANG

1150
If ANG = 360 Then ANG = 0

1151
NNG:

1152
1153
ANG = 360 - ANG

1154
DR = DU / 2

1155
ANG_R = (ANG * 3.14159265358979) / 180

1156
1157
DXI = SVPI * Cos(ANG_R)

1158
DYI = SVPI * Sin(ANG_R)

1159
DXF = SVPF * Cos(ANG_R)

1160
DYFF = SVPF * Sin(ANG_R)

1161
1162
LTA = Round(((YF - YI) ^ 2 + (Xf - XI) ^ 2) ^ (0.5), 2)

1163
XXX = (Xf + XI) / 2

1164
YYY = (YF + YI) / 2

1165
1166
XI = XI - DXI

1167
YI = YI + DYI

1168
Xf = Xf + DXF

1169
YF = YF - DYFF

1170
1171
LT = Round(((YF - YI) ^ 2 + (Xf - XI) ^ 2) ^ (0.5), 2)

1172
''If DU > LT Then DU = LT

1173
NN = Int(LT / DU)

1174
1175
PP = Round((LT - DU) / NN, 3)    'PASSO RODITURA

1176
AU = 90 - ANG                    'ANGOLOUTENSILE

1177
AR = ANG                         'ANGOLORODITURA

1178
1179
XC = XI + DR * (Cos(ANG_R) + Sin(ANG_R))

1180
YC = YI + DR * (-Sin(ANG_R) + Cos(ANG_R))

1181
1182
XC = Jcdf(Round(XC, 2))

1183
YC = Jcdf(Round(YC, 2))

1184
AR = Jcdf(Round(AR, 2))

1185
AU = Jcdf(Round(AU, 0))

1186
1187
If LTA > DU Then

1188
ST1 = ST64("G90/X" & XC & "/Y" & YC & "/" & LAB & AU & "./>")

1189
ST2 = ST64("G28/I" & PP & "/J-" & AR & "./K" & NN & "/" & LAB & AU & "./>")

1190
Else

1191
1192
XKK = Jcdf(Round(XXX + DR * Sin(ANG_R), 2))

1193
YKK = Jcdf(Round(YYY + DR * Cos(ANG_R), 2))

1194
ST1 = ST64("G90/X" & XKK & "/Y" & YKK & "/" & LAB & AU & "./>")

1195
ST2 = ""

1196
End If

1197
TG_R = ST1 & ST2

1198
1199
End Function

1200
1201
1202
1203
Function T_PUNCH(ByVal X As Double, ByVal Y As Double, ByVal LAB As String, ByVal ind As Double) As String

1204
'ESEGUE UNA LAVORAZIONE  A COLPO SINGOLO SECONDO ETICHETTA STABILITA

1205
1206
1207
LAB_TOOL = LAB

1208
1209
1210
If ind = 0 Then

1211
G90 = "G90/X" & X & "/Y" & Y & "/" & LAB_TOOL & "/>"

1212
Else

1213
G90 = "G90/X" & X & "/Y" & Y & "/" & LAB_TOOL & "C" & ind & "./>"

1214
End If

1215
1216
T_PUNCH = ST64(Jcdf(G90))

1217
1218
End Function

1219
1220
1221
1222
Function T_DATAMATRIX(ByVal VALORE As String, ByVal X0 As Double, ByVal Y0 As Double, ByVal VERSO As String)

1223
1224
PS = 2.5 'PASSO

1225
1226
1227
Dim R(18) As String

1228
Dim RC(18, 18) As Byte

1229
Dim RC2(18, 18) As Byte

1230
1231
    '-------------------------------------------------------

1232
    ' Dichiarazione dell'oggetto array di stringhe

1233
    Dim DATA_MAT() As String

1234
    Dim fn As Object

1235
1236
1237
    ' Creazione dell'oggetto esterno per la logica

1238
    Set fn = CreateObject("Wittur.Amada.Utils.Datamatix")

1239
    ' Viene richiamata la funzione di conversione

1240
    ' 1° Parametro = codice a 8 cifre da decodificare

1241
    ' 2° Parametro = valore booleano che indica se è necessario escludere il perimetro esterno fisso

1242
1243
1244
    DATA_MAT = fn.GetBinaryMatrix(VALORE, False, True) 'CONSIDERO ANCHE IL CONTORNO - (CODICE A 8 CIFRE, CONTORNO, QUADRATO O RETTANGOLARE)

1245
    '-------------------------------------------------------

1246
1247
1248
Select Case VERSO

1249
Case "V"

1250
1251
For TY = 0 To 7

1252
R(TY + 1) = DATA_MAT(TY) 'RIGA MATRICE DATAMATRIX

1253
Next TY

1254
1255
1256
Q_INT = ""

1257
NORIPET = ""

1258
1259
For TC = 1 To 8 'RIGA

1260
For TC1 = 1 To Len(R(TC)) 'COLONNA

1261
RC2(TC, TC1) = Mid(R(TC), TC1, 1) 'MATRICE PUNTO PER PUNTO

1262
Next TC1

1263
Next TC

1264
1265
1266
For TR = 1 To 18 'FACCIO LA TRASPOSTA DELLA MATRICE

1267
For TR2 = 1 To 8

1268
RC(TR, TR2) = RC2(TR2, TR)

1269
Next TR2

1270
Next TR

1271
1272
1273
For kk = 1 To 18  'CONTATORE DI RIGA

1274
For NN = 1 To 8 'CONTATORE DI COLONNA

1275
1276
'GoTo NOASOLE

1277
'***************************************************************************************ASOLA VERTICALE

1278
1279
If Not kk > 16 Then

1280
1281
If Not (InStr(1, NORIPET, "_" & kk & NN & "_") > 0 Or InStr(1, NORIPET, "_" & kk + 1 & NN & "_") > 0 Or InStr(1, NORIPET, "_" & kk + 2 & NN & "_") > 0) Then

1282
If RC(kk, NN) = 1 And RC(kk + 1, NN) = 1 And RC(kk + 2, NN) = 1 Then

1283
Q_INT = Q_INT & T_SLOT(X0 + (NN - 1) * PS, Y0 + (kk + 1) * PS, 7, 2, 90)

1284
NORIPET = NORIPET & "_" & kk & NN & "_" & kk + 1 & NN & "_" & kk + 2 & NN & "_"

1285
End If

1286
End If

1287
End If

1288
1289
1290
'***************************************************************************************ASOLA ORIZZONTALE

1291
1292
If Not NN > 6 Then

1293
1294
1295
If Not (InStr(1, NORIPET, "_" & kk & NN & "_") > 0 Or InStr(1, NORIPET, "_" & kk & NN + 1 & "_") > 0 Or InStr(1, NORIPET, "_" & kk & NN + 2 & "_") > 0) Then

1296
If RC(kk, NN) = 1 And RC(kk, NN + 1) = 1 And RC(kk, NN + 2) = 1 Then

1297
Q_INT = Q_INT & T_SLOT(X0 + (NN) * PS, Y0 + (kk) * PS, 7, 2, 0)

1298
NORIPET = NORIPET & "_" & kk & NN & "_" & kk & NN + 1 & "_" & kk & NN + 2 & "_"

1299
End If

1300
End If

1301
End If

1302
1303
NOASOLE:

1304
'*****************************************************************************************TONDO

1305
1306
If Not InStr(1, NORIPET, "_" & kk & NN & "_") > 0 Then

1307
If RC(kk, NN) = 1 Then Q_INT = Q_INT & T_CIRC(X0 + (NN - 1) * PS, Y0 + (kk) * PS, 2)

1308
End If

1309
1310
1311
Next NN

1312
Next kk

1313
1314
T_DATAMATRIX = QORIGINE & QASSEY & QASSEX & Q_INT & QTM_Y & QTM_X

1315
1316
1317
1318
Case "O"

1319
1320
For TY = 0 To 7

1321
R(TY + 1) = DATA_MAT(TY) 'RIGA MATRICE DATAMATRIX

1322
Next TY

1323
1324
1325
Q_INT = ""

1326
NORIPET = ""

1327
1328
1329
For TC = 1 To 8 'RIGA

1330
For TC1 = 1 To Len(R(TC)) 'COLONNA

1331
RC(TC, TC1) = Mid(R(TC), TC1, 1) 'MATRICE PUNTO PER PUNTO

1332
Next TC1

1333
Next TC

1334
1335
1336
1337
For kk = 1 To 8  'CONTATORE DI RIGA

1338
For NN = 1 To 18 'CONTATORE DI COLONNA

1339
1340
'GoTo NOASOLE2

1341
'***************************************************************************************ASOLA VERTICALE

1342
1343
If Not kk > 6 Then

1344
1345
If Not (InStr(1, NORIPET, "_" & kk & NN & "_") > 0 Or InStr(1, NORIPET, "_" & kk + 1 & NN & "_") > 0 Or InStr(1, NORIPET, "_" & kk + 2 & NN & "_") > 0) Then

1346
If RC(kk, NN) = 1 And RC(kk + 1, NN) = 1 And RC(kk + 2, NN) = 1 Then

1347
Q_INT = Q_INT & T_SLOT(X0 + (NN - 1) * PS, Y0 + (8 - kk - 1) * PS, 7, 2, 90)

1348
NORIPET = NORIPET & "_" & kk & NN & "_" & kk + 1 & NN & "_" & kk + 2 & NN & "_"

1349
End If

1350
End If

1351
End If

1352
1353
1354
'***************************************************************************************ASOLA ORIZZONTALE

1355
1356
If Not NN > 16 Then

1357
1358
If Not (InStr(1, NORIPET, "_" & kk & NN & "_") > 0 Or InStr(1, NORIPET, "_" & kk & NN + 1 & "_") > 0 Or InStr(1, NORIPET, "_" & kk & NN + 2 & "_") > 0) Then

1359
If RC(kk, NN) = 1 And RC(kk, NN + 1) = 1 And RC(kk, NN + 2) = 1 Then

1360
Q_INT = Q_INT & T_SLOT(X0 + (NN) * PS, Y0 + (8 - kk) * PS, 7, 2, 0)

1361
NORIPET = NORIPET & "_" & kk & NN & "_" & kk & NN + 1 & "_" & kk & NN + 2 & "_"

1362
End If

1363
End If

1364
End If

1365
1366
NOASOLE2:

1367
'*****************************************************************************************TONDO

1368
1369
If Not InStr(1, NORIPET, "_" & kk & NN & "_") > 0 Then

1370
If RC(kk, NN) = 1 Then Q_INT = Q_INT & T_CIRC(X0 + (NN - 1) * PS, Y0 + (8 - kk) * PS, 2)

1371
End If

1372
1373
1374
1375
Next NN

1376
Next kk

1377
1378
T_DATAMATRIX = QORIGINE & QASSEY & QASSEX & Q_INT & QTM_Y & QTM_X

1379
1380
Case Else

1381
MsgBox ("ERRORE VERSO DATAMATRIX")

1382
End Select

1383
1384
1385
End Function

1386
1387
1388
1389
1390
1391
1392
Function T_RAD(ByVal XC As Double, ByVal YC As Double, ANGOLO As String)

1393
'RAGGIATURA

1394
1395
Select Case ANGOLO

1396
Case "1"

1397
ANGOLO = "-90"

1398
Case "2"

1399
ANGOLO = "0"

1400
Case "3"

1401
ANGOLO = "90"

1402
Case "4"

1403
ANGOLO = "180"

1404
Case Else

1405
MsgBox ("errore")

1406
End Select

1407
1408
1409
Offset = 0.65

1410
Select Case ANGOLO

1411
Case "0"

1412
T_RAD = T_SPECIAL(XC - Offset, YC + Offset, "RAG-3", "C0.")

1413
Case "180"

1414
T_RAD = T_SPECIAL(XC + Offset, YC - Offset, "RAG-3", "C0.")

1415
Case "90"

1416
T_RAD = T_SPECIAL(XC - Offset, YC - Offset, "RAG-3", "C0.")

1417
Case "-90"

1418
T_RAD = T_SPECIAL(XC + Offset, YC + Offset, "RAG-3", "C0.")

1419
Case Else

1420
MsgBox (("ERROR ANGLE 5RD"))

1421
End Select

1422
1423
1424
End Function

1425
1426
Function T_RAG(ByVal X As Double, ByVal Y As Double, ByVal LATO As Integer)

1427
1428
DSP = 2.9 '2.6

1429
Select Case LATO

1430
Case 1 'BASSO SINISTRO

1431
Y = Y - DSP

1432
X = X - DSP

1433
Case 2 'ALTO SINISTRO

1434
Y = Y + DSP

1435
X = X - DSP

1436
Case 3 'ALTO DESTRO

1437
Y = Y + DSP

1438
X = X + DSP

1439
Case 4 'BASSO DESTRO

1440
Y = Y - DSP

1441
X = X + DSP

1442
Case Else

1443
MsgBox ("ERRORE NELL'ANGOLO DEL RAGGIATORE")

1444
End Select

1445
1446
T_RAG = T_SPECIAL(X, Y, "3S", "C0.")

1447
1448
End Function

1449
1450
        

    


            


                                


        

            



                
    

        Public Pastes
    

    
            

    

                    

        

    





    


    
    
    
    
    
    
    
    




    


    



                

            We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.             OK, I Understand
        

    
                

            

                
                    
                
            

            

                Not a member of Pastebin yet?

                Sign Up, it unlocks many cool features!