Egalware/OmagVIEWPlus
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
master
OmagVIEWPlus/NCCommunication/NCCommunication.vb
T
Nicola Pievani 65dee8bf4c OmagVIEWPlus 2.3a1: 
-> aggiornamento automatico della lista "PartList";
-> verifica funzionamento ultima versione.
2021-01-07 14:08:14 +00:00

2266 lines
114 KiB
VB.net
Raw Permalink Blame History

Imports System.Windows.Threading
Imports System.Collections.ObjectModel
Imports System.IO
Imports EgtUILib
Imports EgtWPFLib5
Imports Sharp7
Public Class NCCommunication
Public Enum Types As Integer
BIT = 0
' WORD = 1
INT = 2
' DWORD = 3
DINT = 4
REAL = 5
' STRING_ = 6
' CHAR_ARRAY = 7
End Enum
Public Enum Connection_States As Integer
DEBUG = 0
SIEMENS = 3
End Enum
Private m_bFirst As Boolean = True
' inidica che il pezzo sul manipolatore 2 deve essere scaricato a mano
Private m_IsTryAgainToUnload2 As Boolean = False
' indica che ci sono pezzi che devono essere scaricati a mano
Private m_bWaitingManualUnloading As Boolean = False
' in caso di errore in fase di pallettizzazione, quando è terminato lo scarico manuale dei pezzi allora torna False
Private m_bErrorLoading As Boolean = False
' indica che il ricalcolo del nesting per il pezzo rotto è stato fatto (attendo, devo passare le nuove coordinate)
Private m_bAdjustNestingTab1 As Boolean = False
' indica che il ricalcolo del nesting per il pezzo rotto è stato fatto (attendo, devo passare le nuove coordinate)
Private m_bAdjustNestingTab2 As Boolean = False
' pezzo precedente, il primo è creato in modo fittizio
Private m_LocalPrecPart As New Part(-10, -10)
' riferiento alla finestra delle informazioni
Private m_InfoWindowVM As InfoWindowVM
' riferiento alla finestra informazioni della tavola 1
Private m_InfoWindow1VM As InfoWindowVM
' forzo l'apertura dei magazzini
Friend m_OpenWarehouse As Boolean = False
' Timer
Private m_TimerIsBusy As Boolean = False
Private m_RefreshTimer As New DispatcherTimer
Private m_nTime As Integer = 0
Private m_NC As Nc_Parent = Nothing
Private Connection_State As Connection_States = Connection_States.DEBUG
Private SimulPosTab As New Point3d
Private SimulPosStrip As New Point3d
Private SimulCAng As Double = 0
Private Sub ShowResult(ByVal Result As Integer)
' This function returns a textual explaination of the error code
'TextError.Text = Client.ErrorText(Result)
End Sub
Public Sub New()
' lettura tipo di PLC
Dim nType As Integer = GetMainPrivateProfileInt(S_NUMERICALCONTROL, K_TYPE, 0)
Select Case nType
Case Connection_States.DEBUG
Connection_State = Connection_States.DEBUG
Case Connection_States.SIEMENS
' creazione classe Siemens
m_NC = New Nc_Siemens
' connessione
Dim bOk As Boolean = m_NC.InitConnection()
If bOk Then
Connection_State = Connection_States.SIEMENS
Else
Connection_State = Connection_States.DEBUG
MessageBox.Show("Impossible connect to the PLC.")
End If
Case Else
Connection_State = Connection_States.DEBUG
End Select
If Connection_State = Connection_States.DEBUG Then
m_NC = New Nc_Debug
End If
' lancio il timer di aggiornamento dell'interfaccia
AddHandler m_RefreshTimer.Tick, AddressOf RefreshTimer_Tick
m_RefreshTimer.Interval = TimeSpan.FromMilliseconds(GetMainPrivateProfileInt(S_NUMERICALCONTROL, K_TIMERINTERVAL, 1000))
m_RefreshTimer.Start()
' elimino il file di ProcessLog precedente
If My.Computer.FileSystem.FileExists(Map.refMainWindowVM.MainWindowM.sTempDir & "\ProcessLog.txt") Then
My.Computer.FileSystem.DeleteFile(Map.refMainWindowVM.MainWindowM.sTempDir & "\ProcessLog.txt")
End If
' eseguo la ricerca dei part
Part.GetListOfPart()
' carico il magazzino attivo (letto dalla configurazione)
For Each ItemWarehouse In Map.refUnloadingAreaVM.WarehouseList
If SetCurrStorage(ItemWarehouse) Then
If Map.refUnloadingAreaVM.IdProjTable2.enStatus = StatusProj.LOADING Then
Map.refUnloadingAreaVM.IdProjTable2.enStatus = StatusProj.WORKING
OutLogProcess("[0] Progetto pronto per pallettizzazione: " & Map.refUnloadingAreaVM.IdProjTable2.nProjInd.ToString)
End If
Exit For
End If
Next
' se lo stato del manipolatore-1 è "1", "2" oppure "3" significa che il primo pezzo della lista è in fase di elaborazione
Dim nVal1 As Integer = 0
If ReadInt("StatusMachine1Read", nVal1) Then
If Not IsNothing(Map.refUnloadingAreaVM.GetParts(Place.ON_TABLE)) AndAlso
Map.refUnloadingAreaVM.GetParts(Place.ON_TABLE).Count > 0 AndAlso
(nVal1 = 1 OrElse nVal1 = 2) Then
Map.refUnloadingAreaVM.CurrPartTable1 = Map.refUnloadingAreaVM.GetParts(Place.ON_TABLE)(0)
ElseIf Not IsNothing(Map.refUnloadingAreaVM.GetParts(Place.ON_TABLE, StatusPart.WASTE)) AndAlso
Map.refUnloadingAreaVM.GetParts(Place.ON_TABLE).Count > 0 AndAlso
nVal1 = 3 Then
Dim nLastWastePart As Integer = Map.refUnloadingAreaVM.GetParts(Place.ON_TABLE, StatusPart.WASTE).Count - 1
If nLastWastePart > 0 Then
Map.refUnloadingAreaVM.CurrPartTable1 = Map.refUnloadingAreaVM.GetParts(Place.ON_TABLE, StatusPart.WASTE)(nLastWastePart)
End If
End If
End If
' se lo stato del manipolatore-2 è "1", "2" oppure "3" significa che il primo pezzo della lista è in fase di elaborazione
Dim nVal2 As Integer = 0
If ReadInt("StatusMachine2Read", nVal2) Then
If Not IsNothing(Map.refUnloadingAreaVM.GetParts(Place.ON_MOTOR_RULLER)) AndAlso
Map.refUnloadingAreaVM.GetParts(Place.ON_MOTOR_RULLER).Count > 0 AndAlso
(nVal2 = 1 OrElse nVal2 = 2 OrElse nVal2 = 3) Then
Map.refUnloadingAreaVM.CurrPartTable2 = Map.refUnloadingAreaVM.GetParts(Place.ON_MOTOR_RULLER)(0)
' recupero il box corrente di deposito
Dim LocalCurrWarehouse As WarehouseVM = Map.refUnloadingAreaVM.GetCurrentWarehouse()
If Not IsNothing(LocalCurrWarehouse) Then
Map.refUnloadingAreaVM.CurrBox = Map.refUnloadingAreaVM.GetPartBox(Map.refUnloadingAreaVM.CurrPartTable2, LocalCurrWarehouse)
End If
End If
End If
' Eseguo subito la prima lettura variabili
Refresh()
End Sub
Private Sub RefreshTimer_Tick()
If Not m_TimerIsBusy Then
m_TimerIsBusy = True
m_RefreshTimer.Stop()
Refresh()
m_TimerIsBusy = False
m_RefreshTimer.Start()
End If
End Sub
Private Sub Refresh()
OutLogProcess("----------------------- " & My.Computer.Clock.LocalTime.ToLongTimeString & "-----------------------")
' verifico se è stato attivato il bottone
Map.refUnloadingAreaVM.NotifyPropertyChanged("ShowTabParts")
' eventualmente aggiorno la lista dei pezzi
If Not IsNothing(Map.refUnloadingAreaVM.m_refTablePartWindowVM) Then
Map.refUnloadingAreaVM.m_refTablePartWindowVM.NotifyPropertyChanged("CurrentPartList")
End If
'Dim n1Value As Integer = 0
'Dim x As Boolean = m_NC.ReadInt(81, 0, n1Value)
'Dim y As Boolean = m_NC.WriteInt(81, 0, 547)
''Dim nValue As Integer = 0
''ReadInt32(81, 0, nValue)
'Dim dValue As Double = 0
'm_NC.ReadReal(81, 2, dValue)
'Dim dVal As Double = 0
'Dim z As Boolean = m_NC.ReadReal(81, 2, dVal)
'Dim e As Boolean = m_NC.WriteReal(81, 2, 635.8736)
'Dim b As Boolean = False
'x = TryCast(m_NC, Nc_Siemens).ReadBool(81, 6, b)
'x = TryCast(m_NC, Nc_Siemens).WriteBool(81, 6, True)
'Dim s As String = ""
'x = TryCast(m_NC, Nc_Siemens).ReadString(81, 8, 6, s)
'x = TryCast(m_NC, Nc_Siemens).WriteString(81, 8, "tres")
Dim nValue As Integer = 0
Dim dValue As Double = 0
Dim nValue2 As Integer = 0
' variabile che indica se legge almeno una variabile
Dim bRaededVariable As Boolean = False
' Variabili prima lettura dopo cambio attivazione
Dim bAFirstNotActive As Boolean = False
Dim bBFirstNotActive As Boolean = False
' comunico il numero di pezzi presenti sulla tavola
If Not IsNothing(Map.refUnloadingAreaVM.GetParts(Place.ON_MOTOR_RULLER)) Then
Dim nCountRuller As Integer = Map.refUnloadingAreaVM.GetParts(Place.ON_MOTOR_RULLER).Count
WriteInt("CountPartsOnRuller", nCountRuller)
Else
WriteInt("CountPartsOnRuller", 0)
End If
' se la tavola è svuotata allora ricerco un nuovo progetto (solo se la rulliera non contiene pezzi con scarico manuale)
If Map.refUnloadingAreaVM.GetParts(Place.ON_TABLE).Count = 0 Then
OutLogProcess("[0] Tavola di carico vuota")
Dim nCounterManual As Integer = 0
Dim nCounterAutomatic As Integer = 0
' conto il numero di pezzi manuali presenti sulla rulliera
For Each ItemPart In Map.refUnloadingAreaVM.GetParts(Place.ON_MOTOR_RULLER)
If ItemPart.enUnloading = Unloading.MANUAL Then
nCounterManual = nCounterManual + 1
Else
nCounterAutomatic = nCounterAutomatic + 1
End If
Next
' leggo se lo scarico manuale è terminato (nValue=0) solo quando sono terminati quello automatici
If m_bWaitingManualUnloading Then
If ReadInt("UnloadManualRead", nValue) Then
bRaededVariable = True
If nValue = 0 Then
' svuoto la rulliera dai pezzi manuali
Map.refUnloadingAreaVM.UnloadedManualPart()
' comunico che lo scarico manuale è terminato
m_bWaitingManualUnloading = False
' ridefinisco subito il numero di pezzi manuali
nCounterManual = 0
End If
End If
End If
' verifico se sono presenti pezzi manuali sulla rulliera (se non ci son pezzi manuali -> bManualUnloading = False)
If nCounterManual > 0 AndAlso nCounterAutomatic = 0 Then
' comunico alla macchina che deve iniziare lo scarico manuale
WriteReal("UnloadManual", 1)
' attendo che sia comunicato il valore anche nella variabile di lettura (UnloadManualRead)
'EgtUILib.WritePrivateProfileString("0", "81.10", "1", "c:\EgtData\OmagVIEWPlus\Config\NC_Debug.ini")
' comunico che attendo il termino dello scarico manuale
m_bWaitingManualUnloading = True
' rendo visibile la freccia rossa sulla rulliera
Map.refUnloadingAreaVM.RullerArrowVisibility = Visibility.Visible
OutLogProcess("[0] Pezzi manuali sulla rulliera")
End If
' se lo scarico manuale è terminato procedo a caricare nuovo progetto
If nCounterManual = 0 Then
' nascondo la freccai rossa
Map.refUnloadingAreaVM.RullerArrowVisibility = Visibility.Collapsed
' carico il nuovo progetto
Dim sProjNew As String = Map.refMainWindowVM.MainWindowM.sProjDir & "\" & CURR_PROJ_NEW
Dim sProjLock As String = Map.refMainWindowVM.MainWindowM.sProjDir & "\" & CURR_PROJ_LOCK
' verifico che sia arrivato il seganle che la lastra è stata disposta correttamente
If ReadInt("TakePhotoRead", nValue) Then
bRaededVariable = True
' Se c'è file segnalazione nuovo lo trasformo in segnalazione bloccato
Dim bLoadProj As Boolean = True
If Map.refMainWindowVM.WaitingPhoto And nValue = 0 OrElse nValue = 2 Then
bLoadProj = False
End If
If My.Computer.FileSystem.FileExists(sProjNew) AndAlso bLoadProj Then
OutLogProcess("[0] Trovato nuovo progetto")
' se riesco a posizionare tutte le ventose
If Map.refMainWindowVM.StartUnloadingProject() Then
' Rinomino segnalazione nuovo in segnalazione blocco
My.Computer.FileSystem.MoveFile(sProjNew, sProjLock, True)
OutLogProcess("[0] Tutti i pezzi sono prelevabili")
Else
' Rinomino segnalazione nuovo in segnalazione blocco
OutLogProcess("[0] Impossibile caricare tutti i pezzi")
End If
WriteInt("TakePhoto", 0)
End If
End If
'' avendo caricato un nuovo progetto devo disporre il nuovo magazzino (se non ho altri progetti prima)
'Map.refUnloadingAreaVM.bOrganizeWarehouse = True
End If
End If
' aggiorno l'elenco dei progetti in esecuzione nel file Warehouse.ini
Dim sListIndProj As String = String.Empty
For Each ItemProj In Map.refMainWindowVM.MainWindowM.ProjIndList
If ItemProj.enStatus = StatusProj.LOADING Or ItemProj.enStatus = StatusProj.WORKING Then
' costruisco la stringa che contiene l'elenco dei progetti in esecuzione sulla macchina
If String.IsNullOrEmpty(sListIndProj) Then
sListIndProj = ItemProj.nProjInd.ToString
Else
sListIndProj = sListIndProj & "," & ItemProj.nProjInd.ToString
End If
End If
Next
' scrivo nel file ini l'elenco
WarehauseWritePrivateProfileString("Warehouse", "IdProj", sListIndProj)
' leggo lo stato SCARICATORE StatusMachine1
Dim StatusMachine1 As StatusMachine = StatusMachine.MOVING
If ReadInt("StatusMachine1Read", nValue) Then
bRaededVariable = True
' converto in Enum
If nValue >= 0 OrElse nValue <= 4 Then
StatusMachine1 = DirectCast(nValue, StatusMachine)
End If
Select Case StatusMachine1
Case StatusMachine.WAITING_POINT
OutLogProcess("[1] Stato macchina 1: 0")
' la macchina è ferma ed è pronta a ricevere le nuove coordinate
' se esiste un pezzo corrente allora significa che è stato scaricato correttamente
If Not IsNothing(Map.refUnloadingAreaVM.CurrPartTable1) Then
' comunico che il pezzo è stato depositato sulla rulliera (aggiorno il file ini del progetto)
If Not Map.refUnloadingAreaVM.CurrPartTable1.enStatus = StatusPart.WASTE Then
Map.refUnloadingAreaVM.CurrPartTable1.enPlace = Place.ON_MOTOR_RULLER
End If
EgtSetStatus(Map.refUnloadingAreaVM.CurrPartTable1.IdPart, GDB_ST.OFF)
EgtDraw()
OutLogProcess("[1] Pezzo depositato su rulliera: " & Map.refUnloadingAreaVM.CurrPartTable1.IdPart.ToString)
End If
' passo al pezzo successivo, e lo rendo corrente
Map.refUnloadingAreaVM.CurrPartTable1 = UnLoadTable1(SimulPosTab, SimulPosStrip, SimulCAng)
m_bAdjustNestingTab1 = False
' salvo il deisegno del progetto corrente
If Not IsNothing(Map.refUnloadingAreaVM.CurrPartTable1) Then
EgtSaveFile(Map.refMainWindowVM.MainWindowM.sTempDir & "\" & CURR_PROJ_NAME, NGE.BIN)
End If
Case StatusMachine.CHANGE_POINT
OutLogProcess("[1] Stato macchina 1: 3")
' chiedo conferma su cosa fare
If Not IsNothing(Map.refUnloadingAreaVM.CurrPartTable1) Then
' creo la finestra per eseguire la richiesta
If IsNothing(m_InfoWindow1VM) Then
m_InfoWindow1VM = New InfoWindowVM("Do you want to try again?", "Error in unloading 1")
m_InfoWindow1VM.m_RefInfoWindowV.Show()
Map.refUnloadingAreaVM.EnablePage = False
End If
If m_InfoWindow1VM.TryAgain Then
WriteInt("StatusMachine1", CInt(StatusMachine.LOADED_POINT))
m_InfoWindow1VM = Nothing
Map.refUnloadingAreaVM.EnablePage = True
Exit Select
ElseIf m_InfoWindow1VM.StopTry Then
' dichiaro che il pezzo è rovinato
Map.refUnloadingAreaVM.CurrPartTable1.enStatus = StatusPart.WASTE
OutLogProcess("[1] Pezzo scartato sul tavolo: " & Map.refUnloadingAreaVM.CurrPartTable1.IdPart.ToString)
m_InfoWindow1VM = Nothing
Map.refUnloadingAreaVM.EnablePage = True
' comunico che la macchina è libera
WriteInt("StatusMachine1", 0)
' coloro di rosso il pezzo non depositabile
Dim nIdRegion As Integer = GeomCalc.GetRegionFromPart(Map.refUnloadingAreaVM.CurrPartTable1.IdPart)
If nIdRegion > 0 Then
EgtSetColor(nIdRegion, New Color3d(255, 0, 0, 80))
EgtDraw()
End If
' se è l'ultimo pezzo comunico che il progetto è terminato
If Map.refUnloadingAreaVM.CurrPartTable1.IsLast Then
Map.refUnloadingAreaVM.IdProjTable2.enStatus = StatusProj.DONE
OutLogProcess("[3] Progetto terminato: " & Map.refUnloadingAreaVM.IdProjTable2.nProjInd.ToString)
' elimino il fiel lock
Dim sProjLock As String = Map.refMainWindowVM.MainWindowM.sProjDir & "\" & CURR_PROJ_LOCK
If My.Computer.FileSystem.FileExists(sProjLock) Then
My.Computer.FileSystem.DeleteFile(sProjLock)
OutLogProcess("[3] Eliminato file: " & sProjLock)
End If
Map.refUnloadingAreaVM.CurrPartTable1 = Nothing
Exit Select
End If
' ricalcolo il Nesting dei pezzi StatusPart.GOOD
If Not m_bAdjustNestingTab1 Then
m_bAdjustNestingTab1 = True
AdjustNesting1D(Map.refUnloadingAreaVM.CurrPartTable1)
End If
End If
End If
'' se esisteva un pezzo corrente allora significa chè è stato scartato
'If Not IsNothing(Map.refUnloadingAreaVM.CurrPartTable1) Then
' ' comunico che il pezzo è stato sacrtato (aggiorno il file ini del progetto)
' Map.refUnloadingAreaVM.CurrPartTable1.enStatus = StatusPart.WASTE
' OutLogProcess("[1] Pezzo scartato sul tavolo: " & Map.refUnloadingAreaVM.CurrPartTable1.IdPart.ToString)
' Dim nIdRegion As Integer = GeomCalc.GetRegionFromPart(Map.refUnloadingAreaVM.CurrPartTable1.IdPart)
' If nIdRegion > 0 Then
' EgtSetColor(nIdRegion, New Color3d(255, 0, 0, 80))
' EgtDraw()
' End If
' ' se è l'ultimo pezzo comunico che il progetto è terminato
' If Map.refUnloadingAreaVM.CurrPartTable1.IsLast Then
' Map.refUnloadingAreaVM.IdProjTable2.enStatus = StatusProj.DONE
' OutLogProcess("[3] Progetto terminato: " & Map.refUnloadingAreaVM.IdProjTable2.nProjInd.ToString)
' ' elimino il fiel lock
' Dim sProjLock As String = Map.refMainWindowVM.MainWindowM.sProjDir & "\" & CURR_PROJ_LOCK
' If My.Computer.FileSystem.FileExists(sProjLock) Then
' My.Computer.FileSystem.DeleteFile(sProjLock)
' OutLogProcess("[3] Eliminato file: " & sProjLock)
' End If
' Map.refUnloadingAreaVM.CurrPartTable1 = Nothing
' ' comunico macchina disponibile
' WriteInt("StatusMachine1", 0)
' Exit Select
' End If
' ' ricalcolo il Nesting dei pezzi StatusPart.GOOD
' If Not m_bAdjustNestingTab1 Then
' m_bAdjustNestingTab1 = True
' AdjustNesting1D(Map.refUnloadingAreaVM.CurrPartTable1)
' End If
'End If
'' passo al pezzo successivo, e lo rendo corrente
'Map.refUnloadingAreaVM.CurrPartTable1 = UnLoadTable1(SimulPosTab, SimulPosStrip, SimulCAng)
'' salvo il deisegno del progetto corrente
'If Not IsNothing(Map.refUnloadingAreaVM.CurrPartTable1) Then
' EgtSaveFile(Map.refMainWindowVM.MainWindowM.sTempDir & "\" & CURR_PROJ_NAME, NGE.BIN)
'End If
End Select
' aggiorno Pezzi rimasti sul tavolo (esclusi quelli rovinati)
Map.refUnloadingAreaVM.NotifyPropertyChanged("Table1Percentage")
' aggiorno Pezzi attualmente sulla rulliera motorizzata
Map.refUnloadingAreaVM.NotifyPropertyChanged("TableDifference")
End If
' simulo la posizione della ventosa sul tavolo
If ReadInt("StatusVacTab1Read", nValue) AndAlso Not IsNothing(Map.refUnloadingAreaVM.CurrPartTable1) Then
bRaededVariable = True
Dim bRefreshSimul As Boolean = True
If m_LocalPrecPart.IdPart = Map.refUnloadingAreaVM.CurrPartTable1.IdPart AndAlso m_LocalPrecPart.IdProject = Map.refUnloadingAreaVM.CurrPartTable1.IdProject Then
bRefreshSimul = False
End If
' se ventose attivate simulo la posizione di scarico
If nValue = 1 And bRefreshSimul Then
' non eseguo nessun controllo perchè posizionamento della ventosa
SimulUnloadingTab1(Map.refUnloadingAreaVM.CurrPartTable1, SimulPosStrip, SimulCAng)
' salvo il valore dell'ultimo pezzo prelevato
m_LocalPrecPart = Map.refUnloadingAreaVM.CurrPartTable1
ElseIf nValue = 0 Then
' simulo la posizione di carico (disegno la ventosa sopra il tavolo 1)
SimulLoadingTab1(Map.refUnloadingAreaVM.CurrPartTable1, SimulPosTab)
End If
End If
' mentre scarico la macchina1 attendo che la macchina2 sia pronta
Dim bFoundStorage As Boolean = False
' cambio progetto sulla tavola 2, devo attendere che i box di tipo LOADING siano stati riempiti
OutLogProcess("[2] Stato progetto corrente: " & Map.refUnloadingAreaVM.IdProjTable2.nProjInd.ToString & " - " & Map.refUnloadingAreaVM.IdProjTable2.enStatus.ToString)
' se il progetto corrente (se nessun file .ini di progetto è caricato nell'OrganizeWarehouse) è in fase LOADING oppure DONE, passo al successivo
If (Map.refUnloadingAreaVM.IdProjTable2.enStatus = StatusProj.DONE Or Map.refUnloadingAreaVM.IdProjTable2.enStatus = StatusProj.LOADING Or
Map.refUnloadingAreaVM.IdProjTable2.nProjInd = -1) And
EndedUnloading() Then
' verifico lo stato del magazzino corrente se è ancora disponibile (altrimenti lo disattivo)
CurrWarehaouseIsAvailable(Map.refUnloadingAreaVM.GetCurrentWarehouse())
' se il progetto è prenotato allora rendo i magazzini non disponibili alla macchina e disattivi
If Map.refMainWindowVM.WaitingConfirmManualPart Then
OutLogProcess("[2] Nuova lastra prenotata")
' riabilito la scelta dei magazzini
Map.refUnloadingAreaVM.SetActiveWarehouse(0)
For Each ItemWarehouse In Map.refUnloadingAreaVM.WarehouseList
ItemWarehouse.SetState(States.NOT_AVAILABLE)
OutLogProcess("[2] Rendo disponibile il magazzino: " & ItemWarehouse.Id.ToString)
Next
Else
' ricerco il primo magazzino attivo
For Each ItemWarehouse In Map.refUnloadingAreaVM.WarehouseList
If ItemWarehouse.IsActive Then
OutLogProcess("[2] Trovato magazzino Attivo: " & ItemWarehouse.Id.ToString)
' verifico se il magazzino è ancora disponibile per il nuovo progetto
Map.refUnloadingAreaVM.bOrganizeWarehouse = Not SetCurrStorage(ItemWarehouse)
End If
Next
' se non è stato trovato nessun magazzino attivo cerco il primo magazzino disponibile
If Map.refUnloadingAreaVM.bOrganizeWarehouse Then
OutLogProcess("[2] Nessun magazzino Attivo")
For Each ItemWarehouse In Map.refUnloadingAreaVM.WarehouseList
If ItemWarehouse.State = States.AVAILABLE Then
Map.refUnloadingAreaVM.bOrganizeWarehouse = Not SetCurrStorage(ItemWarehouse)
End If
Next
End If
End If
End If
' se la finestra "Status Machine 2" è aperta allora la aggiorno
If Not IsNothing(Map.refUnloadingAreaVM.m_refStatuMachine2VM) Then
Map.refUnloadingAreaVM.m_refStatuMachine2VM.SetStatusMachine()
End If
' recupero il MAGAZZINO attivo, se non c'è magazzino attivo il pallettizzatore aspetta
Dim CurrWarehouse As WarehouseVM = Map.refUnloadingAreaVM.GetCurrentWarehouse()
If IsNothing(CurrWarehouse) Then Return
If Not CurrWarehouse.IsActive Then Return
' inizio a lavorare sul progetto corrente
If Map.refUnloadingAreaVM.IdProjTable2.enStatus = StatusProj.LOADING Then
Map.refUnloadingAreaVM.IdProjTable2.enStatus = StatusProj.WORKING
OutLogProcess("[2] Progetto pronto per pallettizzazione: " & Map.refUnloadingAreaVM.IdProjTable2.nProjInd.ToString)
End If
' comunico nuovo magazzino
SetActiveWarehouse(CurrWarehouse)
' leggo lo stao del pallettizzatore
Dim StatusMachine2 As StatusMachine = StatusMachine.MOVING
If ReadInt("StatusMachine2Read", nValue) Then
bRaededVariable = True
' converto in Enum
If nValue >= 0 OrElse nValue <= 4 Then
StatusMachine2 = DirectCast(nValue, StatusMachine)
End If
Select Case StatusMachine2
Case StatusMachine.WAITING_POINT
OutLogProcess("[3] Stato macchina 2: 0")
Dim bWaitingForManual As Boolean = False
' verifico che sul rullo siano stati depositati tutti i pezzi che riempiono un Layer
If Not IsNothing(Map.refUnloadingAreaVM.CurrPartTable2) AndAlso
Map.refUnloadingAreaVM.CurrPartTable2.enUnloading = Unloading.AUTOMATIC AndAlso
Map.refUnloadingAreaVM.CurrPartTable2.enPlace <> Place.ON_BOX Then
' comunico che il pezzo è stato depositato nel Box
Map.refUnloadingAreaVM.CurrPartTable2.enPlace = Place.ON_BOX
OutLogProcess("[3] Pezzo depositato nel Box: " & Map.refUnloadingAreaVM.CurrPartTable2.IdPart.ToString & " - " & Map.refUnloadingAreaVM.CurrPartTable2.IdBox.ToString)
' aggiorno la percentuale del box
If Not IsNothing(Map.refUnloadingAreaVM.CurrBox) Then Map.refUnloadingAreaVM.CurrBox.NotifyPropertyChanged("nFillPercentage")
' se è l'ultimo pezzo comunico che il progetto è terminato
If Map.refUnloadingAreaVM.CurrPartTable2.IsLast Then
Map.refUnloadingAreaVM.IdProjTable2.enStatus = StatusProj.DONE
OutLogProcess("[3] Progetto terminato: " & Map.refUnloadingAreaVM.IdProjTable2.nProjInd.ToString)
' elimino il file ini associato
Dim sFile As String = Map.refMainWindowVM.MainWindowM.sTempDir & "\PartList" & Map.refUnloadingAreaVM.IdProjTable2.nProjInd.ToString & ".ini"
If My.Computer.FileSystem.FileExists(sFile) Then
My.Computer.FileSystem.DeleteFile(sFile)
OutLogProcess("[3] Eliminato file: " & sFile)
End If
Map.refUnloadingAreaVM.CurrPartTable2 = Nothing
Exit Select
End If
' nascondo la freccia rossa sulla rulliera
Map.refUnloadingAreaVM.RullerArrowVisibility = Visibility.Collapsed
ElseIf Not IsNothing(Map.refUnloadingAreaVM.CurrPartTable2) AndAlso
Map.refUnloadingAreaVM.CurrPartTable2.enUnloading = Unloading.MANUAL AndAlso
Map.refUnloadingAreaVM.CurrPartTable2.enPlace <> Place.ON_WASTE_BOX Then
bWaitingForManual = True
' rendo visibile la freccia rossa sulla rulliera
Map.refUnloadingAreaVM.RullerArrowVisibility = Visibility.Visible
If ReadInt("UnloadManualRead", nValue) Then
bRaededVariable = True
If nValue = 0 Then
' lo scarico manulae del pezzo è avvenuto
Map.refUnloadingAreaVM.ClearOutputMessage()
m_bErrorLoading = False
' significa che il pezzo è stato tolto a mano (dove è finito?)
Map.refUnloadingAreaVM.CurrPartTable2.enStatus = StatusPart.NOT_LOADED
Map.refUnloadingAreaVM.CurrPartTable2.enPlace = Place.ON_WASTE_BOX
bWaitingForManual = False
OutLogProcess("[3] Pezzo non prelevabile : " & Map.refUnloadingAreaVM.IdProjTable2.nProjInd.ToString)
' se ultimo pezzo
If Map.refUnloadingAreaVM.CurrPartTable2.IsLast Then
Map.refUnloadingAreaVM.IdProjTable2.enStatus = StatusProj.DONE
OutLogProcess("[3] Progetto terminato: " & Map.refUnloadingAreaVM.IdProjTable2.nProjInd.ToString)
' elimino il file ini associato
Dim sFile As String = Map.refMainWindowVM.MainWindowM.sTempDir & "\PartList" & Map.refUnloadingAreaVM.IdProjTable2.nProjInd.ToString & ".ini"
If My.Computer.FileSystem.FileExists(sFile) Then
My.Computer.FileSystem.DeleteFile(sFile)
OutLogProcess("[3] Eliminato file: " & sFile)
End If
Map.refUnloadingAreaVM.CurrPartTable2 = Nothing
Exit Select
End If
' nascondo il pezzo
EgtSetStatus(Map.refUnloadingAreaVM.CurrPartTable2.IdPart, GDB_ST.OFF)
' Ricalcolo la disposizione dei pezzi nel deposito
AdjustNesting1DTab2(Map.refUnloadingAreaVM.CurrPartTable2)
End If
End If
End If
' verifico che un intero Layer sia stato depositato sulla ruelliera e che il pezzo corrente non debba essere scaricato a mano
If CompleteLayerForUnloading(Map.refUnloadingAreaVM.IdProjTable2.nProjInd) And Not bWaitingForManual Then
' salvo le coordinate per afferrare e depositare i pezzi (solo quelli automatici)
Map.refUnloadingAreaVM.CurrPartTable2 = UnLoadTable2(CurrWarehouse, Map.refUnloadingAreaVM.IdProjTable2.nProjInd)
End If
' salvo il deisegno del progetto corrente
If Map.refMainWindowVM.MainWindowM.nProjInd = Map.refUnloadingAreaVM.IdProjTable2.nProjInd Then
EgtSaveFile(Map.refMainWindowVM.MainWindowM.sTempDir & "\" & CURR_PROJ_NAME, NGE.BIN)
End If
Case StatusMachine.CHANGE_POINT
OutLogProcess("[3] Stato macchina 2: 3")
' rendo visibile la freccia rossa sulla rulliera
Map.refUnloadingAreaVM.RullerArrowVisibility = Visibility.Visible
' chiedo conferma su cosa fare
If Not IsNothing(Map.refUnloadingAreaVM.CurrPartTable2) Then
If IsNothing(m_InfoWindowVM) Then
m_InfoWindowVM = New InfoWindowVM("Do you want to try again?", "Error in unloading 2")
m_InfoWindowVM.m_RefInfoWindowV.Show()
Map.refUnloadingAreaVM.EnablePage = False
End If
If m_InfoWindowVM.TryAgain Then
WriteInt("StatusMachine2", CInt(StatusMachine.LOADED_POINT))
m_InfoWindowVM = Nothing
Map.refUnloadingAreaVM.EnablePage = True
' nascondo la freccia rossa sulla rulliera
Map.refUnloadingAreaVM.RullerArrowVisibility = Visibility.Collapsed
Exit Select
ElseIf m_InfoWindowVM.StopTry Then
' dichiaro che il pezzo deve essere scaricaro a mano
Map.refUnloadingAreaVM.CurrPartTable2.enUnloading = Unloading.MANUAL
OutLogProcess("[3] Pezzo non prelevabile : " & Map.refUnloadingAreaVM.IdProjTable2.nProjInd.ToString)
m_InfoWindowVM = Nothing
Map.refUnloadingAreaVM.EnablePage = True
' comunico che attendo lo scarico manuale del pezzo
WriteReal("UnloadManual", 1)
' comunico che la macchina è libera
WriteInt("StatusMachine2", 0)
' coloro di rosso il pezzo non depositabile
Dim nIdRegion As Integer = GeomCalc.GetRegionFromPart(Map.refUnloadingAreaVM.CurrPartTable2.IdPart)
If nIdRegion > 0 Then
EgtSetColor(nIdRegion, New Color3d(255, 0, 0, 80))
EgtDraw()
End If
End If
End If
' salvo il deisegno del progetto corrente
If Map.refMainWindowVM.MainWindowM.nProjInd = Map.refUnloadingAreaVM.IdProjTable2.nProjInd Then
EgtSaveFile(Map.refMainWindowVM.MainWindowM.sTempDir & "\" & CURR_PROJ_NAME, NGE.BIN)
End If
End Select
End If
' Pezzi attualmente sulla rulliera motorizzata
Map.refUnloadingAreaVM.NotifyPropertyChanged("TableDifference")
' Percentuale di pezzi depositati nel totale dei box disponibili magazzino
CurrWarehouse.NotifyPropertyChanged("FillPercentage")
End Sub
#Region "METHODS"
' salvo le coordinate per afferrare e depositare il pezzo sulla tavola 1
Private Function UnLoadTable1(ByRef PosTable1 As Point3d, ByRef PosStrip As Point3d, ByRef C_Ang As Double) As Part
Dim LocalPart As Part = Nothing
' la macchina è ferma e ha scartato un pezzo-> comunico le coordinate di aggancio del nuovo pezzo
If Not IsNothing(Map.refUnloadingAreaVM.GetParts(Place.ON_TABLE)) AndAlso
Map.refUnloadingAreaVM.GetParts(Place.ON_TABLE).Count > 0 Then
LocalPart = Map.refUnloadingAreaVM.GetParts(Place.ON_TABLE)(0)
PosTable1 = LocalPart.GetUnloadingPosTable1
WriteReal("X_Table1", PosTable1.x)
WriteReal("Y_Table1", PosTable1.y)
WriteReal("Z_Table1", PosTable1.z)
WriteReal("C_Table1", LocalPart.DegAngOnTable)
PartWritePrivateProfilePoint(LocalPart.IdProject, ConstIni.S_PART & LocalPart.IdPart.ToString, "PointTable1", PosTable1)
' salvo le informazioni del pezzo manipolatore per il deposito
C_Ang = 0
If LocalPart.MoveTable1.m_bCupsSecondSel Then
C_Ang = -90
End If
PosStrip = LocalPart.GetloadingPosStrip(C_Ang)
WriteReal("X_MotorStrip", PosStrip.x)
WriteReal("Y_MotorStrip", PosStrip.y)
WriteReal("Z_MotorStrip", PosStrip.z)
WriteReal("C_MotorStrip", C_Ang)
PartWritePrivateProfilePoint(LocalPart.IdProject, ConstIni.S_PART & LocalPart.IdPart.ToString, "PointStrip", PosStrip)
' restitusco la dimensione x del pezzo
WriteReal("Rect1DimX", LocalPart.MoveTable1.m_vtRect.x * 2)
' salvo le ventose che devono essere attivate
For IndexVacuum = 1 To 8
WriteInt("Tb1Vacuum" & IndexVacuum.ToString, LocalPart.GetVacuumLoadingStatus("V" & IndexVacuum.ToString))
Next
' comunico se è ultimo pezzo
If LocalPart.IsLast Then
WriteInt("LastPartTable1", 1)
OutLogProcess("UnLoadTable1() -> Ultimo Pezzo prelevato dal tavolo: " & LocalPart.IdPart.ToString)
' salvo le informazioni sui pezzi rovinati del tavolo 1
Map.refMainWindowVM.MainWindowM.SavePartStatus()
' cancello il file .lck
Dim sProjLock As String = Map.refMainWindowVM.MainWindowM.sProjDir & "\" & CURR_PROJ_LOCK
If My.Computer.FileSystem.FileExists(sProjLock) Then
My.Computer.FileSystem.DeleteFile(sProjLock)
OutLogProcess("[3] Eliminato file: " & sProjLock)
End If
Else
WriteInt("LastPartTable1", -1)
OutLogProcess("UnLoadTable1() -> Altri pezzi da prelevare dal tavolo")
End If
' modifico il colore per indicare quale è il pezzo in elaborazione
Dim nIdRegion As Integer = GeomCalc.GetRegionFromPart(LocalPart.IdPart)
If nIdRegion > 0 Then
EgtSetColor(nIdRegion, New Color3d(0, 255, 0, 80))
EgtDraw()
End If
' Per visualizzare le sequenza di scarico in modo veloce durante il Debug
If Connection_State = Connection_States.DEBUG Then
SimulLoadingTab1(LocalPart, PosTable1)
SimulUnloadingTab1(LocalPart, PosStrip, C_Ang)
End If
' comunico nuovo stato alla macchina-> 1
WriteInt("StatusMachine1", CInt(StatusMachine.LOADED_POINT))
'EgtUILib.WritePrivateProfileString("0", "81.140", "1", "c:\EgtData\OmagVIEWPlus\Config\NC_Debug.ini")
OutLogProcess("UnLoadTable1() -> Communico punto di prelievo pezzo: " & LocalPart.IdPart.ToString)
OutLogProcess("UnLoadTable1() -> Stato macchina 1: 1 - " & LocalPart.IdPart.ToString)
End If
Return LocalPart
End Function
' verifico se ho terminato il carcio dei Box
Private Function EndedUnloading() As Boolean
If IsNothing(Map.refUnloadingAreaVM.GetCurrentWarehouse) Then Return True
'If Not m_OpenWarehouse Then
For Each ItemBox In Map.refUnloadingAreaVM.GetCurrentWarehouse.Boxes
ItemBox.NotifyPropertyChanged("nFillPercentage")
If ItemBox.State = States.LOADING Then
OutLogProcess("EndedUnloading() -> Box G" & ItemBox.OrigDefCN.ToString & " index " & ItemBox.Id.ToString & " incompleto")
Return False
End If
Next
OutLogProcess("EndedUnloading() -> Terimnato riempimento Boxs")
'Else
' For Each ItemBox In Map.refUnloadingAreaVM.GetCurrentWarehouse.Boxes
' ItemBox.NotifyPropertyChanged("nFillPercentage")
' If ItemBox.State = States.LOADING Or ItemBox.State = States.AVAILABLE Then
' ItemBox.IsAvailable = False
' OutLogProcess("Box " & ItemBox.Id.ToString & " non disponibile per il ricalcolo")
' End If
' Next
' OutLogProcess("EndedUnloading() -> Terimnato riempimento Boxs")
'End If
Return True
End Function
' simulo il prelievo dal tavolo 1
Private Sub SimulLoadingTab1(ByVal LocalPart As Part, PosTable1 As Point3d)
EgtSetMachineLook(MCH_LOOK.TAB_HEAD)
' simulo la posizione di prelievo
EgtSetAxisPos("X1", PosTable1.x + LocalPart.ptTable1.x)
EgtSetAxisPos("Y", PosTable1.y + LocalPart.ptTable1.y)
EgtSetAxisPos("Z1", PosTable1.z + LocalPart.ptTable1.z)
EgtSetAxisPos("W1", LocalPart.DegAngOnTable)
EgtDraw()
End Sub
' simulo lo scarico sulla rulliera dal tavolo 1
Private Sub SimulUnloadingTab1(ByVal LocalPart As Part, PosStrip As Point3d, C_Ang As Double)
' rappresento graficamente il deposito sulla rulliera dei pezzi
If LocalPart.MoveTable1.m_bCupsSecondSel Then
' ruoto il pezzo per simulare il deposito sulla rulliera
EgtRotate(LocalPart.IdPart, LocalPart.MoveTable1.m_ptCenMinRect, Vector3d.Z_AX, -LocalPart.MoveTable1.m_dAngRotDeg - 90, GDB_RT.GLOB)
Else
EgtRotate(LocalPart.IdPart, LocalPart.MoveTable1.m_ptCenMinRect, Vector3d.Z_AX, -LocalPart.MoveTable1.m_dAngRotDeg, GDB_RT.GLOB)
End If
' calcolo il vettore di spostamento
Dim vtRuller As Vector3d = New Vector3d(4081.61, 3740.55, 23.08)
Dim vtPartOnRuller As Vector3d = (PosStrip - Point3d.ORIG) - LocalPart.MoveTable1.m_vtDelta
Dim vtPartToRuller As Vector3d = vtRuller - (LocalPart.CeneterPartTable - Point3d.ORIG)
Dim vtMove As Vector3d = (vtPartToRuller + vtPartOnRuller)
EgtMove(LocalPart.IdPart, vtMove, GDB_RT.GLOB)
' simulo la posizione di deposito
EgtSetMachineLook(MCH_LOOK.TAB_HEAD)
EgtSetAxisPos("X1", PosStrip.x + vtRuller.x + LocalPart.ptTable1.x)
EgtSetAxisPos("Y", PosStrip.y + vtRuller.y + LocalPart.ptTable1.y)
EgtSetAxisPos("Z1", PosStrip.z + vtRuller.z + LocalPart.ptTable1.z)
EgtSetAxisPos("W1", C_Ang)
EgtDraw()
End Sub
' verifico lo stato del magazzino (se tutto occupato allora lo libero subito)
Private Function CurrWarehaouseIsAvailable(CurrWareouse As WarehouseVM) As Boolean
If IsNothing(CurrWareouse) Then Return True
' verifico che il magazzino è disponibile
If CurrWareouse.State = States.AVAILABLE Then
For Each ItemGridBox In CurrWareouse.GridBoxList
For Each ItemBox In ItemGridBox.CurrBoxList
If ItemBox.State = States.AVAILABLE Or ItemBox.State = States.LOADING Then
OutLogProcess("CurrWarehaouseIsAvailable() -> Magazzino corrente disponibile: " & CurrWareouse.Id.ToString)
Return True
End If
Next
Next
End If
'CurrWareouse.SetIsActive(False)
CurrWareouse.SetState(States.NOT_AVAILABLE)
OutLogProcess("CurrWarehaouseIsAvailable() -> Magazzino corrente non disponibile: " & CurrWareouse.Id.ToString)
'CurrWareouse.NotifyPropertyChanged("IsEnabled")
Return False
End Function
' salvo il magazzino attivo (solo se è differente da quello corrente) e lo comunico
Private Sub SetActiveWarehouse(CurrWarehouse As WarehouseVM)
Dim nValue As Integer = 0
Dim dValue As Double = 0
' comunico il magazzino attivo
WarehauseWritePrivateProfileString("Warehouse", "ActiveStorage", CurrWarehouse.Id.ToString)
WriteReal("ActiveStorage", CurrWarehouse.Id)
'' lo stato del magazzino è reale (solo nel plc)
'If ReadReal("ActiveStorageRead", dValue) Then
' Dim enIdStorage As Warehouses
' nValue = CInt(dValue)
' If nValue >= 0 OrElse nValue <= 4 Then
' enIdStorage = DirectCast(nValue, Warehouses)
' End If
' If enIdStorage <> CurrWarehouse.Id Then
' WarehauseWritePrivateProfileString("Warehouse", "ActiveStorage", CurrWarehouse.Id.ToString)
' nValue = CInt(CurrWarehouse.Id)
' WriteReal("ActiveStorage", CDbl(nValue))
' EgtUILib.WritePrivateProfileString("0", "81.6", nValue.ToString, "c:\EgtData\OmagVIEWPlus\Config\NC_Debug.ini")
' OutLogProcess("SetActiveWarehouse() -> " & enIdStorage.ToString & " <> " & CurrWarehouse.Id.ToString)
' OutLogProcess("SetActiveWarehouse() -> Comunico il cambio di magazzino alla macchina: " & CurrWarehouse.Id.ToString)
' End If
'End If
End Sub
' verifico che il magazzino corrente possa accogliere i nuovi pezzi
Private Function SetCurrStorage(objWarehouse As WarehouseVM) As Boolean
' se il magazzino attivo non è più disponibile
If objWarehouse.State <> States.AVAILABLE Then
' allora comunico che non è attivo
objWarehouse.SetIsActive(False)
OutLogProcess("SetCurrStorage() -> Disattivo magazzino corrente: " & objWarehouse.Id.ToString)
'esco
Return False
End If
' se il magazzino corrente è disponibile
Map.refUnloadingAreaVM.SetActiveWarehouse(objWarehouse.Id)
' verifico che il progetto possa essere scaricato
Dim bStorageFound As Boolean = Map.refUnloadingAreaVM.OrganaizeWarehouse()
If Not bStorageFound Then
objWarehouse.SetIsActive(False)
objWarehouse.SetState(States.NOT_AVAILABLE)
objWarehouse.NotifyPropertyChanged("IsEnabled")
OutLogProcess("SetCurrStorage() -> magazzino corrente non disponibile per scarico: " & objWarehouse.Id.ToString)
End If
Return bStorageFound
End Function
' verifico che un layer sia completamente disponibile sulla rulliera, oppure che ci sia un numero minimo (letto da configurazione) di pezzi
Private Function CompleteLayerForUnloading(IdProjTable2 As Integer) As Boolean
' verifico quali sono i pezzi presenti sulla rulliera
Dim ListPartRuller As New ObservableCollection(Of Part)
Dim ListPartTable1 As New ObservableCollection(Of Part)
Dim nLayerRuller As Integer = 0
Dim nLayerTable1 As Integer = -1
Dim nIdBoxTable As Integer = -1
Dim nIdBoxRuller As Integer = -2
' recupero le liste del progetto corrente sulla rulliera e sul tavolo
ListPartRuller = Map.refUnloadingAreaVM.GetParts(IdProjTable2, Place.ON_MOTOR_RULLER)
ListPartTable1 = Map.refUnloadingAreaVM.GetParts(IdProjTable2, Place.ON_TABLE)
' in emergenza: se ho più di 4 pezzi inizio a scaricare
Dim nMaxPart As Integer = 5
nMaxPart = GetMainPrivateProfileInt("BOX", "MinCountPartRuller", nMaxPart)
If ListPartRuller.Count >= nMaxPart Then
Return True
End If
' recupero il Layer del primo pezzo inserito sulla rulliera
If ListPartRuller.Count > 0 Then
nLayerRuller = ListPartRuller(0).nLayer
nIdBoxRuller = ListPartRuller(0).IdBox
Else
' siginfica che la rulliera è vuota
Return False
End If
' se il pezzo deve essere depositato sul Rack (nLayer = -1)
If nLayerRuller = -1 Then
Return True
End If
' recupero il Layer del primo pezzo da scaricare sulla rullira
If ListPartTable1.Count > 0 Then
nLayerTable1 = ListPartTable1(0).nLayer
nIdBoxTable = ListPartTable1(0).IdBox
Else
'significa che la tavola è vuota
Return True
End If
' se lo stasso Layer è sulla rulliera e sul tavolo significa che non posso iniziare a scaricare
If nLayerTable1 <> nLayerRuller Or nIdBoxTable <> nIdBoxRuller Then
Return True
Else
Return False
End If
End Function
' salvo le coordinate per afferrare e depositare il pezzo sulla tavola 2
Private Function UnLoadTable2(CurrWarehouse As WarehouseVM, IdProjTable2 As Integer) As Part
Dim LocalPart As Part = Nothing
' devo ricercare i pezzi del progetto che sto scaricando
If Not IsNothing(Map.refUnloadingAreaVM.GetParts(IdProjTable2, Place.ON_MOTOR_RULLER)) AndAlso
Map.refUnloadingAreaVM.GetParts(IdProjTable2, Place.ON_MOTOR_RULLER).Count > 0 Then
LocalPart = Map.refUnloadingAreaVM.GetParts(IdProjTable2, Place.ON_MOTOR_RULLER)(0)
' se lo scarico previsto è manuale allora interrompo
If LocalPart.enUnloading = Unloading.MANUAL Then
Return LocalPart
End If
Dim bFoundBox As Boolean = False
' ricerco tra tutti i box del magazzino quello che deve accogliere il pezzo
For Each ItemBox In CurrWarehouse.Boxes
For Each ItemPart In ItemBox.MyListPart
If ItemPart.IdPart = LocalPart.IdPart AndAlso
ItemPart.IdProject = LocalPart.IdProject Then
ItemBox.State = States.LOADING
Map.refUnloadingAreaVM.CurrBox = ItemBox
' comunico le coordinte di afferraggio pezzo (indipendenti dal tipo di Box)
Dim PointRuller As Point3d = LocalPart.GetLoadingPosRuller
WriteReal("X_Ruller", PointRuller.x)
WriteReal("Y_Ruller", PointRuller.y)
WriteReal("Z_Ruller", PointRuller.z)
WriteReal("C_Ruller", LocalPart.MoveTable2.m_dAngRotDeg)
PartWritePrivateProfilePoint(LocalPart.IdProject, ConstIni.S_PART & LocalPart.IdPart.ToString, "PointRuller", PointRuller)
' rappresento graficamente il deposito sulla rulliera dei pezzi -> solo per la versione Debug
If Map.refMainWindowVM.MainWindowM.nProjInd = Map.refUnloadingAreaVM.IdProjTable2.nProjInd Then
SimulLouadingTab2(LocalPart, PointRuller)
End If
' restitusco la dimensione x del pezzo
WriteReal("Rect2DimX", LocalPart.MoveTable2.m_vtRect.x * 2)
' cumunico l'id del box ativo
WriteInt("ActiveBox", ItemBox.Id)
' riconosco il tipo di box
Dim C_Ang As Double = 0
Dim B_Ang As Double = 0
If ItemBox.enConfigBox = ConfigBox.PALLET Then
' deposito sempre com la ventosa 8 rivolta verso i cancelli
C_Ang = 180
' offset del centro pezzo
Dim vtCurrOffset As New Vector3d(Map.refUnloadingAreaVM.OffsetPalletX, LocalPart.dOffestPartY, LocalPart.Height * (LocalPart.nLayer + 1))
Dim bRotate As Boolean = False
'If ItemBox.Id = 1 Or ItemBox.Id = 3 Or ItemBox.Id = 5 Then
' bRotate = True
'End If
' determino se la testa deve essere girata per eseguire il deposito del pezzo sulla rulliera
Dim PointPallet As Point3d = LocalPart.GetUnloadingPosBox(vtCurrOffset, bRotate)
WriteReal("X_Box", PointPallet.x)
WriteReal("Y_Box", PointPallet.y)
WriteReal("Z_Box", PointPallet.z)
PartWritePrivateProfilePoint(LocalPart.IdProject, ConstIni.S_PART & LocalPart.IdPart.ToString, "PointPallet", PointPallet)
' se il pallet è vicino all'uscita del magazzino
If bRotate Then
C_Ang = 0
End If
WriteReal("C_Box", C_Ang)
WriteReal("B_Box", B_Ang)
' eseguo la simulazione di scarico sul Pallet -> solo per la versione Debug
If Map.refMainWindowVM.MainWindowM.nProjInd = Map.refUnloadingAreaVM.IdProjTable2.nProjInd Then
SimulLoadingPallet(LocalPart, PointPallet, ItemBox.Id, CurrWarehouse.Id)
End If
Else
C_Ang = -90
B_Ang = -Map.refUnloadingAreaVM.AngRack
' ottengo il vettore Offset della ventosa rispetto al bordo ventosa a partire dal baricentro del pezzo (nel sistema Rack)
Dim vtCurrOffset As New Vector3d(ItemBox.GetRackOffsetX(ItemPart), ItemBox.GetRackOffsetY(ItemPart), ItemBox.GetRackOffsetZ(ItemPart))
Dim PointRacks As Point3d = LocalPart.GetUnloadingPosRack(vtCurrOffset)
WriteReal("X_Box", PointRacks.x)
WriteReal("Y_Box", PointRacks.y)
WriteReal("Z_Box", PointRacks.z)
PartWritePrivateProfilePoint(LocalPart.IdProject, ConstIni.S_PART & LocalPart.IdPart.ToString, "PointRack", PointRacks)
WriteReal("C_Box", C_Ang)
WriteReal("B_Box", B_Ang)
' eseguo la simulazione di deposito dei pezzi sul Rack (nel delle ventose)
If Map.refMainWindowVM.MainWindowM.nProjInd = Map.refUnloadingAreaVM.IdProjTable2.nProjInd Then
SimulUnloadingRack(LocalPart, PointRacks, ItemBox.Id, CurrWarehouse.Id)
End If
End If
' salvo le ventose che devono essere attivate
For IndexVacuum = 1 To 8
WriteInt("Tb2Vacuum" & IndexVacuum.ToString, LocalPart.GetVacuumLoadingStatus("V" & IndexVacuum.ToString, "Table2"))
Next
bFoundBox = True
WriteInt("StatusMachine2", CInt(StatusMachine.LOADED_POINT))
OutLogProcess("UnLoadTable2() -> Communico punto di prelievo pezzo: " & LocalPart.IdPart.ToString)
OutLogProcess("UnLoadTable2() -> Stato macchina 2: 1")
Exit For
End If
Next
If bFoundBox Then Exit For
Next
If Not bFoundBox Then
' verifico se manca la definizione del magazzino nel pezzo
If LocalPart.IdBox = -1 Then
Map.refUnloadingAreaVM.ClearOutputMessage()
Map.refUnloadingAreaVM.SetOutputMessage("Organize warehouse")
' libero i magazzini
Map.refUnloadingAreaVM.IdProjTable2.enStatus = StatusProj.LOADING
' forzo l'apertura dei magazzini
m_OpenWarehouse = True
Return Nothing
End If
End If
End If
Return LocalPart
End Function
' trasformo tutti i pezzi che devono essere depositati sui pallet (quelli sui rack rimangono sui rack) in pezzi manuali
Private Sub UnloadManualPart(CurrWarehouse As WarehouseVM)
If m_bErrorLoading Then Return
' recupero tutti i pezzi che sono ancora sulla rulliera e sul tavolo
Dim PartListRuller As New ObservableCollection(Of Part)
PartListRuller = Map.refUnloadingAreaVM.GetParts(Map.refUnloadingAreaVM.IdProjTable2.nProjInd, Place.ON_MOTOR_RULLER)
Dim PartListTable As New ObservableCollection(Of Part)
PartListTable = Map.refUnloadingAreaVM.GetParts(Map.refUnloadingAreaVM.IdProjTable2.nProjInd, Place.ON_TABLE)
' tutti i pezzi che rimangono sulla rulliera e su tavolo che devono essere pallettizzati
Dim nCounterPart As Integer = 0
For Each ItemPartRuller In PartListRuller
If ItemPartRuller.IdBox < 7 Then
ItemPartRuller.enUnloading = Unloading.MANUAL
For Each ItemBox In CurrWarehouse.Boxes
For Each ItemPart In ItemBox.MyListPart
If ItemPart.IdPart = ItemPartRuller.IdPart AndAlso ItemPart.IdProject = ItemPartRuller.IdProject Then
ItemBox.State = States.FULL
End If
Next
Next
nCounterPart = nCounterPart + 1
End If
Next
For Each ItemPartTable In PartListTable
If ItemPartTable.IdBox < 7 Then
ItemPartTable.enUnloading = Unloading.MANUAL
For Each ItemBox In CurrWarehouse.Boxes
For Each ItemPart In ItemBox.MyListPart
If ItemPart.IdPart = ItemPartTable.IdPart AndAlso ItemPart.IdProject = ItemPartTable.IdProject Then
ItemBox.State = States.FULL
End If
Next
Next
nCounterPart = nCounterPart + 1
End If
Next
' Comunico il messaggio a video
Map.refUnloadingAreaVM.SetOutputMessage("Machine-2 can't load parts: you have to manually unload " & nCounterPart.ToString & " parts.")
m_bErrorLoading = True
End Sub
' in caso di mancato prelievo di un pezzo dalla tavola 1 ricalcolo la disposizione dei pezzi (eventualmente su altri pallet)
Private Sub AdjustNesting1D(WastePart As Part)
' recupero l'eleco dei pezzi BUONI che stanno sulla tavola
Dim PartListTable As New ObservableCollection(Of Part)
PartListTable = Map.refUnloadingAreaVM.GetParts(WastePart.IdProject, Place.ON_TABLE)
' se non ci sno pezzi sulla tavola esco
If PartListTable.Count() < 1 Then
Return
End If
' box associato al pezzo
Dim CurrBox As Box = Nothing
' magazzino corrente
Dim CurrWarehouse As WarehouseVM = Map.refUnloadingAreaVM.GetCurrentWarehouse()
' se c'è un magazzino corrrente allora trovo il box corrente di scarico
If Not IsNothing(CurrWarehouse) Then
' recupero il Box associato al pezzo
CurrBox = Map.refUnloadingAreaVM.GetPartBox(WastePart, CurrWarehouse)
End If
' se il Box di deposito è un rack
If WastePart.IdBox > 6 And Not IsNothing(CurrBox) Then
' elimino il pezzo dall'elenco dei pezzi da depositare sul rack ed esco
CurrBox.MyListPart.Remove(WastePart)
Return
End If
' -------------------- COSTRUISCO LA PILA --------------------
' conto il numero di pezzi del Layer a cui appartiene il pezzo
Dim CounterPartLayer As Integer = 0
If Not IsNothing(CurrBox) Then
' conto il numero di pezzi presenti nel Layer
For Each ItemLayer In CurrBox.MyListPart
If ItemLayer.nLayer = WastePart.nLayer Then
CounterPartLayer = CounterPartLayer + 1
End If
Next
' se contiene un solo pezzo allora Shifto tutti i layer successivi del box in basso
If CounterPartLayer = 1 Then
For Each ItemLayer In CurrBox.MyListPart
If ItemLayer.nLayer > WastePart.nLayer Then
ItemLayer.nLayer = ItemLayer.nLayer - 1
End If
Next
CurrBox.MyListPart.Remove(WastePart)
Return
End If
Else
' conto il numero di pezzi presenti nel Layer
For Each ItemLayer In PartListTable
If ItemLayer.nLayer = WastePart.nLayer Then
CounterPartLayer = CounterPartLayer + 1
End If
Next
' se contiene un solo pezzo allora Shifto tutti i layer successivi del box in basso
If CounterPartLayer = 1 Then
For Each ItemLayer In PartListTable
ItemLayer.nLayer = ItemLayer.nLayer - 1
Next
Return
End If
End If
' ------------------------------------------------------------
' verifico se il pezzo rovinato è il primo del Layer (ricerco se ci sono altri pezzi sulla rulliera o nel Box)
Dim CounterPartInLayer As Integer = 1
Dim PrecLayer As New List(Of Part)
If Not IsNothing(CurrBox) Then
' cerco è già stato depositato sulla rulliera o sul box un pezzo dello stesso Layer
For Each ItemMyList In CurrBox.MyListPart
If (ItemMyList.enPlace = Place.ON_BOX Or ItemMyList.enPlace = Place.ON_MOTOR_RULLER) AndAlso ItemMyList.nLayer = WastePart.nLayer Then
CounterPartInLayer = CounterPartInLayer + 1
ElseIf (ItemMyList.enPlace = Place.ON_BOX Or ItemMyList.enPlace = Place.ON_MOTOR_RULLER) AndAlso ItemMyList.nLayer = WastePart.nLayer - 1 Then
PrecLayer.Add(ItemMyList)
End If
Next
Else
' se non esiste nessun box attivo allora cerco solo sulla rulliera
For Each ItemMyList In Map.refUnloadingAreaVM.GetParts(WastePart.IdProject, Place.ON_MOTOR_RULLER)
If ItemMyList.nLayer = WastePart.nLayer Then
CounterPartInLayer = CounterPartInLayer + 1
ElseIf ItemMyList.nLayer = WastePart.nLayer - 1 Then
PrecLayer.Add(ItemMyList)
End If
Next
End If
' lista dei pezzi presenti sull'ultimo Layer
Dim LastLayerList As New List(Of Part)
' liste dei pezzi della tavola divisi per dimensione
Dim PartListMax As New List(Of Part)
Dim PartListMedium As New List(Of Part)
Dim PartListMin As New List(Of Part)
' classifico i pezzi (medi e piccoli) ancora sul tavolo
For Each ItemPartTable In PartListTable
GetPartialList(ItemPartTable.MinRectX, PartListMax, PartListMedium, PartListMin).Add(ItemPartTable)
Next
Dim bFilled As Boolean = False
' rimuovo i pezzi che vanno su un altro Box e quelli dello stesso Layer solo se CounterPartLayer>1
If CounterPartInLayer = 1 Then
CamAuto.RemuovePartSameLayer(PartListMedium, WastePart, If(CounterPartInLayer = 1, False, True))
CamAuto.RemuovePartSameLayer(PartListMin, WastePart, If(CounterPartInLayer = 1, False, True))
Else
CamAuto.RemuovePartSameLayer(PartListMedium, WastePart, If(CounterPartInLayer = 1, False, True))
CamAuto.RemuovePartSameLayer(PartListMin, WastePart, If(CounterPartInLayer = 1, False, True))
' -------------------- SOSTITUISCO IL PEZZO ------------------
' cerco se esiste un pezzo che possa occupare il buco
For Each ItemMedium In PartListMedium
If Math.Abs(ItemMedium.MinRectY - WastePart.MinRectY) < EPS_SMALL Then
' allora questo pezzo può sostituire quello rovinato
ItemMedium.IdBox = WastePart.IdBox
ItemMedium.nLayer = WastePart.nLayer
ItemMedium.dOffestPartY = WastePart.dOffestPartY
PartListMedium.Remove(ItemMedium)
bFilled = True
Exit For
End If
Next
If Not bFilled Then
' cerco se esiste un pezzo che possa occupare il buco
For Each ItemMin In PartListMin
If Math.Abs(ItemMin.MinRectY - WastePart.MinRectY) < EPS_SMALL Then
' allora questo pezzo può sostituire quello rovinato
ItemMin.IdBox = WastePart.IdBox
ItemMin.nLayer = WastePart.nLayer
ItemMin.dOffestPartY = WastePart.dOffestPartY
PartListMin.Remove(ItemMin)
bFilled = True
Exit For
End If
Next
End If
If bFilled Then
' ricavo l'elenco dei pezzi del Layer precedente
If Not IsNothing(CurrBox) Then
' cerco è già stato depositato sulla rulliera o sul box un pezzo dello stesso Layer
For Each ItemMyList In CurrBox.MyListPart
If (ItemMyList.enPlace = Place.ON_BOX Or ItemMyList.enPlace = Place.ON_MOTOR_RULLER) AndAlso ItemMyList.nLayer = WastePart.nLayer Then
PrecLayer.Add(ItemMyList)
End If
Next
Else
' se non esiste nessun box attivo allora cerco solo sulla rulliera
For Each ItemMyList In Map.refUnloadingAreaVM.GetParts(WastePart.IdProject, Place.ON_MOTOR_RULLER)
If ItemMyList.nLayer = WastePart.nLayer Then
PrecLayer.Add(ItemMyList)
End If
Next
End If
End If
If bFilled Then
' rimuovo i pezzi che vanno su un altro Box e quelli dello stesso Layer solo se CounterPartLayer>1
CamAuto.RemuovePartSameLayer(PartListMedium, WastePart, True)
CamAuto.RemuovePartSameLayer(PartListMin, WastePart, True)
End If
End If
' ------------------------------------------------------------
' dimensione Y di depisoto disponibile sul pallet
Dim dDiffY As Double = Map.refUnloadingAreaVM.OffsetPalletY * 2
' se primo del Layer allora calcolo lo spazio disponibile sul layer precedente
If CounterPartInLayer = 1 Then
If PrecLayer.Count > 0 Then
Dim dStart As Double = PrecLayer(0).dOffestPartY - PrecLayer(0).MinRectY / 2
Dim dEnd As Double = PrecLayer(0).dOffestPartY - PrecLayer(0).MinRectY / 2
For Each ItemPrec In PrecLayer
If dStart > ItemPrec.dOffestPartY Then
dStart = ItemPrec.dOffestPartY - ItemPrec.MinRectY / 2
End If
If dEnd < ItemPrec.dOffestPartY Then
dEnd = ItemPrec.dOffestPartY + ItemPrec.MinRectY / 2
End If
Next
dDiffY = dEnd - dStart
End If
End If
If Map.refUnloadingAreaVM.OffsetPalletY * 2 - dDiffY - Map.refUnloadingAreaVM.MinTollerance * 2 > -EPS_SMALL Then
dDiffY = dDiffY + Map.refUnloadingAreaVM.MinTollerance * 2
End If
' ripulisco la lista del Box corrente da tutti i pezzi successivi
If Not IsNothing(CurrBox) Then
Dim IndexPartBox As Integer = 0
Dim RemoveList As New List(Of Part)
For IndexPartBox = 0 To CurrBox.MyListPart.Count - 1
If CounterPartInLayer = 1 Then
If CurrBox.MyListPart(IndexPartBox).nLayer >= WastePart.nLayer Then
RemoveList.Add(CurrBox.MyListPart(IndexPartBox))
CurrBox.MyListPart(IndexPartBox).IdBox = -1
End If
Else
If CurrBox.MyListPart(IndexPartBox).nLayer > WastePart.nLayer Then
RemoveList.Add(CurrBox.MyListPart(IndexPartBox))
CurrBox.MyListPart(IndexPartBox).IdBox = -1
End If
End If
Next
For Each ItemIndex In RemoveList
CurrBox.MyListPart.Remove(ItemIndex)
Next
CurrBox.MyListPart.Remove(WastePart)
End If
' -------------------- CALCOLO IL NESTING --------------------
EgtOutLog("Start Nesting")
Dim nCurrLayer As Integer = 0
' eseguo il Nesting1D dei pezzi correnti, costruisco l'elenco dei pezzi da depositare sui pallet
If PartListMedium.Count > 0 And Not MyNesting1D(PartListMedium, dDiffY, LastLayerList, nCurrLayer) Then
Map.refUnloadingAreaVM.ClearOutputMessage()
Map.refUnloadingAreaVM.SetOutputMessage("Impossible to repeat nesting part.")
' elimino le assegnazioni al box di tutti i pezzi che sono ancora sulla tavola
If Not IsNothing(CurrBox) Then
For Each ItemMyList In CurrBox.MyListPart
If ItemMyList.enPlace = Place.ON_TABLE Then
ItemMyList.IdBox = -1
End If
Next
End If
Return
End If
' recupero l'indice dell'ultimo Layer calcolato
If LastLayerList.Count > 0 Then nCurrLayer = LastLayerList(0).nLayer
' eseguo il nesting tra due liste
If PartListMedium.Count > 0 And JoinNesting1D(PartListMedium, PartListMin, LastLayerList, dDiffY, nCurrLayer) Then
nCurrLayer = nCurrLayer + 1
End If
' eseguo il nesting dei pezzi rimanenti
If PartListMin.Count > 0 And Not MyNesting1D(PartListMin, dDiffY, LastLayerList, nCurrLayer) Then
Map.refUnloadingAreaVM.ClearOutputMessage()
Map.refUnloadingAreaVM.SetOutputMessage("Impossible to repeat nesting part.")
' elimino le assegnazioni al box di tutti i pezzi che sono ancora sulla tavola
If Not IsNothing(CurrBox) Then
For Each ItemMyList In CurrBox.MyListPart
If ItemMyList.enPlace = Place.ON_TABLE Then
ItemMyList.IdBox = -1
End If
Next
End If
Return
End If
' comunico che il processo di Nesting è terminato
EgtOutLog("End Nesting")
' ------------------------------------------------------------
' lista dei pezzi ceh devono essere riposizionati sullo stesso Pallet
Dim ActualListPart As New List(Of Part)
' -------------------- RIORDINO LA LISTA --------------------
' riordino l'elenco dei pezzi (dal Primo Layer all'ultimo Layer)
Dim StartLayer As Integer = 0
Dim bLayerExist As Boolean = True
' se trovo un pezzo che appartiene al layer allora rimango nel ciclo
While bLayerExist
bLayerExist = False
' ricerco tutti i pezzi che appartengono allo stesso layer
For Each ItemPart In PartListMedium
If ItemPart.nLayer = StartLayer Then
ActualListPart.Add(ItemPart)
Dim IndexPart As Integer = 0
' rimuovo il pezzi appena ricalcolato dall'elenco dei pezzi
For IndexPart = 0 To Map.refUnloadingAreaVM.ListPart.Count - 1
If Map.refUnloadingAreaVM.ListPart(IndexPart).IdPart = ItemPart.IdPart AndAlso
Map.refUnloadingAreaVM.ListPart(IndexPart).IdProject = ItemPart.IdProject AndAlso
Map.refUnloadingAreaVM.ListPart(IndexPart).enPlace = Place.ON_TABLE Then
Map.refUnloadingAreaVM.ListPart.RemoveAt(IndexPart)
Exit For
End If
Next
bLayerExist = True
End If
Next
' passo al Layer successivo
StartLayer = StartLayer + 1
End While
bLayerExist = True
StartLayer = StartLayer - 1
While bLayerExist
bLayerExist = False
' ricerco tutti i pezzi che appartengono allo stesso layer
For Each ItemPart In PartListMin
If ItemPart.nLayer = StartLayer Then
ActualListPart.Add(ItemPart)
For IndexPart = 0 To Map.refUnloadingAreaVM.ListPart.Count - 1
' rimuovo i pezzi appena ricalcolati dall'elenco dei pezzi
If Map.refUnloadingAreaVM.ListPart(IndexPart).IdPart = ItemPart.IdPart AndAlso
Map.refUnloadingAreaVM.ListPart(IndexPart).IdProject = ItemPart.IdProject AndAlso
Map.refUnloadingAreaVM.ListPart(IndexPart).enPlace = Place.ON_TABLE Then
Map.refUnloadingAreaVM.ListPart.RemoveAt(IndexPart)
Exit For
End If
Next
bLayerExist = True
End If
Next
' passo al Layer successivo
StartLayer = StartLayer + 1
End While
' ------------------------------------------------------------
' cancello il file PartList.ini e lo riscrivo completamente
Dim nIdProj As Integer = Map.refUnloadingAreaVM.IdProjTable2.nProjInd
Dim sFile As String = Map.refMainWindowVM.MainWindowM.sTempDir & "\PartList" & Map.refUnloadingAreaVM.IdProjTable2.nProjInd.ToString & ".ini"
If My.Computer.FileSystem.FileExists(sFile) Then
My.Computer.FileSystem.DeleteFile(sFile)
OutLogProcess("AdjustNesting1D-> Riscrivo l'elenco di prelievo dei pezzi" & sFile)
End If
' -------------------- DEFINIZIONE DEI BOX ------------------
Dim NewBox As Box = Nothing
' se primo pezzo di un Layer allora non devo cambiare Pallet
If CounterPartInLayer = 1 Then
For Each ItemActual In ActualListPart
' assegno il Layer
ItemActual.nLayer = ItemActual.nLayer + WastePart.nLayer
If Not IsNothing(CurrBox) Then
' se esiste un Box allora assegno l'indirizzo del Box
NewBox = CurrBox
ItemActual.IdBox = CurrBox.Id
End If
Next
ElseIf bFilled Then
For Each ItemActual In ActualListPart
' assegno il Layer
ItemActual.nLayer = ItemActual.nLayer + WastePart.nLayer + 1
If Not IsNothing(CurrBox) Then
' se esiste un Box allora assegno l'indirizzo del Box
NewBox = CurrBox
ItemActual.IdBox = CurrBox.Id
End If
Next
Else
' cerco il primo pallet disponibile
Dim IdBoxAvailable As Integer = -1
If Not IsNothing(CurrWarehouse) Then
For Each ItemGridBox In CurrWarehouse.GridBoxList
For Each ItemBox In ItemGridBox.CurrBoxList
If ItemBox.State = States.AVAILABLE AndAlso ItemBox.MyListPart.Count = 0 Then
If ItemGridBox.IsPallet Then
IdBoxAvailable = ItemBox.Id
NewBox = ItemBox
Exit For
End If
End If
Next
' se ho trovato un box disponibile
If IdBoxAvailable <> -1 Then Exit For
Next
End If
End If
' ------------------------------------------------------------
' ricavo l'indice da cui iniziare ad inserire i pezzi da depositare
Dim IndexMaualPart As Integer = 0
For IndexMaualPart = 0 To Map.refUnloadingAreaVM.ListPart.Count - 1
If Map.refUnloadingAreaVM.ListPart(IndexMaualPart).IdProject = WastePart.IdProject And
Map.refUnloadingAreaVM.ListPart(IndexMaualPart).enUnloading = Unloading.MANUAL And
Map.refUnloadingAreaVM.ListPart(IndexMaualPart).enPlace = Place.ON_TABLE Then
Exit For
End If
Next
Dim IndexRack As Integer = 0
If PartListMax.Count > 0 Then
For IndexRack = 0 To Map.refUnloadingAreaVM.ListPart.Count - 1
If Map.refUnloadingAreaVM.ListPart(IndexRack).IdProject = WastePart.IdProject And
Map.refUnloadingAreaVM.ListPart(IndexRack).IdPart = PartListMax(0).IdPart And
Map.refUnloadingAreaVM.ListPart(IndexRack).enPlace = Place.ON_TABLE Then
IndexMaualPart = IndexRack
Exit For
End If
Next
End If
' reinserisco i pezzi nella lista
For Each ActualItemPart In ActualListPart
' verifico che il pezzo non esiste già nella lista
For Each ItemPart In Map.refUnloadingAreaVM.ListPart
If ItemPart.IdProject = WastePart.IdProject AndAlso Not ItemPart.IdPart = ActualItemPart.IdPart Then
Map.refUnloadingAreaVM.ListPart.Insert(IndexMaualPart, ActualItemPart)
Exit For
End If
Next
IndexMaualPart = IndexMaualPart + 1
' modifico il colore dei pezzi che sono stati ricalcolati
Dim nIdCurrRegion As Integer = GeomCalc.GetRegionFromPart(ActualItemPart.IdPart)
If nIdCurrRegion > 0 Then
EgtSetColor(nIdCurrRegion, New Color3d(0, 200, 200, 80))
EgtDraw()
End If
If Not IsNothing(NewBox) Then
' se ho trovato un Box su cui scaricare
NewBox.MyListPart.Add(ActualItemPart)
ActualItemPart.IdBox = NewBox.Id
ElseIf IsNothing(NewBox) And (CounterPartInLayer = 1 Or bFilled) Then
' se posso continuare a scaricare nei Layer successivi (senza aver definito la disponibilità dei magazzini)
If nIdCurrRegion > 0 Then
EgtSetColor(nIdCurrRegion, New Color3d(0, 85, 170, 80))
EgtDraw()
End If
ElseIf IsNothing(NewBox) And (CounterPartInLayer <> 1 Or Not bFilled) Then
' se devo cambiare Box (prima di aver definito il magazzino)
ActualItemPart.IdBox = -1
If nIdCurrRegion > 0 Then
EgtSetColor(nIdCurrRegion, New Color3d(0, 150, 250, 80))
EgtDraw()
End If
End If
Next
' salvo tutto nel file PartList.ini
Dim nListCount As Integer = 0
Dim LastIndex As Integer = 0
For LastIndex = 0 To Map.refUnloadingAreaVM.ListPart.Count - 1
If Map.refUnloadingAreaVM.ListPart(LastIndex).IdProject = nIdProj Then
nListCount = nListCount + 1
Map.refUnloadingAreaVM.ListPart(LastIndex).SavePart(Map.refUnloadingAreaVM.ListPart(LastIndex).IdPart)
Map.refUnloadingAreaVM.ListPart(LastIndex).IdBox = Map.refUnloadingAreaVM.ListPart(LastIndex).IdBox
Map.refUnloadingAreaVM.ListPart(LastIndex).dOffestPartY = Map.refUnloadingAreaVM.ListPart(LastIndex).dOffestPartY
If LastIndex > 0 Then
Map.refUnloadingAreaVM.ListPart(LastIndex - 1).SetIsLast(False)
End If
Map.refUnloadingAreaVM.ListPart(LastIndex).SetIsLast(True)
PartWritePrivateProfileString(Map.refUnloadingAreaVM.ListPart(LastIndex).IdProject, "PartList", "IdPart" & nListCount.ToString, Map.refUnloadingAreaVM.ListPart(LastIndex).IdPart.ToString)
End If
Next
End Sub
' in caso di mancato prelievo dei pezzi dalla tavola 2 ricalcolo la disposizione dei pezzi (eventualmente su altri pallet)
Private Sub AdjustNesting1DTab2(WastePart As Part)
' recupero l'eleco dei pezzi BUONI che stanno sulla tavola (per il calcolo degli indici per il reinserimento dei pezzinella lista)
Dim PartListTable As New ObservableCollection(Of Part)
PartListTable = Map.refUnloadingAreaVM.GetParts(WastePart.IdProject, Place.ON_TABLE)
'Dim PartListRuller As New ObservableCollection(Of Part)
'PartListRuller = Map.refUnloadingAreaVM.GetParts(WastePart.IdProject, Place.ON_MOTOR_RULLER)
'' se non ci sno pezzi sulla tavola esco
'If PartListTable.Count() + PartListRuller.Count() < 1 Then
' Return
'End If
' box associato al pezzo
Dim CurrBox As Box = Nothing
' magazzino corrente
Dim CurrWarehouse As WarehouseVM = Map.refUnloadingAreaVM.GetCurrentWarehouse()
' se c'è un magazzino corrrente allora trovo il box corrente di scarico
If Not IsNothing(CurrWarehouse) Then
' recupero il Box associato al pezzo
CurrBox = Map.refUnloadingAreaVM.GetPartBox(WastePart, CurrWarehouse)
Else
' se non esiste un magazzino associato come faccio a scaricare?
Return
End If
' se il Box di deposito è un rack
If WastePart.IdBox > 6 And Not IsNothing(CurrBox) Then
' elimino il pezzo dall'elenco dei pezzi da depositare sul rack ed esco
CurrBox.MyListPart.Remove(WastePart)
Return
End If
' -------------------- COSTRUISCO LA PILA --------------------
' conto il numero di pezzi del Layer a cui appartiene il pezzo
Dim CounterPartLayer As Integer = 0
If Not IsNothing(CurrBox) Then
' conto il numero di pezzi presenti nel Layer
For Each ItemLayer In CurrBox.MyListPart
If ItemLayer.nLayer = WastePart.nLayer Then
CounterPartLayer = CounterPartLayer + 1
End If
Next
' se contiene un solo pezzo allora Shifto tutti i layer successivi del box in basso
If CounterPartLayer = 1 Then
For Each ItemLayer In CurrBox.MyListPart
If ItemLayer.nLayer > WastePart.nLayer Then
ItemLayer.nLayer = ItemLayer.nLayer - 1
End If
Next
CurrBox.MyListPart.Remove(WastePart)
Return
End If
'Else
' ' conto il numero di pezzi presenti nel Layer
' For Each ItemLayer In PartListTable
' If ItemLayer.nLayer = WastePart.nLayer Then
' CounterPartLayer = CounterPartLayer + 1
' End If
' Next
' ' se contiene un solo pezzo allora Shifto tutti i layer successivi del box in basso
' If CounterPartLayer = 1 Then
' For Each ItemLayer In PartListTable
' ItemLayer.nLayer = ItemLayer.nLayer - 1
' Next
' Return
' End If
End If
' ------------------------------------------------------------
'' verifico se il pezzo rovinato è il primo del Layer (ricerco se ci sono altri pezzi sulla rulliera o nel Box)
'Dim CounterPartInLayer As Integer = 1
'Dim PrecLayer As New List(Of Part)
'If Not IsNothing(CurrBox) Then
' ' cerco è già stato depositato sulla rulliera o sul box un pezzo dello stesso Layer
' For Each ItemMyList In CurrBox.MyListPart
' If (ItemMyList.enPlace = Place.ON_BOX Or ItemMyList.enPlace = Place.ON_MOTOR_RULLER) AndAlso ItemMyList.nLayer = WastePart.nLayer Then
' CounterPartInLayer = CounterPartInLayer + 1
' ElseIf (ItemMyList.enPlace = Place.ON_BOX Or ItemMyList.enPlace = Place.ON_MOTOR_RULLER) AndAlso ItemMyList.nLayer = WastePart.nLayer - 1 Then
' PrecLayer.Add(ItemMyList)
' End If
' Next
'Else
' ' se non esiste nessun box attivo allora cerco solo sulla rulliera
' For Each ItemMyList In Map.refUnloadingAreaVM.GetParts(WastePart.IdProject, Place.ON_MOTOR_RULLER)
' If ItemMyList.nLayer = WastePart.nLayer Then
' CounterPartInLayer = CounterPartInLayer + 1
' ElseIf ItemMyList.nLayer = WastePart.nLayer - 1 Then
' PrecLayer.Add(ItemMyList)
' End If
' Next
'End If
'' se non è il prim del Layer cerco un pezzo Uguale che possa sostituirlo
' dimensione Y di depisoto disponibile sul pallet
'Dim dDiffY As Double = Map.refUnloadingAreaVM.OffsetPalletY * 2
'' se primo del Layer allora calcolo lo spazio disponibile sul layer precedente
'If CounterPartInLayer = 1 Then
' If PrecLayer.Count > 0 Then
' Dim dStart As Double = PrecLayer(0).dOffestPartY - PrecLayer(0).MinRectY / 2
' Dim dEnd As Double = PrecLayer(0).dOffestPartY - PrecLayer(0).MinRectY / 2
' For Each ItemPrec In PrecLayer
' If dStart > ItemPrec.dOffestPartY Then
' dStart = ItemPrec.dOffestPartY - ItemPrec.MinRectY / 2
' End If
' If dEnd < ItemPrec.dOffestPartY Then
' dEnd = ItemPrec.dOffestPartY + ItemPrec.MinRectY / 2
' End If
' Next
' dDiffY = dEnd - dStart
' End If
'End If
'' lista dei pezzi presenti sull'ultimo Layer
'Dim LastLayerList As New List(Of Part)
' liste dei pezzi della tavola divisi per dimensione
Dim PartListMax As New List(Of Part)
Dim PartListMedium As New List(Of Part)
Dim PartListMin As New List(Of Part)
' classifico i pezzi (medi e piccoli) ancora sul tavolo
For Each ItemPartTable In PartListTable
GetPartialList(ItemPartTable.MinRectX, PartListMax, PartListMedium, PartListMin).Add(ItemPartTable)
Next
'' rimuovo i pezzi che vanno su un altro Box e quelli dello stesso Layer solo se CounterPartLayer>1
'CamAuto.RemuovePartSameLayer(PartListMedium, WastePart, False)
'CamAuto.RemuovePartSameLayer(PartListMin, WastePart, False)
' lista dei pezzi da depositare su un nuovo pallet
Dim NewListPallet As New List(Of Part)
' ripulisco la lista del Box corrente da tutti i pezzi successivi (che andranno su un altro pallet) e anche dalla lista
If Not IsNothing(CurrBox) Then
Dim IndexPartBox As Integer = 0
Dim RemoveList As New List(Of Part)
For IndexPartBox = 0 To CurrBox.MyListPart.Count - 1
If CurrBox.MyListPart(IndexPartBox).nLayer > WastePart.nLayer Then
RemoveList.Add(CurrBox.MyListPart(IndexPartBox))
NewListPallet.Add(CurrBox.MyListPart(IndexPartBox))
CurrBox.MyListPart(IndexPartBox).IdBox = -1
CurrBox.MyListPart(IndexPartBox).nLayer = CurrBox.MyListPart(IndexPartBox).nLayer - WastePart.nLayer - 1
'' rimuovo i pezzi appena ricalcolati dall'elenco dei pezzi
'For IndexPart = 0 To Map.refUnloadingAreaVM.ListPart.Count - 1
' If Map.refUnloadingAreaVM.ListPart(IndexPart).IdPart = CurrBox.MyListPart(IndexPartBox).IdPart AndAlso
' Map.refUnloadingAreaVM.ListPart(IndexPart).IdProject = CurrBox.MyListPart(IndexPartBox).IdProject AndAlso
' Map.refUnloadingAreaVM.ListPart(IndexPart).enPlace = Place.ON_TABLE Then
' Map.refUnloadingAreaVM.ListPart.RemoveAt(IndexPart)
' Exit For
' End If
'Next
End If
Next
For Each ItemIndex In RemoveList
CurrBox.MyListPart.Remove(ItemIndex)
Next
CurrBox.MyListPart.Remove(WastePart)
End If
'' -------------------- CALCOLO IL NESTING --------------------
'EgtOutLog("Start Nesting")
'Dim nCurrLayer As Integer = 0
'' eseguo il Nesting1D dei pezzi correnti, costruisco l'elenco dei pezzi da depositare sui pallet
'If PartListMedium.Count > 0 And Not MyNesting1D(PartListMedium, dDiffY, LastLayerList, nCurrLayer) Then
' Map.refUnloadingAreaVM.ClearOutputMessage()
' Map.refUnloadingAreaVM.SetOutputMessage("Impossible to repeat nesting part.")
' ' elimino le assegnazioni al box di tutti i pezzi che sono ancora sulla tavola
' If Not IsNothing(CurrBox) Then
' For Each ItemMyList In CurrBox.MyListPart
' If ItemMyList.enPlace = Place.ON_TABLE Then
' ItemMyList.IdBox = -1
' End If
' Next
' End If
' Return
'End If
'' recupero l'indice dell'ultimo Layer calcolato
'If LastLayerList.Count > 0 Then nCurrLayer = LastLayerList(0).nLayer
'' eseguo il nesting tra due liste
'If PartListMedium.Count > 0 And JoinNesting1D(PartListMedium, PartListMin, LastLayerList, dDiffY, nCurrLayer) Then
' nCurrLayer = nCurrLayer + 1
'End If
'' eseguo il nesting dei pezzi rimanenti
'If PartListMin.Count > 0 And Not MyNesting1D(PartListMin, dDiffY, LastLayerList, nCurrLayer) Then
' Map.refUnloadingAreaVM.ClearOutputMessage()
' Map.refUnloadingAreaVM.SetOutputMessage("Impossible to repeat nesting part.")
' ' elimino le assegnazioni al box di tutti i pezzi che sono ancora sulla tavola
' If Not IsNothing(CurrBox) Then
' For Each ItemMyList In CurrBox.MyListPart
' If ItemMyList.enPlace = Place.ON_TABLE Then
' ItemMyList.IdBox = -1
' End If
' Next
' End If
' Return
'End If
'' comunico che il processo di Nesting è terminato
'EgtOutLog("End Nesting")
'' ------------------------------------------------------------
'' lista dei pezzi ceh devono essere riposizionati sullo stesso Pallet
'Dim ActualListPart As New List(Of Part)
'' -------------------- RIORDINO LA LISTA --------------------
'' riordino l'elenco dei pezzi (dal Primo Layer all'ultimo Layer)
'Dim StartLayer As Integer = 0
'Dim bLayerExist As Boolean = True
'' se trovo un pezzo che appartiene al layer allora rimango nel ciclo
'While bLayerExist
' bLayerExist = False
' ' ricerco tutti i pezzi che appartengono allo stesso layer
' For Each ItemPart In PartListMedium
' If ItemPart.nLayer = StartLayer Then
' ActualListPart.Add(ItemPart)
' Dim IndexPart As Integer = 0
' ' rimuovo il pezzi appena ricalcolato dall'elenco dei pezzi
' For IndexPart = 0 To Map.refUnloadingAreaVM.ListPart.Count - 1
' If Map.refUnloadingAreaVM.ListPart(IndexPart).IdPart = ItemPart.IdPart Then
' Map.refUnloadingAreaVM.ListPart.RemoveAt(IndexPart)
' Exit For
' End If
' Next
' bLayerExist = True
' End If
' Next
' ' passo al Layer successivo
' StartLayer = StartLayer + 1
'End While
'bLayerExist = True
'StartLayer = StartLayer - 1
'While bLayerExist
' bLayerExist = False
' ' ricerco tutti i pezzi che appartengono allo stesso layer
' For Each ItemPart In PartListMin
' If ItemPart.nLayer = StartLayer Then
' ActualListPart.Add(ItemPart)
' For IndexPart = 0 To Map.refUnloadingAreaVM.ListPart.Count - 1
' ' rimuovo i pezzi appena ricalcolati dall'elenco dei pezzi
' If Map.refUnloadingAreaVM.ListPart(IndexPart).IdPart = ItemPart.IdPart Then
' Map.refUnloadingAreaVM.ListPart.RemoveAt(IndexPart)
' Exit For
' End If
' Next
' bLayerExist = True
' End If
' Next
' ' passo al Layer successivo
' StartLayer = StartLayer + 1
'End While
'' ------------------------------------------------------------
'' cancello il file PartList.ini e lo riscrivo completamente
'Dim nIdProj As Integer = Map.refUnloadingAreaVM.IdProjTable2.nProjInd
'Dim sFile As String = Map.refMainWindowVM.MainWindowM.sTempDir & "\PartList" & Map.refUnloadingAreaVM.IdProjTable2.nProjInd.ToString & ".ini"
'If My.Computer.FileSystem.FileExists(sFile) Then
' My.Computer.FileSystem.DeleteFile(sFile)
' OutLogProcess("AdjustNestingTab21D-> Riscrivo l'elenco di prelievo dei pezzi" & sFile)
'End If
' -------------------- DEFINIZIONE DEI BOX ------------------
Dim NewBox As Box = Nothing
Dim IdBoxAvailable As Integer = -1
If Not IsNothing(CurrWarehouse) Then
For Each ItemGridBox In CurrWarehouse.GridBoxList
For Each ItemBox In ItemGridBox.CurrBoxList
If ItemBox.State = States.AVAILABLE AndAlso ItemBox.MyListPart.Count = 0 Then
If ItemGridBox.IsPallet Then
IdBoxAvailable = ItemBox.Id
NewBox = ItemBox
Exit For
End If
End If
Next
' se ho trovato un box disponibile
If IdBoxAvailable <> -1 Then Exit For
Next
End If
' ------------------------------------------------------------
'' ricavo l'indice da cui iniziare ad inserire i pezzi da depositare
'Dim IndexMaualPart As Integer = 0
'For IndexMaualPart = 0 To Map.refUnloadingAreaVM.ListPart.Count - 1
' If Map.refUnloadingAreaVM.ListPart(IndexMaualPart).IdProject = WastePart.IdProject And
' Map.refUnloadingAreaVM.ListPart(IndexMaualPart).enUnloading = Unloading.MANUAL And
' Map.refUnloadingAreaVM.ListPart(IndexMaualPart).enPlace = Place.ON_TABLE Then
' Exit For
' End If
'Next
'Dim IndexRack As Integer = 0
'If PartListMax.Count > 0 Then
' For IndexRack = 0 To Map.refUnloadingAreaVM.ListPart.Count - 1
' If Map.refUnloadingAreaVM.ListPart(IndexRack).IdProject = WastePart.IdProject And
' Map.refUnloadingAreaVM.ListPart(IndexRack).IdPart = PartListMax(0).IdPart And
' Map.refUnloadingAreaVM.ListPart(IndexRack).enPlace = Place.ON_TABLE Then
' IndexMaualPart = IndexRack
' Exit For
' End If
' Next
'End If
' reinserisco i pezzi nella lista
For Each ActualItemPart In NewListPallet
'' verifico che il pezzo non esiste già nella lista
'For Each ItemPart In Map.refUnloadingAreaVM.ListPart
' If ItemPart.IdProject = WastePart.IdProject AndAlso Not ItemPart.IdPart = ActualItemPart.IdPart Then
' Map.refUnloadingAreaVM.ListPart.Insert(IndexMaualPart, ActualItemPart)
' Exit For
' End If
'Next
'IndexMaualPart = IndexMaualPart + 1
' modifico il colore dei pezzi che sono stati ricalcolati
Dim nIdCurrRegion As Integer = GeomCalc.GetRegionFromPart(ActualItemPart.IdPart)
If nIdCurrRegion > 0 Then
EgtSetColor(nIdCurrRegion, New Color3d(0, 200, 200, 80))
EgtDraw()
End If
If Not IsNothing(NewBox) Then
' se ho trovato un Box su cui scaricare
NewBox.MyListPart.Add(ActualItemPart)
ActualItemPart.IdBox = NewBox.Id
ElseIf IsNothing(NewBox) Then
' se devo cambiare Box (prima di aver definito il magazzino)
ActualItemPart.IdBox = -1
If nIdCurrRegion > 0 Then
EgtSetColor(nIdCurrRegion, New Color3d(0, 150, 250, 80))
EgtDraw()
End If
End If
Next
' salvo tutto nel file PartList.ini
Dim nListCount As Integer = 0
Dim LastIndex As Integer = 0
For LastIndex = 0 To Map.refUnloadingAreaVM.ListPart.Count - 1
If Map.refUnloadingAreaVM.ListPart(LastIndex).IdProject = WastePart.IdProject Then
nListCount = nListCount + 1
Map.refUnloadingAreaVM.ListPart(LastIndex).SavePart(Map.refUnloadingAreaVM.ListPart(LastIndex).IdPart)
Map.refUnloadingAreaVM.ListPart(LastIndex).IdBox = Map.refUnloadingAreaVM.ListPart(LastIndex).IdBox
Map.refUnloadingAreaVM.ListPart(LastIndex).dOffestPartY = Map.refUnloadingAreaVM.ListPart(LastIndex).dOffestPartY
If LastIndex > 0 Then
Map.refUnloadingAreaVM.ListPart(LastIndex - 1).SetIsLast(False)
End If
Map.refUnloadingAreaVM.ListPart(LastIndex).SetIsLast(True)
PartWritePrivateProfileString(Map.refUnloadingAreaVM.ListPart(LastIndex).IdProject, "PartList", "IdPart" & nListCount.ToString, Map.refUnloadingAreaVM.ListPart(LastIndex).IdPart.ToString)
End If
Next
End Sub
' simulazione di carico dalla rulliera tavola 2
Private Sub SimulLouadingTab2(LocalPart As Part, PosRuller As Point3d)
EgtSetStatus(LocalPart.IdPart, GDB_ST.ON_)
' ricavo la regione del pezzo
Dim nIdRegion As Integer = GeomCalc.GetRegionFromPart(LocalPart.IdPart)
If nIdRegion > 0 Then
EgtSetColor(nIdRegion, New Color3d(0, 0, 255, 80))
End If
Dim ptPartCen As Point3d
EgtCentroid(nIdRegion, GDB_ID.ROOT, ptPartCen)
Dim vtRuller As Vector3d = New Vector3d(4081.61, 3740.55, 23.08)
Dim ptLocal As Point3d = New Point3d(vtRuller.x - 4000 + LocalPart.MoveTable2.m_vtRect.x, vtRuller.y - LocalPart.MoveTable2.m_vtRect.y, vtRuller.z)
Dim vtMove As Vector3d = (ptLocal - Point3d.ORIG) + (LocalPart.ptTable1 - Point3d.ORIG) - (ptPartCen - Point3d.ORIG)
EgtMove(LocalPart.IdPart, vtMove, GDB_RT.GLOB)
' simulo la posizione di prelievo dalla rulliera
If Connection_State = Connection_States.DEBUG Then
EgtSetMachineLook(MCH_LOOK.TAB_HEAD)
EgtSetAxisPos("X1", PosRuller.x + vtRuller.x - 4000 + LocalPart.ptTable1.x)
EgtSetAxisPos("Y", PosRuller.y + vtRuller.y + LocalPart.ptTable1.y)
EgtSetAxisPos("Z1", PosRuller.z + vtRuller.z + LocalPart.ptTable1.z)
EgtSetAxisPos("W1", 180)
End If
EgtDraw()
End Sub
' simulazione di scarico su Pallet
Private Sub SimulLoadingPallet(LocalPart As Part, PointPallet As Point3d, IndexPallet As Integer, IdWarehouse As Integer)
EgtSetStatus(LocalPart.IdPart, GDB_ST.ON_)
Dim nIdRegion As Integer = GeomCalc.GetRegionFromPart(LocalPart.IdPart)
If nIdRegion > 0 Then
EgtSetColor(nIdRegion, New Color3d(200, 150, 0 + LocalPart.nLayer * 40, 80))
End If
Dim ptPartCen As Point3d
EgtCentroid(nIdRegion, GDB_ID.ROOT, ptPartCen)
Dim vtBox1B As Vector3d = New Vector3d(-7585, 1450, -520)
Dim Offset_x As Double = 1570
Dim Offset_y As Double = 0
Dim Offset_z As Double = 0
If IdWarehouse = 1 Then
Offset_y = -3653
End If
vtBox1B.y = vtBox1B.y + Offset_y
If IndexPallet = 2 Or IndexPallet = 4 Or IndexPallet = 6 Then
vtBox1B.y = -1450 + vtBox1B.y + Offset_y
End If
If IndexPallet = 3 Or IndexPallet = 4 Then
vtBox1B.x = Offset_x + vtBox1B.x
ElseIf IndexPallet = 5 Or IndexPallet = 6 Then
vtBox1B.x = Offset_x * 2 + 1200 + vtBox1B.x
End If
Dim ptLocal As Point3d = New Point3d(ptPartCen.x - LocalPart.MoveTable2.m_vtRect.x, ptPartCen.y - LocalPart.MoveTable2.m_vtRect.y, ptPartCen.z)
Dim ptBox As Point3d = New Point3d(LocalPart.ptTable1.x + vtBox1B.x, LocalPart.ptTable1.y + vtBox1B.y, LocalPart.ptTable1.z + vtBox1B.z)
Dim vtMove As Vector3d = (ptBox - Point3d.ORIG) - (ptLocal - Point3d.ORIG)
Dim vtCurrOffset As Vector3d = PointPallet - Point3d.ORIG - LocalPart.MoveTable2.m_vtDelta
EgtMove(LocalPart.IdPart, vtMove + vtCurrOffset - LocalPart.MoveTable2.m_vtRect, GDB_RT.GLOB)
'EgtZoom(ZM.ALL)
EgtDraw()
End Sub
Private Sub SimulUnloadingRack(LocalPart As Part, PointRacks As Point3d, IndexRack As Integer, IdWarehouse As Integer)
' eseguo un a simulazione di deposito del pezzo (non delle ventose)
EgtSetStatus(LocalPart.IdPart, GDB_ST.ON_)
Dim nIdRegion As Integer = GeomCalc.GetRegionFromPart(LocalPart.IdPart)
If nIdRegion > 0 Then
EgtSetColor(nIdRegion, New Color3d(100, 150, 0 + LocalPart.nLayer * 40, 80))
End If
Dim ptPartCen As Point3d
EgtCentroid(nIdRegion, GDB_ID.ROOT, ptPartCen)
' ruoto il pezzo do 90
EgtRotate(LocalPart.IdPart, ptPartCen, Vector3d.Z_AX, 90, GDB_RT.GLOB)
' punto di riferimento per il deposito (eseguo i conti considerando la rotazione del pezzo)
Dim ptLocal As Point3d = New Point3d(ptPartCen.x + LocalPart.MinRectY / 2, ptPartCen.y, 0)
' ruoto il pezzo di -70
EgtRotate(LocalPart.IdPart, ptLocal, Vector3d.Y_AX, Map.refUnloadingAreaVM.AngRack, GDB_RT.GLOB)
' deterino la posizione di riferimento del Rack
Dim vtBox1B As Vector3d = New Vector3d(-7085, 1225, -520)
Dim Offset_x As Double = 1570
Dim Offset_y As Double = 0
Dim Offset_z As Double = 0
If IdWarehouse = 1 Then
Offset_y = -3653
End If
Offset_x = 1570 * (IndexRack - 7)
Dim ptBox As Point3d = New Point3d(LocalPart.ptTable1.x + vtBox1B.x + Offset_x, LocalPart.ptTable1.y + vtBox1B.y + Offset_y, LocalPart.ptTable1.z + vtBox1B.z)
' muovo il pezzo nel punto indicato
Dim vtMove As Vector3d = (ptBox - Point3d.ORIG) - (ptLocal - Point3d.ORIG)
Dim vtOffset As Vector3d = PointRacks - Point3d.ORIG
vtOffset.y = 0
vtOffset.z = 0
EgtMove(LocalPart.IdPart, vtMove + vtOffset, GDB_RT.GLOB)
'EgtZoom(ZM.ALL)
EgtDraw()
End Sub
#End Region ' Methos
#Region "LETTURA SCRITTURA Siemens"
' definito il nome della variabile recupero l'inidirzzo variabile PLC e restituisco il valore letto da PLC
Friend Function ReadInt(sVarName As String, ByRef nValue As Integer) As Boolean
Dim bok As Boolean = True
Dim sVar As String = String.Empty
' leggo da file OmagVIEWPlus l'indirizzo della variabile associata
If GetMainPrivateProfileString(S_VARIABLES, sVarName, "", sVar) > 0 Then
' Spezzatura nei componenti: sVar -> ActiveStorage=81,0,2
Dim sVarSplit() As String = sVar.Split(","c)
If sVarSplit.Length = 3 Then
' elimino spazi
For Each Var In sVarSplit
Var = Var.Trim
Next
Dim nType As Integer = 0
Dim Type As Types = 0
' l'ulitmo codice identifica il tipo di variabile
Integer.TryParse(sVarSplit(2), nType)
If nType >= 0 AndAlso nType <= 7 Then Type = DirectCast(nType, Types)
' se il tipo è intero
If Type = 2 Then
Dim DbNumber As Integer = 0
Dim Start As Integer = 0
Integer.TryParse(sVarSplit(0), DbNumber)
Integer.TryParse(sVarSplit(1), Start)
' leggo dalla macchina (file NC_Debug.ini) il valore della variabile associata
If m_NC.ReadInt(DbNumber, Start, nValue) Then
' scrivo in backup
Dim sBackupFolder As String = Map.refMainWindowVM.MainWindowM.sLogDir & "\" & Date.Today.Year & "-" &
If(Date.Today.Month < 10, "0", "") & Date.Today.Month & "-" & If(Date.Today.Day < 10, "0", "") & Date.Today.Day & ".ini"
WritePrivateProfileString(m_nTime.ToString, DbNumber & "." & Start, nValue.ToString, sBackupFolder)
Return True
End If
End If
End If
End If
OutLogProcess("<< ERRORE nella converione dati: [" & S_VARIABLES & "] '" & sVarName & "' non presente >>")
Return False
End Function
' definito il nome della variabile recupero l'inidirzzo variabile PLC e restituisco il valore letto da PLC
Friend Function ReadReal(sVarName As String, ByRef dValue As Double) As Boolean
Dim bok As Boolean = True
Dim sVar As String = String.Empty
' leggo da file OmagVIEWPlus l'indirizzo della variabile associata
If GetMainPrivateProfileString(S_VARIABLES, sVarName, "", sVar) > 0 Then
' Spezzatura nei componenti: sVar -> ActiveStorage=81,0,2
Dim sVarSplit() As String = sVar.Split(","c)
If sVarSplit.Length = 3 Then
' elimino spazi
For Each Var In sVarSplit
Var = Var.Trim
Next
Dim nType As Integer = 0
Dim Type As Types = 0
' l'ulitmo codice identifica il tipo di variabile
Integer.TryParse(sVarSplit(2), nType)
If nType >= 0 AndAlso nType <= 7 Then Type = DirectCast(nType, Types)
' se il tipo è reale
If Type = 5 Then
Dim DbNumber As Integer = 0
Dim Start As Integer = 0
Integer.TryParse(sVarSplit(0), DbNumber)
Integer.TryParse(sVarSplit(1), Start)
' leggo dalla macchina (file NC_Debug.ini) il valore della variabile associata
If m_NC.ReadReal(DbNumber, Start, dValue) Then
' scrivo in backup
Dim sBackupFolder As String = Map.refMainWindowVM.MainWindowM.sLogDir & "\" & Date.Today.Year & "-" &
If(Date.Today.Month < 10, "0", "") & Date.Today.Month & "-" & If(Date.Today.Day < 10, "0", "") & Date.Today.Day & ".ini"
WritePrivateProfileString(m_nTime.ToString, DbNumber & "." & Start, dValue.ToString, sBackupFolder)
EgtOutLog("DB." & DbNumber.ToString & "DBD" & Start.ToString & " -> " & dValue)
Return True
Else
OutLogProcess("<< ERRORE nella comunicazione: DB." & DbNumber.ToString & "DBD." & dValue.ToString & " non presente >>")
End If
End If
End If
End If
OutLogProcess("<< ERRORE nella conversione dati: [" & S_VARIABLES & "] '" & sVarName & "' non presente >>")
Return False
End Function
' scrivo le variabili RG[n], n: indice della variabile RG
Friend Function WriteInt_RG(sVarName As String, nValue As Integer) As Boolean
Dim bok As Boolean = True
Dim sVar As String = String.Empty
' lettura dell'inidrizzo di memoria per la scrittura del valore e dell'indice di R
Dim DBNumber As Integer = 81
Dim nWriteValue As Integer = 0
Dim nWriteIndex As Integer = 0
If GetMainPrivateProfileString(S_VARIABLES, "ConvertToRG", "", sVar) > 0 Then
Dim sItemSplit() As String = sVarName.Split(","c)
If sItemSplit.Count = 3 And IsNumeric(sItemSplit(0)) And IsNumeric(sItemSplit(1)) And IsNumeric(sItemSplit(2)) Then
DBNumber = CInt(sItemSplit(0))
nWriteIndex = CInt(sItemSplit(1))
nWriteValue = CInt(sItemSplit(2))
Else
Return False
End If
Else
Return False
End If
' Lettura variabile
If GetMainPrivateProfileString(S_VARIABLES, sVarName, "", sVar) > 0 Then
' Spezzatura nei componenti
Dim sVarSplit() As String = sVar.Split(","c)
If sVarSplit.Length = 2 Then
' elimino spazi
For Each Var In sVarSplit
Var = Var.Trim
Next
Dim nType As Integer = 0
Dim Type As Types = 0
Integer.TryParse(sVarSplit(1), nType)
If nType >= 0 AndAlso nType <= 7 Then Type = DirectCast(nType, Types)
If Type = 2 Then
Dim RNumber As Integer = 0
Integer.TryParse(sVarSplit(0), RNumber)
If nValue > 65000 Then
EgtOutLog("Trying to write an overflow integer")
Return False
End If
' controllo che scrittura sia disponibile
Dim WriteValue As Integer = 0
For Index = 0 To 10
m_NC.ReadInt(81, 140, WriteValue)
If WriteValue = 2000 Then
Exit For
End If
System.Threading.Thread.Sleep(10)
Next
If WriteValue <> 2000 Then
EgtOutLog("Scrittura sempre occupata")
Return False
End If
If m_NC.WriteInt(DBNumber, nWriteValue, nValue) And m_NC.WriteInt(DBNumber, nWriteIndex, RNumber) Then
' scrivo in backup
Dim sBackupFolder As String = Map.refMainWindowVM.MainWindowM.sLogDir & "\" & Date.Today.Year & "-" &
If(Date.Today.Month < 10, "0", "") & Date.Today.Month & "-" & If(Date.Today.Day < 10, "0", "") & Date.Today.Day & ".ini"
WritePrivateProfileString(m_nTime.ToString, DBNumber.ToString & "." & nWriteValue.ToString, RNumber.ToString, sBackupFolder)
WritePrivateProfileString(m_nTime.ToString, DBNumber.ToString & "." & nWriteIndex.ToString, nValue.ToString, sBackupFolder)
Return True
End If
End If
End If
End If
OutLogProcess("<< ERRORE nella converione dati: [" & S_VARIABLES & "] '" & sVarName & "' non presente >>")
Return False
End Function
Friend Function WriteReal_RG(sVarName As String, dValue As Double) As Boolean
Dim bok As Boolean = True
Dim sVar As String = String.Empty
' lettura dell'inidrizzo di memoria per la scrittura del valore e dell'indice di R
Dim DBNumber As Integer = 81
Dim nWriteValue As Integer = 0
Dim nWriteIndex As Integer = 0
If GetMainPrivateProfileString(S_VARIABLES, "ConvertToRG", "", sVar) > 0 Then
Dim sItemSplit() As String = sVarName.Split(","c)
If sItemSplit.Count = 3 And IsNumeric(sItemSplit(0)) And IsNumeric(sItemSplit(1)) And IsNumeric(sItemSplit(2)) Then
DBNumber = CInt(sItemSplit(0))
nWriteIndex = CInt(sItemSplit(1))
nWriteValue = CInt(sItemSplit(2))
Else
Return False
End If
Else
Return False
End If
' Lettura variabile
If GetMainPrivateProfileString(S_VARIABLES, sVarName, "", sVar) > 0 Then
' Spezzatura nei componenti
Dim sVarSplit() As String = sVar.Split(","c)
If sVarSplit.Length = 2 Then
' elimino spazi
For Each Var In sVarSplit
Var = Var.Trim
Next
Dim nType As Integer = 0
Dim Type As Types = 0
Integer.TryParse(sVarSplit(1), nType)
If nType >= 0 AndAlso nType <= 7 Then Type = DirectCast(nType, Types)
If Type = 2 Then
Dim RNumber As Integer = 0
Integer.TryParse(sVarSplit(0), RNumber)
If dValue > 65000 Then
EgtOutLog("Trying to write an overflow integer")
Return False
End If
' controllo che scrittura sia disponibile
Dim WriteValue As Integer = 0
For Index = 0 To 10
m_NC.ReadInt(81, 140, WriteValue)
If WriteValue = 2000 Then
Exit For
End If
System.Threading.Thread.Sleep(10)
Next
If WriteValue <> 2000 Then
EgtOutLog("Scrittura sempre occupata")
Return False
End If
If m_NC.WriteReal(DBNumber, nWriteValue, dValue) And m_NC.WriteInt(DBNumber, nWriteIndex, RNumber) Then
' scrivo in backup
Dim sBackupFolder As String = Map.refMainWindowVM.MainWindowM.sLogDir & "\" & Date.Today.Year & "-" &
If(Date.Today.Month < 10, "0", "") & Date.Today.Month & "-" & If(Date.Today.Day < 10, "0", "") & Date.Today.Day & ".ini"
WritePrivateProfileString(m_nTime.ToString, DBNumber.ToString & "." & nWriteValue.ToString, RNumber.ToString, sBackupFolder)
WritePrivateProfileString(m_nTime.ToString, DBNumber.ToString & "." & nWriteIndex.ToString, dValue.ToString, sBackupFolder)
Return True
End If
End If
End If
End If
OutLogProcess("<< ERRORE nella converione dati: [" & S_VARIABLES & "] '" & sVarName & "' non presente >>")
Return False
End Function
Friend Function WriteInt(sVarName As String, nValue As Integer) As Boolean
Dim bok As Boolean = True
Dim sVar As String = String.Empty
' Lettura variabile
If GetMainPrivateProfileString(S_VARIABLES, sVarName, "", sVar) > 0 Then
' Spezzatura nei componenti
Dim sVarSplit() As String = sVar.Split(","c)
If sVarSplit.Length = 3 Then
' elimino spazi
For Each Var In sVarSplit
Var = Var.Trim
Next
Dim nType As Integer = 0
Dim Type As Types = 0
Integer.TryParse(sVarSplit(2), nType)
If nType >= 0 AndAlso nType <= 7 Then Type = DirectCast(nType, Types)
If Type = 2 Then
Dim DbNumber As Integer = 0
Dim Start As Integer = 0
Integer.TryParse(sVarSplit(0), DbNumber)
Integer.TryParse(sVarSplit(1), Start)
If nValue > 65000 Then
EgtOutLog("Trying to write an overflow integer")
Return False
End If
If m_NC.WriteInt(DbNumber, Start, CShort(nValue)) Then
' scrivo in backup
Dim sBackupFolder As String = Map.refMainWindowVM.MainWindowM.sLogDir & "\" & Date.Today.Year & "-" &
If(Date.Today.Month < 10, "0", "") & Date.Today.Month & "-" & If(Date.Today.Day < 10, "0", "") & Date.Today.Day & ".ini"
WritePrivateProfileString(m_nTime.ToString, "81.144", nValue.ToString, sBackupFolder)
EgtOutLog("Write:" & DbNumber & "." & Start & " -> " & CShort(nValue))
Return True
Else
OutLogProcess("<< IMPOSSIBILE COMUNICARE INTERO >>")
End If
End If
End If
End If
OutLogProcess("<< ERRORE nella converione dati: [" & S_VARIABLES & "] '" & sVarName & "' non presente >>")
Return False
End Function
Friend Function WriteReal(sVarName As String, dValue As Double) As Boolean
Dim bok As Boolean = True
Dim sVar As String = String.Empty
' Lettura variabile
If GetMainPrivateProfileString(S_VARIABLES, sVarName, "", sVar) > 0 Then
' Spezzatura nei componenti
Dim sVarSplit() As String = sVar.Split(","c)
If sVarSplit.Length = 3 Then
' elimino spazi
For Each Var In sVarSplit
Var = Var.Trim
Next
Dim nType As Integer = 0
Dim Type As Types = 0
Integer.TryParse(sVarSplit(2), nType)
If nType >= 0 AndAlso nType <= 7 Then Type = DirectCast(nType, Types)
If Type = 5 Then
Dim DbNumber As Integer = 0
Dim Start As Integer = 0
Integer.TryParse(sVarSplit(0), DbNumber)
Integer.TryParse(sVarSplit(1), Start)
If dValue > 65000 Then
EgtOutLog("Trying to write an overflow integer")
Return False
End If
If m_NC.WriteReal(DbNumber, Start, CSng(dValue)) Then
' scrivo in backup
Dim sBackupFolder As String = Map.refMainWindowVM.MainWindowM.sLogDir & "\" & Date.Today.Year & "-" &
If(Date.Today.Month < 10, "0", "") & Date.Today.Month & "-" & If(Date.Today.Day < 10, "0", "") & Date.Today.Day & ".ini"
WritePrivateProfileString(m_nTime.ToString, "81.144", dValue.ToString, sBackupFolder)
Return True
End If
End If
End If
End If
OutLogProcess("<< ERRORE nella converione dati: [" & S_VARIABLES & "] '" & sVarName & "' non presente >>")
Return False
End Function
Private Function WriteBool(sVarName As String, nValue As Boolean) As Boolean
Dim bok As Boolean = True
Dim sVar As String = String.Empty
' Lettura variabile
If GetMainPrivateProfileString(S_VARIABLES, sVarName, "", sVar) > 0 Then
' Spezzatura nei componenti
Dim sVarSplit() As String = sVar.Split(","c)
If sVarSplit.Length = 3 Then
' elimino spazi
For Each Var In sVarSplit
Var = Var.Trim
Next
Dim nType As Integer = 0
Dim Type As Types = 0
Integer.TryParse(sVarSplit(2), nType)
If nType >= 0 AndAlso nType <= 7 Then Type = DirectCast(nType, Types)
If Type = 0 Then
Dim DbNumber As Integer = 0
Dim Start As Integer = 0
Integer.TryParse(sVarSplit(0), DbNumber)
Integer.TryParse(sVarSplit(1), Start)
If m_NC.WriteBool(DbNumber, Start, nValue) Then
' scrivo in backup
Dim sBackupFolder As String = Map.refMainWindowVM.MainWindowM.sLogDir & "\" & Date.Today.Year & "-" &
If(Date.Today.Month < 10, "0", "") & Date.Today.Month & "-" & If(Date.Today.Day < 10, "0", "") & Date.Today.Day & ".ini"
WritePrivateProfileString(m_nTime.ToString, DbNumber & "." & Start, If(nValue, 1, 0).ToString, sBackupFolder)
Return True
End If
End If
End If
End If
OutLogProcess("<< ERRORE nella converione dati: [" & S_VARIABLES & "] '" & sVarName & "' non presente >>")
Return False
End Function
#End Region ' Lettura scriettura Siemens
End Class
Reference in New Issue View Git Blame Copy Permalink