API tools faq
paste
Advertisement
Dece111

Tooling

Dece111
Feb 28th, 2024
119
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
VisualBasic 36.06 KB | None | 0 0
raw download clone embed print report diff
  1. 'Tooling
  2.  
  3. Function T_RECT1(ByVal XS As Double, ByVal XD As Double, ByVal YI As Double, ByVal YS As Double) As String
  4.  
  5.  
  6. N1 = Round(XS, 2)
  7. N2 = Round(XD, 2)
  8. N3 = Round(YI, 2)
  9. N4 = Round(YS, 2)
  10.  
  11. If XS > XD Then
  12. XS = N2
  13. XD = N1
  14. End If
  15.  
  16. If YI > YS Then
  17. YI = N4
  18. YS = N3
  19. End If
  20.  
  21. ''********************
  22. 'If YI < -4 Then
  23. 'YI = -4
  24. 'End If
  25. ''********************
  26.  
  27.  
  28. XC = (XS + XD) / 2
  29. YC = (YI + YS) / 2
  30. WDTJ = Abs(XS - XD)
  31. HGTJ = Abs(YI - YS)
  32.  
  33.  
  34. T_RECT1 = T_RECT2(XC, YC, WDTJ, HGTJ)
  35.  
  36.  
  37.  
  38. If T_RECT1 = "" Then MsgBox ("ATTENZIONE ERRORE SPACCO RETTANGOLARE SU") & " " & ACT_MOD
  39.  
  40. End Function
  41.  
  42.  
  43.  
  44. Function T_RECT2(ByVal XC As Double, ByVal YC As Double, ByVal WDT As Double, ByVal HGT As Double) As String
  45.  
  46. 'ESEGUE UNA LAVORAZIONE RETTANGOLARE
  47. 'XC = X CENTRO RETTANGOLO    YC= Y CENTRO RETTANGOLO
  48. 'WDT = LARGHEZZA RETTANGOLO  HGT= ALTEZZA RETTANGOLO
  49.  
  50. WDT = Round(WDT, 2)
  51. HGT = Round(HGT, 2)
  52.  
  53. XC = Round(XC, 2)
  54. YC = Round(YC, 2)
  55.  
  56. XSX = XC - WDT / 2
  57. YLW = YC - HGT / 2
  58.  
  59. If XSX <= 0 Then LSX = 1 Else LSX = 0
  60. If YLW <= 0 Then LNF = 1 Else LNF = 0
  61.  
  62.  
  63. TX = LAB_2(WDT, HGT)
  64.  
  65. TXQ = LAB_7(WDT, HGT)
  66.  
  67. ' --------------------------- COMPARIAMO I RISULTATI FRA QUADRI E RETTANGOLI:
  68. RQ = 0
  69. If TX <> "" Then RQ = ((1 * Right(TX, InStr(1, StrReverse(TX), " ", vbTextCompare) - 1)) ^ 2) / (WDT * HGT) ' INDICE DELLA LAVORAZIONE COL QUADRO
  70.  
  71. If TXQ <> "" Then
  72. MLR = Right(TXQ, Len(TXQ) - InStr(1, TXQ, " ", vbBinaryCompare))
  73. MDX = NUM(Right(MLR, InStr(1, StrReverse(MLR), " ", vbTextCompare) - 1))
  74. MSX = NUM(Left(MLR, InStr(1, MLR, " ", vbTextCompare)))
  75. End If
  76.  
  77.  
  78.  
  79. RR = 0
  80. RR = (MDX * MSX) / (WDT * HGT)    ' INDICE DELLA PRESTAZIONE CON RETTANGOLO
  81.  
  82. If ACT_MOD = "1006715" And InStr(1, TXQ, "30 5") > 0 Then 'ELIMINARE
  83. RR = 0
  84. End If
  85. If ACT_MOD = "1014657" And InStr(1, TXQ, "32,6 22,6") > 0 Then 'ELIMINARE
  86. RR = 0
  87. End If
  88.  
  89. If TX & TXQ = "" Then GoTo UUUUUU
  90.  
  91. If RQ > RR Then
  92. TLBL = Left(TX, InStr(1, TX, " ", vbBinaryCompare) - 1)                 'ETICHETTA DELL'UTENSILE QUADRO SELEZIONATO
  93. SQRV = Right(TX, Len(TX) - InStr(1, TX, " ", vbBinaryCompare))          'LATO DELL'UTENSILE QUADRO SELEZIONATO
  94. MIN_LAT = -(WDT * (WDT <= HGT) + HGT * (WDT > HGT))                     'LATO MINIMO DEL RETTANGOLO
  95.  
  96. DIFF = MIN_LAT - SQRV
  97.  
  98.  
  99. Select Case DIFF
  100.  
  101.     Case Is > 0                'RODITURA X-Y
  102.    NPX = WDT / SQRV
  103.     If NPX > 1 Then
  104.     NPX = Int(NPX)
  105.     PX = Round((WDT - SQRV) / NPX, 2)
  106.     End If
  107.    
  108.     NPY = HGT / SQRV
  109.     If NPY > 1 Then
  110.     NPY = Int(NPY)
  111.     PY = Round((HGT - SQRV) / NPY, 2)
  112.     End If
  113.    
  114.    
  115.     Select Case LSX & LNF
  116.    
  117.     Case "00"               ' SCANTONATURA DX ALTA
  118.    XPC = XC + (WDT / 2 - SQRV / 2)
  119.     YPC = YC + (HGT / 2 - SQRV / 2)
  120.     G90 = "G90/X" & XPC & "/Y" & YPC & "/" & TLBL & "/*SQI*/>"
  121.     G37 = "G37/I-" & PX & "/P" & NPX & "/J-" & PY & "/K" & NPY & "/" & TLBL & "/*SQ*/>"
  122.    
  123.     Case "11"               ' SCANTONATURA SX BASSA
  124.    XPC = XC - (WDT / 2 - SQRV / 2)
  125.     YPC = YC - (HGT / 2 - SQRV / 2)
  126.     G90 = "G90/X" & XPC & "/Y" & YPC & "/" & TLBL & "/*SQI*/>"
  127.     G37 = "G37/I" & PX & "/P" & NPX & "/J" & PY & "/K" & NPY & "/" & TLBL & "/*SQ*/>"
  128.  
  129.     Case "10"               ' SCANTONATURA SX ALTA
  130.    XPC = XC - (WDT / 2 - SQRV / 2)
  131.     YPC = YC + (HGT / 2 - SQRV / 2)
  132.     G90 = "G90/X" & XPC & "/Y" & YPC & "/" & TLBL & "/*SQI*/>"
  133.     G37 = "G37/I" & PX & "/P" & NPX & "/J-" & PY & "/K" & NPY & "/" & TLBL & "/*SQ*/>"
  134.    
  135.     Case "01"               ' SCANTONATURA DX BASSA
  136.    XPC = XC + (WDT / 2 - SQRV / 2)
  137.     YPC = YC - (HGT / 2 - SQRV / 2)
  138.     G90 = "G90/X" & XPC & "/Y" & YPC & "/" & TLBL & "/*SQI*/>"
  139.     G37 = "G37/I-" & PX & "/P" & NPX & "/J" & PY & "/K" & NPY & "/" & TLBL & "/*SQ*/>"
  140.    
  141.     End Select
  142.    
  143.     T_RECT2 = ST64(Jcdf(G90)) & ST64(Jcdf(G37))
  144.      
  145.      
  146. Case Is = 0
  147.     If HGT - WDT = 0 Then     'COLPO SINGOLO
  148.    XPC = XC
  149.     YPC = YC
  150.     G90 = "G90/X" & XPC & "/Y" & YPC & "/" & TLBL & "/>"
  151.     T_RECT2 = ST64(Jcdf(G90))
  152.     Else
  153.    
  154.     If WDT > HGT Then         'RODITURA X
  155.    NPX = WDT / SQRV
  156.     If NPX > 1 Then
  157.     NPX = Int(NPX)
  158.     PX = Round((WDT - SQRV) / NPX, 2)
  159.     End If
  160.    
  161.     If LSX = 1 Then           '-------DA DX A SX  <<<<<<
  162.    XPC = Round(XC - (WDT / 2 - SQRV / 2), 2)
  163.     YPC = Round(YC, 2)
  164.     REP_X = XPC - 2000
  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.    
  169.     Else                     '-------DA SX A DX  >>>>>>>
  170.    XPC = Round(XC + (WDT / 2 - SQRV / 2), 2)
  171.     YPC = Round(YC, 2)
  172.     REP_X = XPC - 2000
  173.     G90 = "G90/X" & XPC & "/Y" & YPC & "/" & TLBL & "/*SQI*/>"
  174.     G28 = "G28/I" & PX & "/J180./K" & NPX & "/" & TLBL & "/*SQ*/>"
  175.     T_RECT2 = ST64(Jcdf(G90)) & ST64(Jcdf(G28))
  176.     End If
  177.    
  178.    
  179.     Else                      'RODITURA Y
  180.    NPY = HGT / SQRV
  181.     If NPY > 1 Then
  182.     NPY = Int(NPY)
  183.     PY = Round((HGT - SQRV) / NPY, 2)
  184.     End If
  185.    
  186.     If LNF = 1 Then           '------DALL'BASSO ALL'ALTO
  187.    XPC = Round(XC, 2)
  188.     YPC = Round(YC - (HGT / 2 - SQRV / 2), 2)
  189.     G90 = "G90/X" & XPC & "/Y" & YPC & "/" & TLBL & "/*SQI*/>"
  190.     G28 = "G28/I" & PY & "/J90./K" & NPY & "/" & TLBL & "/*SQ*/>"
  191.     T_RECT2 = ST64(Jcdf(G90)) & ST64(Jcdf(G28))
  192.    
  193.     Else                      '-------DALL'ALTO AL BASSO
  194.    XPC = Round(XC, 2)
  195.     YPC = Round(YC + HGT / 2 - SQRV / 2, 2)
  196.     G90 = "G90/X" & XPC & "/Y" & YPC & "/" & TLBL & "/*SQI*/>"
  197.     G28 = "G28/I" & PY & "/J-90./K" & NPY & "/" & TLBL & "/*SQ*/>"
  198.     T_RECT2 = ST64(Jcdf(G90)) & ST64(Jcdf(G28))
  199.     End If
  200.    
  201.     End If
  202.     End If
  203.    
  204.     Case Is < 0
  205.  
  206.     End Select
  207.    
  208.    
  209.    
  210. Else    '---------------------- DEFINIAMO LA LAVORAZIONE FATTA DI RETTANGOLO
  211.  
  212.  
  213. UTE = Left(TXQ, InStr(1, TXQ, " ", vbBinaryCompare) - 1)
  214. ANG = Right(UTE, InStr(1, StrReverse(UTE), "_", vbBinaryCompare) - 1)
  215. TLBL = Left(UTE, InStr(1, UTE, "_", vbBinaryCompare) - 1)
  216.  
  217. If Right(ANG, 1) = "I" Then TLBL = TLBL & "C" & Replace(ANG, "I", "") & "."
  218.  
  219.  
  220. MLR = Right(TXQ, Len(TXQ) - InStr(1, TXQ, " ", vbBinaryCompare))
  221.  
  222.  
  223. Select Case ANG
  224.  
  225. Case "0", "0I"
  226. XXX = NUM(Left(MLR, InStr(1, MLR, " ", vbTextCompare)))
  227. YYY = NUM(Right(MLR, InStr(1, StrReverse(MLR), " ", vbTextCompare) - 1))
  228.  
  229. Case "90", "90I"
  230.  
  231. XXX = NUM(Right(MLR, InStr(1, StrReverse(MLR), " ", vbTextCompare) - 1))
  232. YYY = NUM(Left(MLR, InStr(1, MLR, " ", vbTextCompare)))
  233.  
  234. Case Else
  235. MsgBox "ERROR RECT TOOL ANGLE"
  236. End Select
  237.    
  238.    
  239. RX = "0"
  240. RY = "0"
  241.  
  242. If WDT > XXX Then RX = "1"
  243. If HGT > YYY Then RY = "1"
  244.  
  245.  
  246. Select Case RX & RY
  247.  
  248. Case "00"   'COLPO   -------------------------------------------------------------------------------------
  249.    XPC = XC
  250.     YPC = YC
  251.     G90 = "G90/X" & XPC & "/Y" & YPC & "/" & TLBL & "/>"
  252.     T_RECT2 = ST64(Jcdf(G90))
  253.  
  254.  
  255. Case "11"   'RODITURA XY  -------------------------------------------------------------------------------------
  256.  
  257.     NPX = WDT / XXX
  258.     If NPX > 1 Then
  259.     NPX = Int(NPX)
  260.     PX = Round((WDT - XXX) / NPX, 3)
  261.     End If
  262.    
  263.     NPY = HGT / YYY
  264.     If NPY > 1 Then
  265.     NPY = Int(NPY)
  266.     PY = Round((HGT - YYY) / NPY, 3)
  267.     End If
  268.  
  269.  
  270.     Select Case LSX & LNF
  271.    
  272.     Case "00"               ' SCANTONATURA DX ALTA
  273.    XPC = XC + (WDT / 2 - XXX / 2)
  274.     YPC = YC + (HGT / 2 - YYY / 2)
  275.     G90 = "G90/X" & XPC & "/Y" & YPC & "/" & TLBL & "/*SQI*/>"
  276.     G37 = "G37/I-" & PX & "/P" & NPX & "/J-" & PY & "/K" & NPY & "/" & TLBL & "/*SQ*/>"
  277.    
  278.     Case "11"               ' SCANTONATURA SX BASSA
  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.     Case "10"               ' SCANTONATURA SX ALTA
  285.    XPC = XC - (WDT / 2 - XXX / 2)
  286.     YPC = YC + (HGT / 2 - YYY / 2)
  287.     G90 = "G90/X" & XPC & "/Y" & YPC & "/" & TLBL & "/*SQI*/>"
  288.     G37 = "G37/I" & PX & "/P" & NPX & "/J-" & PY & "/K" & NPY & "/" & TLBL & "/*SQ*/>"
  289.    
  290.     Case "01"               ' SCANTONATURA DX BASSA
  291.    XPC = XC + (WDT / 2 - XXX / 2)
  292.     YPC = YC - (HGT / 2 - YYY / 2)
  293.     G90 = "G90/X" & XPC & "/Y" & YPC & "/" & TLBL & "/*SQI*/>"
  294.     G37 = "G37/I-" & PX & "/P" & NPX & "/J" & PY & "/K" & NPY & "/" & TLBL & "/*SQ*/>"
  295.    
  296.     End Select
  297.    
  298.     T_RECT2 = ST64(Jcdf(G90)) & ST64(Jcdf(G37))
  299.  
  300.  
  301.  
  302. Case "01"  'RODITURA IN Y
  303.  
  304.  
  305. NPY = HGT / YYY
  306.     If NPY > 1 Then
  307.     NPY = Int(NPY)
  308.     PY = Round((HGT - YYY) / NPY, 2)
  309.     End If
  310.    
  311.     If LNF = 1 Then           '------DALL'BASSO ALL'ALTO
  312.    XPC = Round(XC, 2)
  313.     YPC = Round(YC - (HGT / 2 - YYY / 2), 2)
  314.     G90 = "G90/X" & XPC & "/Y" & YPC & "/" & TLBL & "/*SQI*/>"
  315.     G28 = "G28/I" & PY & "/J90./K" & NPY & "/" & TLBL & "/*SQ*/>"
  316.     T_RECT2 = ST64(Jcdf(G90)) & ST64(Jcdf(G28))
  317.    
  318.     Else                      '-------DALL'ALTO AL BASSO
  319.    XPC = Round(XC, 2)
  320.     YPC = Round(YC + HGT / 2 - YYY / 2, 2)
  321.     G90 = "G90/X" & XPC & "/Y" & YPC & "/" & TLBL & "/*SQI*/>"
  322.     G28 = "G28/I" & PY & "/J-90./K" & NPY & "/" & TLBL & "/*SQ*/>"
  323.     T_RECT2 = ST64(Jcdf(G90)) & ST64(Jcdf(G28))
  324.     End If
  325.  
  326.  
  327. Case "10"
  328.  
  329.     NPX = WDT / XXX
  330.     If NPX > 1 Then
  331.     NPX = Int(NPX)
  332.     PX = Round((WDT - XXX) / NPX, 2)
  333.     End If
  334.    
  335.     If LSX = 1 Then           '-------DA DX A SX  <<<<<<
  336.    XPC = Round(XC - (WDT / 2 - XXX / 2), 2)
  337.     YPC = Round(YC, 2)
  338.     REP_X = XPC - 2000
  339.     G90 = "G90/X" & XPC & "/Y" & YPC & "/" & TLBL & "/*SQI*/>"
  340.     G28 = "G28/I" & PX & "/J0./K" & NPX & "/" & TLBL & "/*SQ*/>"
  341.     T_RECT2 = ST64(Jcdf(G90)) & ST64(Jcdf(G28))
  342.    
  343.     Else                     '-------DA SX A DX  >>>>>>>
  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.  
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
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!