From 98b6563e57da4533e689707e9cb784ba693debe5 Mon Sep 17 00:00:00 2001 From: Nicola Pievani Date: Fri, 20 Nov 2020 19:48:51 +0000 Subject: [PATCH] OmagVIEWPlus 2.2k1: -> verificate coordinate di prelievo e deposito (Tab1 e Tab2) -> scatta foto -> gestione di preparazione pallet (nesting 1d) -> gestione mancato vuoto su tavola 1 -> gestione di mancato vuoto tavola 2. --- Constants/ConstGen.vb | 35 +- Constants/ConstIni.vb | 27 +- EgtStoneLib/CamAuto.vb | 460 +++++++++++++++++--- EgtStoneLib/ConstMach.vb | 4 +- EgtStoneLib/EstPhoto.vb | 362 ++++++++------- EgtStoneLib/GeomCalc.vb | 17 + EgtStoneLib/VacuumCups.vb | 54 ++- MainWindow/Camera.vb | 431 ++++++++++++++++++ MainWindow/MainWindowM.vb | 112 +++-- MainWindow/MainWindowV.xaml | 6 +- MainWindow/MainWindowVM.vb | 48 +- MainWindow/Part.vb | 112 +++-- My Project/AssemblyInfo.vb | 4 +- MySceneHost/MySceneHostVM.vb | 214 ++++++--- NCCommunication/NCCommunication.vb | 676 ++++++++++++++++++++++++----- OmagVIEWPlus.vbproj | 9 +- UnloadingArea/UnloadingAreaV.xaml | 12 +- UnloadingArea/UnloadingAreaVM.vb | 328 +++++++++----- Utility/Map.vb | 1 + Utility/Utility.vb | 11 + Warehouse/Box.vb | 20 +- Warehouse/WarehouseVM.vb | 8 +- 22 files changed, 2358 insertions(+), 593 deletions(-) create mode 100644 MainWindow/Camera.vb diff --git a/Constants/ConstGen.vb b/Constants/ConstGen.vb index 1eb696f..af262a0 100644 --- a/Constants/ConstGen.vb +++ b/Constants/ConstGen.vb @@ -25,20 +25,27 @@ Module ConstGen ' Abilitazioni licenza Friend Enum KEY_OPT As UInteger - CUT_BASE = 1 ' Prodotto OmagCUT - MAN_MANIP = 2 - AUTO_MANIP = 4 - MAN_PHOTO = 8 - AUTO_PHOTO = 16 - AUTO_NESTING = 32 - ENABLE_MILL = 64 - PROCUCTION_LINE = 128 - OFFICE_BASE = 256 ' Prodotto OmagOFFICE - VM_MULTI = 512 - UNDER_CUT = 1024 - CSV_SIMPLE = 2048 - PHOTO_BASE = 4096 ' Prodotto OmagPHOTO - TRF_IMPORT = 8192 + CUT_BASE = 1 ' 2 ^ 0 - Prodotto OmagCUT + MAN_MANIP = 2 ' 2 ^ 1 + AUTO_MANIP = 4 ' 2 ^ 2 + MAN_PHOTO = 8 ' 2 ^ 3 + AUTO_PHOTO = 16 ' 2 ^ 4 + CSV_AUTO = 32 ' 2 ^ 5 + ENABLE_MILL = 64 ' 2 ^ 6 + PRODUCTION_LINE = 128 ' 2 ^ 7 + OFFICE_BASE = 256 ' 2 ^ 8 - Prodotto OmagOFFICE + VM_MULTI = 512 ' 2 ^ 9 + UNDER_CUT = 1024 ' 2 ^ 10 + CSV_SIMPLE = 2048 ' 2 ^ 11 + PHOTO_BASE = 4096 ' 2 ^ 12 - Prodotto OmagPHOTO + TRF_IMPORT = 8192 ' 2 ^ 13 + MOVE_PARTS = 16384 ' 2 ^ 14 + IMPORT_SLABDXF = 32768 ' 2 ^ 15 + CURVED_FRAME = 65536 ' 2 ^ 16 + ENABLE_WJ = 131072 ' 2 ^ 17 + ENABLE_POLISHING = 262144 ' 2 ^ 18 + OFFICE_TYPE = 524288 ' 2 ^ 19 + REGISTRATION = 1048576 ' 2 ^ 20 End Enum ' File di log generale diff --git a/Constants/ConstIni.vb b/Constants/ConstIni.vb index 24c04d3..cb002ab 100644 --- a/Constants/ConstIni.vb +++ b/Constants/ConstIni.vb @@ -17,6 +17,7 @@ Module ConstIni Public Const S_GENERAL As String = "General" Public Const K_DEBUG As String = "Debug" + Public Const K_LOGPROCES As String = "LogProces" Public Const K_LICENCE As String = "Licence" Public Const K_USERLEVEL As String = "UserLevel" Public Const K_MAXINST As String = "MaxInstances" @@ -27,6 +28,9 @@ Module ConstIni Public Const K_WINPLACE As String = "WinPlace" Public Const K_SUPPORT As String = "Support" Public Const K_PROJDIR As String = "ProjDir" + Public Const K_IMAGEDIR As String = "ImageDir" + Public Const K_CAMERALINK As String = "CameraLink" + Public Const K_CONTOURFROMCAMERA As String = "ContourFromCamera" Public Const S_LANGUAGES As String = "Languages" Public Const K_LANGUAGE As String = "Language" @@ -53,12 +57,17 @@ Module ConstIni Public Const K_PIVOTBX As String = "PivotBX" Public Const K_PIVOTBY As String = "PivotBY" + Public Const S_DIM_VACUMM As String = "Vacuum" + Public Const K_VACUUM_DIMX As String = "DimX" + Public Const K_VACUUM_DIMY As String = "DimY" Public Const S_BOX As String = "Box" Public Const K_MAX_HEIGHT As String = "MaxHeightPallet" Public Const K_MAX_LENGTH As String = "MaxLengthPallet" - Public Const K_MAX_WIDTH As String = "MaxWidthPallet" Public Const K_MAX_TILE As String = "MaxTileRack" + Public Const K_MIN_TOL As String = "MinTollerance" + Public Const K_MAX_TOL As String = "MaxTollerance" + Public Const S_WAREHOUSE As String = "Warehouse" Public Const K_ACTIVESTORAGE As String = "ActiveStorage" @@ -75,4 +84,20 @@ Module ConstIni Public Const K_PLACE As String = "Place" Public Const K_UNLOADING As String = "Unloading" + Public Const S_CAMERA As String = "Camera" + Public Const K_CAM_COUNT As String = "Count" + Public Const K_CAM_EXEPATH As String = "ExePath" + Public Const K_CAM_IMAGE As String = "Image" + Public Const K_CAM_INFO As String = "Info" + Public Const K_CAM_RESULT As String = "Result" + Public Const K_CAM_CONTOUR As String = "Contour" + Public Const K_CAM_EXEPATH2 As String = "ExePath2" + Public Const K_CAM_IMAGE2 As String = "Image2" + Public Const K_CAM_INFO2 As String = "Info2" + Public Const K_CAM_RESULT2 As String = "Result2" + Public Const K_CAM_CONTOUR2 As String = "Contour2" + Public Const K_CAM_THRESHOLD As String = "Threshold" + Public Const K_CAM_TOLERANCE As String = "Tolerance" + Public Const K_CAM_TIMEOUT As String = "Timeout" + End Module diff --git a/EgtStoneLib/CamAuto.vb b/EgtStoneLib/CamAuto.vb index 67aac56..1bf0dc4 100644 --- a/EgtStoneLib/CamAuto.vb +++ b/EgtStoneLib/CamAuto.vb @@ -290,10 +290,21 @@ Friend Module CamAuto Return bOk End Function + Private PartListMax As New List(Of Part) + Private PartListMedium As New List(Of Part) + Private PartListMin As New List(Of Part) + ' posizionamento vetnotose TavoloScarico-Tappeto Friend Function MyUpdateVacuumsForUnloading() As Boolean + EgtOutLog("Inizio calcolo ventose") + Map.refUnloadingAreaVM.ClearOutputMessage() + Map.refUnloadingAreaVM.SetOutputMessage("Started loading project.") Map.refMainWindowVM.MainWindowM.ProjIndList(Map.refMainWindowVM.MainWindowM.ProjIndList.Count - 1).enStatus = StatusProj.LOADING - Dim PartsList As New List(Of Part) + ' ripulisco gli elenchi + PartListMax.Clear() + PartListMedium.Clear() + PartListMin.Clear() + ' lista dei pezzi manuali del progetto corrente Dim PartsListManual As New List(Of Part) Dim bOk As Boolean = True Dim nIndex As Integer = 1 @@ -327,19 +338,25 @@ Friend Module CamAuto ' recupero le dimensioni del minimo rettangolo -> dal vettore che unisce il centro pezzo con il vertice in alto a sinistra TmpPart.MinRectY = rmData.m_vtRect.y * 2 TmpPart.MinRectX = rmData.m_vtRect.x * 2 - Dim ptCenT As New Point3d If EgtGetPartCenter(nPartId, ptCenT) Then + ' defnisco da subiot i pezzi manuali + Dim nStat As Integer = GDB_ST.ON_ + EgtGetStatus(nPartId, nStat) + ' aggiorno la lista dei pezzi dal più grande al più piccolo + If nStat = GDB_ST.SEL Then + TmpPart.enUnloading = Unloading.MANUAL + TmpPart.nLayer = -2 + End If ' salvo le posizioni delle ventose TmpPart.SetInfoTable1(rmData, b3RawPart.DimZ) - ' salvo il punto ptCent del pezzo + ' salvo il punto ptCent del pezzo rispetto al centro tavola1 TmpPart.SetCenterPartTable(ptCenT) - ' ruoto il pezzo e lo posziono in alto a sinistra + ' ruoto il pezzo e lo posziono in alto a sinistra (per il prelievo del secondo manipolatore) EgtRotate(nPartId, rmData.m_ptCenMinRect, Vector3d.Z_AX, -TmpPart.MoveTable1.m_dAngRotDeg, GDB_RT.GLOB) ' ruoto il versore Y del rettangolo rmData.m_vtOrtoDirX.Rotate(Vector3d.Z_AX, -TmpPart.MoveTable1.m_dAngRotDeg) - Dim vtMove As New Vector3d ' calcolo l'offset in alto a sinistra del rettangolo di riferimento Dim vtRectTopLeft As New Vector3d(rmData.m_vtRect) @@ -355,31 +372,29 @@ Friend Module CamAuto ' creo le variabili per il posizionamento delle ventose sul tavolo 2 Dim rmData2 As New RawMoveData Dim b3Part2 As New BBox3d - If MyPutVacuumCupsOnPart(nPartId, rmData2, b3Part2, VACUUM_HEAD_PALLET) Then - ' correggo il vettore vtDelta con il pivot - Dim PivotC As Vector3d = New Vector3d(Map.refUnloadingAreaVM.PivotCX, Map.refUnloadingAreaVM.PivotCY, 0) - PivotC.Rotate(Vector3d.Z_AX, rmData2.m_dAngRotDeg) - rmData2.m_vtDelta = rmData2.m_vtDelta + PivotC - ' se il vettore vtDelta.x < 0 significa che la ventosa deve essere ruotata di 180° - 'If rmData2.m_vtDelta.x < 0 Then - ' rmData2.m_dAngRotDeg = 180 - ' rmData2.m_vtDelta.Rotate(Vector3d.Z_AX, rmData2.m_dAngRotDeg) - 'End If + If MyPutVacuumCupsOnPart(nPartId, rmData2, b3Part2, VACUUM_HEAD_PALLET) And TmpPart.enUnloading <> Unloading.MANUAL Then + ' salvo le posizioni delle ventose TmpPart.SetInfoTable2(rmData2) Else - EgtOutLog("Error on UpdateVacuums in Part Table2" & nPartId.ToString()) + EgtOutLog("Error on UpdateVacuums in Part Table2 " & nPartId.ToString()) + ' coloro il pezzo non prelevabile dal pallettizzatore di fuxia + Dim nIdCurrRegion As Integer = GeomCalc.GetRegionFromPart(nPartId) + If nIdCurrRegion > 0 Then + EgtSetColor(nIdCurrRegion, New Color3d(255, 255, 0, 80)) + EgtDraw() + End If + ' e diventa scarico manuale + TmpPart.enUnloading = Unloading.MANUAL End If ' riposiziono tutto come all'inizio (per avere la disposizione corretta) EgtMove(nPartId, -vtMove) EgtRotate(nPartId, rmData.m_ptCenMinRect, Vector3d.Z_AX, TmpPart.MoveTable1.m_dAngRotDeg, GDB_RT.GLOB) + EgtDraw() - Dim nStat As Integer = GDB_ST.ON_ - EgtGetStatus(nPartId, nStat) ' aggiorno la lista dei pezzi dal più grande al più piccolo - If nStat = GDB_ST.SEL Then - TmpPart.enUnloading = Unloading.MANUAL - ' pezzi manuli + If TmpPart.enUnloading = Unloading.MANUAL Then + ' pezzi manuali If PartsListManual.Count = 0 Then PartsListManual.Add(TmpPart) Else @@ -396,89 +411,414 @@ Friend Module CamAuto End If End If Else - ' pezzi automatici - If PartsList.Count = 0 Then - PartsList.Add(TmpPart) + ' pezzi automatici (recupero la lista di apparenenza del pezzo) + Dim LocalPartList As List(Of Part) = GetPartList(TmpPart.MinRectX) + If LocalPartList.Count = 0 Then + LocalPartList.Add(TmpPart) Else Dim bIsInsert As Boolean = False - For i = 0 To PartsList.Count - 1 - If TmpPart.MinRectY > PartsList(i).MinRectY Then - PartsList.Insert(i, TmpPart) + For i = 0 To LocalPartList.Count - 1 + If TmpPart.MinRectY > LocalPartList(i).MinRectY Then + LocalPartList.Insert(i, TmpPart) bIsInsert = True Exit For End If Next If Not bIsInsert Then - PartsList.Add(TmpPart) + LocalPartList.Add(TmpPart) End If End If End If - - Dim b3Part3 As New BBox3d - EgtGetBBoxGlob(nPartId, 1, b3Part3) - ' salvo le informazioni per creare la nuova lavorazione - InfoPartList.Add(New InfoPart(b3Part3.Min, nPartId, rmData.m_dAngRotDeg)) - TmpPart.SavePart(nIndex) - nIndex = nIndex + 1 End If - Else bOk = False - EgtOutLog("Error on UpdateVacuums in Part Table1" & nPartId.ToString()) + EgtOutLog("Error on UpdateVacuums in Part Table1 " & nPartId.ToString()) + ' coloro il pezzo non prelevabile di viola + Dim nIdRegion As Integer = GeomCalc.GetRegionFromPart(nPartId) + If nIdRegion > 0 Then + EgtSetColor(nIdRegion, New Color3d(255, 0, 255, 80)) + EgtDraw() + End If End If nPartId = EgtGetNextPartInRawPart(nPartId) - End While - MyCopyRawParts(nRawId, InfoPartList) + End While ' cilco sui Pezzi contenuti nel Grezzo End If nRawId = EgtGetNextRawPart(nRawId) - End While + End While ' ciclo sui Grezzi centenuti nel progetto - '------------------ - 'MyNewMachGroup() - '------------------ + ' salvo il file corrente con i pezzi appena disposti + 'EgtSaveFile(Map.refMainWindowVM.MainWindowM.sTempDir & "\" & CURR_PROJ_NAME, NGE.BIN) ' Scarico le ventose RemoveVacuumCups() ' Ripristino fase corrente originale EgtSetCurrPhase(nOriPhase) + ' comnnico che sta per iniziare il processo di nesting + EgtOutLog("Start Nesting") + Dim nCurrLayer As Integer = 0 + ' elnco dei pezzi inseriti nell'ultimo Layer + Dim LastLayerList As New List(Of Part) + ' Spazio disponibile per il deposito, la prima dimensione è quella del pallet + Dim dDiffY As Double = Map.refUnloadingAreaVM.OffsetPalletY * 2 + ' eseguo il Nesting1D dei pezzi correnti, costruisco l'enco dei pezzi da depositare sui pallet + If PartListMedium.Count > 0 And Not MyNesting1D(PartListMedium, dDiffY, LastLayerList, nCurrLayer) Then + Return False + End If + ' recupero l'indice dell'ultimo Layer calcolato + If LastLayerList.Count > 0 Then nCurrLayer = LastLayerList(0).nLayer + ' eseguo il nestin 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 + Return False + End If + ' comunico che il processo di Nesting è terminato + EgtOutLog("End Nesting") + ' ricostruisco l'elenco completo dei pezzi ordinati per il deposito + Dim ActualListPart As New List(Of Part) + + ' riordino l'elenco dei pezzi (dal Primo Layer all'ultimo Layer) + Dim nCountPart As Integer = 0 + Dim StartLayer As Integer = 0 + Dim bLayerExist As Boolean = True + While bLayerExist + bLayerExist = False + For Each ItemPart In PartListMedium + If ItemPart.nLayer = StartLayer Then + ActualListPart.Add(ItemPart) + ItemPart.bInsert = True + nCountPart = nCountPart + 1 + bLayerExist = True + End If + Next + StartLayer = StartLayer + 1 + End While + bLayerExist = True + StartLayer = StartLayer - 1 + While bLayerExist + bLayerExist = False + For Each ItemPart In PartListMin + If ItemPart.nLayer = StartLayer Then + ActualListPart.Add(ItemPart) + ItemPart.bInsert = True + bLayerExist = True + End If + Next + StartLayer = StartLayer + 1 + End While + + ' verifico se tutti i pezzi sono stati inseriti + Dim ErrList As New List(Of Part) + For Each ItemMedium In PartListMedium + If Not ItemMedium.bInsert Then + ErrList.Add(ItemMedium) + End If + Next + For Each ItemMin In PartListMin + If Not ItemMin.bInsert Then + ErrList.Add(ItemMin) + End If + Next + If ErrList.Count > 0 Then + For Each ItemError In ErrList + ' coloro il pezzo non prelevabile dal pallettizzatore di fuxia + Dim nIdCurrRegion As Integer = GeomCalc.GetRegionFromPart(ItemError.IdPart) + If nIdCurrRegion > 0 Then + EgtSetColor(nIdCurrRegion, New Color3d(255, 255, 0, 80)) + EgtDraw() + End If + Next + End If + ' restituisco l'elenco dei pezzi (prima gli automatici e poi quelli manuali) Dim nActualPositionList As Integer = 0 If Not IsNothing(Map.refUnloadingAreaVM) Then - For Each ItemPart In PartsList + + ' per ogni pezzo + For Each ItemPart In ActualListPart Map.refUnloadingAreaVM.ListPart.Add(ItemPart) nActualPositionList = nActualPositionList + 1 PartWritePrivateProfileString(ItemPart.IdProject, "PartList", "IdPart" & nActualPositionList.ToString, ItemPart.IdPart.ToString) + ItemPart.SavePart(ItemPart.IdPart) + ItemPart.dOffestPartY = ItemPart.dOffestPartY + Next + For Each ItemPart In PartListMax + Map.refUnloadingAreaVM.ListPart.Add(ItemPart) + nActualPositionList = nActualPositionList + 1 + PartWritePrivateProfileString(ItemPart.IdProject, "PartList", "IdPart" & nActualPositionList.ToString, ItemPart.IdPart.ToString) + ItemPart.SavePart(ItemPart.IdPart) Next For Each ItemPartManual In PartsListManual Map.refUnloadingAreaVM.ListPart.Add(ItemPartManual) nActualPositionList = nActualPositionList + 1 PartWritePrivateProfileString(ItemPartManual.IdProject, "PartList", "IdPart" & nActualPositionList.ToString, ItemPartManual.IdPart.ToString) + ItemPartManual.SavePart(ItemPartManual.IdPart) Next ' notifico l'ultimo pezzo Map.refUnloadingAreaVM.ListPart(Map.refUnloadingAreaVM.ListPart.Count - 1).SetIsLast(True) End If - + Map.refUnloadingAreaVM.ClearOutputMessage() + Map.refUnloadingAreaVM.SetOutputMessage("Ended loading project.") Return bOk End Function - Public Sub MyCopyRawParts(nRawId As Integer, InfoPartList As List(Of InfoPart)) - ' aggiungo un nuovo RawPart - Dim ptCenterRawPart As New Point3d - Dim b3RawPart As New BBox3d - EgtGetRawPartCenter(nRawId, ptCenterRawPart) - EgtGetRawPartBBox(nRawId, b3RawPart) - m_RawPartList.Add(New InfoRawPart(nRawId, b3RawPart.Min, b3RawPart.DimX, b3RawPart.DimY, b3RawPart.DimZ, New Color3d(0, 255, 255, 80), InfoPartList)) - 'EgtAddRawPart( Point3d ptOrig, num dLength, num dWidth, num dHeight, Color3d Col) + ' assegnata la lunghezza del pezzo restiruisce la lista di appartenenza + Private Function GetPartList(MinRectX As Double) As List(Of Part) + If MinRectX - Map.refUnloadingAreaVM.MaxLength > EPS_SMALL Then + Return PartListMax + ElseIf MinRectX - 600 > EPS_SMALL Then + Return PartListMedium + Else + Return PartListMin + End If + End Function + + Public Function MyNesting1D(LocalPartList As List(Of Part), ByRef PrecWidthLayer As Double, ByRef LastLayerList As List(Of Part), nLayerIndex As Integer, Optional bStop As Boolean = False) As Boolean + ' se la lista da nestare è vuot allora esco siìubito + If LocalPartList.Count < 1 Then Return False + ' incremento la dimaneione del piano inferiore + If PrecWidthLayer + 100 < Map.refUnloadingAreaVM.OffsetPalletY * 2 Then + PrecWidthLayer = PrecWidthLayer + 100 + End If + ' larghezza disponibile per il deposito del Layer corrente + Dim WidthPallet As Double = PrecWidthLayer + + ' dimensione complessiva occupata dai pezzi + Dim ActualWidthLayer As Double = 0 + ' distanza minima di sicurezza da mantenere tra i pezzi + Dim dTollerance As Double = Map.refUnloadingAreaVM.MinTollerance + ' distanza massima di sicurezza da mantenere tra i pezzi + Dim dMaxTollerance As Double = Map.refUnloadingAreaVM.MaxTollerance + ' eseguo una copia della lista dei pezzi + Dim CopyList As New List(Of Part) + For Each ItemOrigList In LocalPartList + CopyList.Add(ItemOrigList) + Next + ' Lista delle dimensioni dei layer generati + Dim ListLayerWidth As New List(Of Double) + ' Lista dei Part contenuti in un Layer (usata all'interno del ciclo di Nesting) + Dim ListPartLayer As New List(Of Part) + + ' INIZIO NESTING + If Not EgtMaxFillerStart() Then + EgtOutLog("Not Initizlized: EgtMaxFillerStart()") + Return False + Else + EgtOutLog("Initizlized: EgtMaxFillerStart()") + End If + While CopyList.Count() > 0 + EgtMaxFillerStart() + ' carico la lista con i pezzi rimasti per eseguire il Nesting1D + For Each ItemPart In CopyList + EgtMaxFillerAddPart(ItemPart.IdPart, ItemPart.MinRectY) + Next + ' definisco le tolleranze da usare tra i pezzi (dal bordo sinistro, tra i pezzi, dal bordo destro) + Dim SideTollerance As Double = dTollerance + If nLayerIndex > 0 Then + SideTollerance = 0 + End If + EgtMaxFillerCompute(PrecWidthLayer, SideTollerance, dTollerance, SideTollerance) + Dim nFilledParts As Integer = 0 + ' numero di pezzi inseriti nel Layer + Dim nDiffParts As Integer = 0 + Dim dTotFillRatio As Double + EgtMaxFillerGetResults(nFilledParts, nDiffParts, dTotFillRatio) + Dim TotalLenght As Double = 0 + ' ripulisco la lista dei pezzi del Layer precedente + ListPartLayer.Clear() + Dim Index As Integer = 0 + ' se non sono ruiscito ad eseguire il nesting allora esco + If nDiffParts = 0 Then + Return False + End If + ' aggiorno la lista dei pezzi nel Layer e la lista dei pezzi che devono essere nestati + For Index = 0 To nDiffParts - 1 + ' Id del Pezzo inserito nel Layer + Dim nPartId As Integer = 0 + Dim nCount As Integer = 0 + EgtMaxFillerGetOneResult(Index, nPartId, nCount) + Dim IndexPart As Integer = 0 + ' ricerco il pezzo iesimo (Index) del Layer corrente + For IndexPart = 0 To CopyList.Count() - 1 + If nPartId = CopyList(IndexPart).IdPart Then + TotalLenght = TotalLenght + nCount * CopyList(IndexPart).MinRectY + ' salvo il valore del Layer corrente + CopyList(IndexPart).nLayer = nLayerIndex + ' inserisco il pezzo nella lista dei pezzi del Layer corrente + ListPartLayer.Add(CopyList(IndexPart)) + ' rimuovo il pezzo dall'elenco dei pezzi che devono essere ancora nestati + CopyList.RemoveAt(IndexPart) + Exit For + End If + Next + Next + ' seleziono il Layer successivo + nLayerIndex = nLayerIndex + 1 + ' determino il distanziamento tra i pezzi del Layer corrente + CalcOffsetPartY(ListPartLayer, WidthPallet) + ' salvo la dimensione del Layer appena creato + ListLayerWidth.Add(WidthPallet) + ' se "True" calcolo un solo Layer ed esco dal ciclo + If bStop Then Exit While + End While + ' se ho almeno 2 Layer restituisco la dimensione occupata dal penultimo Layer calcolato + If ListLayerWidth.Count() > 1 Then + PrecWidthLayer = ListLayerWidth(ListLayerWidth.Count() - 2) + End If + ' restituisco la lista dei pezzi che occupano l'ultimo Layer + LastLayerList = ListPartLayer + Return True + End Function + + Public Function JoinNesting1D(PrecListPart As List(Of Part), CurrListPart As List(Of Part), LastLayerList As List(Of Part), ByRef dDiffY As Double, nCurrLayer As Integer) As Boolean + ' se una delle due liste da nestare è vuota allora esco + If PrecListPart.Count < 1 Or CurrListPart.Count < 1 Then Return False + EgtOutLog("Start Join Nesting") + ' determino il massimo spazio disponibile rimanente sull'ultimo Layer (togliendo le tolleranze sul bordo sinistro e destro) + Dim dTempDiff As Double = dDiffY + For Each ItemInLayer In LastLayerList + dTempDiff = dTempDiff - ItemInLayer.MinRectY - Map.refUnloadingAreaVM.MinTollerance + Next + ' definisco la lista dei pezzi che occupano lo spazio rimanente del Layer corrente + Dim FirstLayerLIst As New List(Of Part) + ' eseguo il Nesting1D dei pezzi correnti (seconda lista) nell'ultimo Layer + MyNesting1D(CurrListPart, dTempDiff, FirstLayerLIst, nCurrLayer, True) + ' se esistono dei pezzi che possono essere nestati nello spazio rimasto nell'ultimo Layer + If FirstLayerLIst.Count() > 0 Then + For Each ItemFirstPartLayer In FirstLayerLIst + ' inserico il pezzo nella lista dei pezzi più grandi + PrecListPart.Add(ItemFirstPartLayer) + ' rimuovo il pezzo dalla lista dei pezzi che devono essere nestati + For IndexFirst As Integer = 0 To CurrListPart.Count() - 1 + If CurrListPart(IndexFirst).IdPart = ItemFirstPartLayer.IdPart Then + CurrListPart.RemoveAt(IndexFirst) + Exit For + End If + Next + Next + ' inseirco i pezzi appena trovati nella lista dei pezzi del Layer corrente + For Each ItemLastPartLayer In LastLayerList + FirstLayerLIst.Add(ItemLastPartLayer) + Next + ' calcolo la disposizione dei pezzi nel Layer + CalcOffsetPartY(FirstLayerLIst, dDiffY) + Return True + Else + dDiffY = dDiffY - dTempDiff + Return True + End If + End Function + + ' riceve in ingresso la lista dei pezzi e la superficie disponibile -> i pezzi non devono essere raggruppati in categorie + Public Sub MyNestingSideBySide(LocalPartList As List(Of Part), ByVal ActualWidthPallet As Double) + Dim nCurrLayer As Integer = 0 + Dim dTollerance As Double = Map.refUnloadingAreaVM.MinTollerance + Dim dMaxTollerance As Double = Map.refUnloadingAreaVM.MaxTollerance + Dim dMaxDist As Double = 170 + ' lista dei pezzi per il Layer corrente + Dim ListPartLayer As New List(Of Part) + ' definisco la posizione all'interno del Layer + Dim nCurrPos As Integer = 0 + ' superficie disponibile di deposito sul pallet + Dim dDiff As Double = ActualWidthPallet - dTollerance + ' devo necessariamente impilare i pezzi (non posso porvare ad affiancarli) + Dim dCreateTile As Boolean = False + ' costruisco i layer + Dim IndexPart As Integer = 0 + While IndexPart < LocalPartList.Count() - 1 + ' se è il primo pezzo del Layer allora non considero al tolleranza + Dim CurrTollerance As Double = dTollerance + If nCurrPos = 0 Then + dTollerance = 0 + End If + ' inserisco il pezzo nello spazio rimanete del Layer e calcolo lo spazio disponibile + dDiff = dDiff - LocalPartList(IndexPart).MinRectY - dTollerance + ' se il pezzo non sborda + If dDiff >= -EPS_SMALL Then + ' defisco la posizione nel Layer + nCurrPos = nCurrPos + 1 + ' salvo il Layer Occupato dal pezzo + LocalPartList(IndexPart).nLayer = nCurrLayer + ' aggiungo il pezzo alla lista dei pezzi inseriti nel Layer + ListPartLayer.Add(LocalPartList(IndexPart)) + ' passo al pezzo successivo + IndexPart = IndexPart + 1 + Else + ' passo al Layer successivo + nCurrLayer = nCurrLayer + 1 + nCurrPos = 0 + ' calcolo la disposizione dei pezzi nel Layer corrente in Y + CalcOffsetPartY(ListPartLayer, ActualWidthPallet) + dDiff = ActualWidthPallet + ' ripulisco la lista dei pezzi all'interno del Layer + ListPartLayer.Clear() + End If + End While End Sub - Public Sub MyNewMachGroup() - EgtAddMachGroup("Nome_Macchinata", "Omag-MultiCutNC-S") - For Each ItemRaw In m_RawPartList - Dim nRawId As Integer = EgtAddRawPart(ItemRaw.ptOrig, ItemRaw.m_Lenght, ItemRaw.m_Width, ItemRaw.m_Height, ItemRaw.m_Color3d) - For Each ItemPart In ItemRaw.m_InfoPartList - EgtAddPartToRawPart(ItemPart.m_IdPart, Point3d.ORIG + (ItemPart.ptOrig - ItemRaw.ptOrig), nRawId) - Next + ' ricavuta la lista di pezzi che occupano un Layer, e la dimensione Y del Layer precedente determino la nuova disposizione + Public Sub CalcOffsetPartY(ListPartLayer As List(Of Part), ByRef PrecWidthPallet As Double) + ' distanza massima di sicurezza da mantenere tra i pezzi + Dim dMaxTollerance As Double = Map.refUnloadingAreaVM.MaxTollerance + ' distanza minima di sicurezza da mantenere tra i pezzi + Dim dTollerance As Double = Map.refUnloadingAreaVM.MinTollerance + If Math.Abs(PrecWidthPallet - Map.refUnloadingAreaVM.OffsetPalletY * 2) > EPS_SMALL Then + dTollerance = 0 + End If + ' dimensione attale occupata dal layer corrente + Dim ActualWidthPallet As Double = 0 + ' determino lo spazio occupato da tutti i pezzi del Layer corrente (attacati tra loro) + For Each ItemPartLayer In ListPartLayer + ActualWidthPallet = ActualWidthPallet + ItemPartLayer.MinRectY Next + ' aggiungo la tolleranza di sul bordo di sinistra e sul bordo di destra (solo se PrecWidthPallet uguale alla dimensione del Pallet + ActualWidthPallet = ActualWidthPallet + 2 * dTollerance + ' suddivido lo spazio rimasto sul pallet tra i pezzi + Dim dSplit As Double = 0 + If ListPartLayer.Count() > 1 Then + ' determino l'interspazio che deve essere lasciato tra i pezzi + dSplit = (PrecWidthPallet - ActualWidthPallet) / (ListPartLayer.Count() - 1) + ' verifico che la distanza calcolata sia minore del valore massimo + If dSplit > dMaxTollerance Then + dSplit = dMaxTollerance + End If + End If + ' determino lo spazio occupato dai pezzi del Layer corrente + ActualWidthPallet = ActualWidthPallet + (ListPartLayer.Count() - 1) * dSplit + ' centro i pezzi del Layer massimizzando la distanza + Dim vtMoveY As Double = Map.refUnloadingAreaVM.OffsetPalletY - ActualWidthPallet / 2 + ' posizione occupata all'interno del Layer + Dim IndexPart As Integer = 0 + ' spazio occupato dai pezzi precedenti + Dim ActualY As Double = 0 + Dim bCalcOk As Boolean = False + For IndexPart = 0 To ListPartLayer.Count() - 1 + bCalcOk = False + If IndexPart = 0 Then + ' se è il primo pezzo del Layer + ListPartLayer(IndexPart).dOffestPartY = ListPartLayer(IndexPart).MinRectY / 2 + dTollerance + vtMoveY + ActualY = ListPartLayer(IndexPart).MinRectY + dTollerance + bCalcOk = True + ElseIf IndexPart = ListPartLayer.Count() - 1 Then + ' se è l'ultimo pezzo del Layer + ListPartLayer(IndexPart).dOffestPartY = ActualY + ListPartLayer(IndexPart).MinRectY / 2 + dSplit + vtMoveY + ActualY = ActualY + ListPartLayer(IndexPart).MinRectY + dSplit + bCalcOk = True + Else + ' se è un pezzo che sta nel mezzo del pallet + ListPartLayer(IndexPart).dOffestPartY = ActualY + ListPartLayer(IndexPart).MinRectY / 2 + dSplit + vtMoveY + ActualY = ActualY + ListPartLayer(IndexPart).MinRectY + dSplit + bCalcOk = True + End If + If Not bCalcOk Then + Map.refUnloadingAreaVM.ClearOutputMessage() + Map.refUnloadingAreaVM.SetOutputMessage("Error in calc offset box.") + End If + Next + ' restituisco la dimensione del Layer corrente + PrecWidthPallet = ActualWidthPallet - 2 * dTollerance End Sub Friend Function DeactivateAllMachinings() As Boolean diff --git a/EgtStoneLib/ConstMach.vb b/EgtStoneLib/ConstMach.vb index cf3e39f..fc9b6ca 100644 --- a/EgtStoneLib/ConstMach.vb +++ b/EgtStoneLib/ConstMach.vb @@ -57,8 +57,8 @@ Module ConstMach ' Nome gruppo dei grezzi Public Const MACH_RAWS_GROUP As String = "Raws" - ' Nome della superficie del grezzo - Public Const NAME_RAW_SOLID As String = "RawSolid" + '' Nome della superficie del grezzo + 'Public Const NAME_RAW_SOLID As String = "RawSolid" ' Nome del centro del grezzo Public Const NAME_RAW_CENTER As String = "RawCenter" ' Nome del contorno di kerf nel grezzo diff --git a/EgtStoneLib/EstPhoto.vb b/EgtStoneLib/EstPhoto.vb index 6234323..7dbf0cb 100644 --- a/EgtStoneLib/EstPhoto.vb +++ b/EgtStoneLib/EstPhoto.vb @@ -17,34 +17,47 @@ Imports EgtWPFLib5 Module EstPhoto - Friend Function LoadPhoto(sPath As String, - ByRef nSlabId As Integer, ByRef sBlockCode As String, ByRef sSlabCode As String, ByRef sSlabName As String, ByRef sMat As String) As Boolean + ' Offset aggiuntivi per fotografia + Private m_dPhotoOffsetX As Double = 0 + Private m_dPhotoOffsetY As Double = 0 + Private m_dTab2PhotoOffsetX As Double = 0 + Private m_dTab2PhotoOffsetY As Double = 0 + + ' spessore pezzi + 'Private m_dRawHeight As Double = 80 + + Friend ReadOnly Property PhotoOffset As Vector3d + Get + Select Case GetCurrentTable() + Case 2 + Return New Vector3d(m_dTab2PhotoOffsetX, m_dTab2PhotoOffsetY, 0) + Case Else + Return New Vector3d(m_dPhotoOffsetX, m_dPhotoOffsetY, 0) + End Select + End Get + End Property + + Friend Function LoadPhoto(sPath As String) As Boolean ' Verifico esistenza file immagine If Not File.Exists(sPath) Then Return False ' Leggo eventuale file dati aggiuntivi - Dim dThick As Double = 0 Dim ptOri As New Point3d(0, 0, 0) Dim ptCen As New Point3d(0, 0, INFINITO) Dim dMMxPixel As Double = 1 - Dim dCoeff As Double = 1 - If Not ReadAuxData(sPath, nSlabId, sBlockCode, sSlabCode, sSlabName, sMat, dThick, ptOri, ptCen, dMMxPixel, dCoeff) Then Return False + ReadAuxData(sPath, ptOri, ptCen, dMMxPixel) ' Aggiungo eventuali offset - ptOri += CurrentMachine.PhotoOffset - ptCen += CurrentMachine.PhotoOffset - ' Imposto eventuale spezzore grezzo - If dThick > EPS_SMALL Then - OmagOFFICEMap.refRawPartTabVM.Height = DoubleToString( dThick, 3) - End If + ptOri += PhotoOffset + ptCen += PhotoOffset ' Altezza eventuale tavola aggiuntiva - Dim dAddTable As Double = CurrentMachine.dAdditionalTable + 'Dim dAddTable As Double = m_MainWindow.m_CurrentMachine.dAdditionalTable ' Aggiusto dati per spessore grezzo - If Math.Abs(EstCalc.GetRawHeight() + dAddTable) > EPS_SMALL Then + If Math.Abs(EstCalc.GetRawHeight()) > EPS_SMALL Then ' Coefficiente di scalatura - Dim dFsca As Double = (ptCen.z - EstCalc.GetRawHeight() - dAddTable) / (ptCen.z - ptOri.z) + Dim dFsca As Double = (ptCen.z - EstCalc.GetRawHeight()) / (ptCen.z - ptOri.z) dMMxPixel *= dFsca ptOri.x = ptCen.x + (ptOri.x - ptCen.x) * dFsca ptOri.y = ptCen.y + (ptOri.y - ptCen.y) * dFsca - ptOri.z = EstCalc.GetRawHeight() + dAddTable + ptOri.z = EstCalc.GetRawHeight() + 0.05 End If ' Recupero origine della tavola e porto i punti in globale Dim ptTab As Point3d @@ -52,9 +65,8 @@ Module EstPhoto ptOri.ToGlob(New Frame3d(ptTab)) ptCen.ToGlob(New Frame3d(ptTab)) ' Recupero le dimensioni della tavola - Dim b3Tab As New BBox3d - If Not EgtGetTableArea(1, b3Tab) Then Return False - b3Tab.Expand(100, 100, 0) + Dim ptMin, ptMax As Point3d + If Not EgtGetTableArea(1, ptMin, ptMax) Then Return False ' Elimino eventuale precedente foto Dim nOldPhotoId = GetPhoto() If nOldPhotoId <> GDB_ID.NULL Then EgtErase(nOldPhotoId) @@ -67,85 +79,54 @@ Module EstPhoto End If EgtSetLevel(nPhGrpId, GDB_LV.SYSTEM) ' Carico la fotografia - Return EgtAddPhoto(GetPhotoName(), sPath, ptOri, ptCen, dMMxPixel, nPhGrpId, b3Tab.Min(), b3Tab.Max()) <> GDB_ID.NULL + Return EgtAddPhoto(PHOTO_NAME, sPath, ptOri, ptCen, dMMxPixel, nPhGrpId, ptMin, ptMax) <> GDB_ID.NULL End Function Friend Function LoadContour(sPath As String) As Boolean ' Elimino eventuale vecchio contorno RemoveContour() + ' Verifico esistenza file contorno + If Not File.Exists(sPath) Then Return False ' Leggo eventuale file dati aggiuntivi - Dim nSlabId As Integer = 0 - Dim sBlockCode As String = "" - Dim sSlabCode As String = "" - Dim sSlabName As String = "" - Dim sMat As String = "" - Dim dThick As Double = 0 Dim ptOri As New Point3d(0, 0, 0) Dim ptCen As New Point3d(0, 0, INFINITO) Dim dMMxPixel As Double = 1 - Dim dCoeff As Double = 1 - If Not ReadAuxData(sPath, nSlabId, sBlockCode, sSlabCode, sSlabName, sMat, dThick, ptOri, ptCen, dMMxPixel, dCoeff) Then Return False + ReadAuxData(sPath, ptOri, ptCen, dMMxPixel) ' Aggiungo eventuali offset - ptOri += CurrentMachine.PhotoOffset - ptCen += CurrentMachine.PhotoOffset - ' Recupero dimensione della immagine originale della fotografia + ptOri += PhotoOffset + ptCen += PhotoOffset + ' Recupero dimensione della immagine da cui è stata derivata la fotografia Dim nPixelX As Integer = 0 Dim nPixelY As Integer = 0 If Not EgtGetPhotoImagePixels(GetPhoto(), nPixelX, nPixelY) Then Return False ' Altezza eventuale tavola aggiuntiva - Dim dAddTable As Double = CurrentMachine.dAdditionalTable + 'Dim dAddTable As Double = m_MainWindow.m_CurrentMachine.dAdditionalTable ' Aggiusto dati per spessore grezzo - If Math.Abs(EstCalc.GetRawHeight() + dAddTable) > EPS_SMALL Then + If Math.Abs(EstCalc.GetRawHeight()) > EPS_SMALL Then ' Coefficiente di scalatura - Dim dFsca As Double = (ptCen.z - EstCalc.GetRawHeight() - dAddTable) / (ptCen.z - ptOri.z) + Dim dFsca As Double = (ptCen.z - EstCalc.GetRawHeight()) / (ptCen.z - ptOri.z) dMMxPixel *= dFsca ptOri.x = ptCen.x + (ptOri.x - ptCen.x) * dFsca ptOri.y = ptCen.y + (ptOri.y - ptCen.y) * dFsca - ptOri.z = EstCalc.GetRawHeight() + dAddTable + ptOri.z = EstCalc.GetRawHeight() End If ' Recupero origine della tavola e porto i punti in globale Dim ptTab As Point3d If Not EgtGetTableRef(1, ptTab) Then Return False ptOri.ToGlob(New Frame3d(ptTab)) ptCen.ToGlob(New Frame3d(ptTab)) - ' Verifico coefficiente scalatura Pixel (per MapaScan, normalmente 1) - If dCoeff < EPS_SMALL Then - EgtOutLog("ReadContour : coefficiente di scalatura pixel nullo") - Return False - End If - - ' Se esiste file dxf lancio lettore standard, altrimenti quello personalizzato - Dim nCrvId As Integer = GDB_ID.NULL - Dim sCntPath As String = Path.ChangeExtension(sPath, ".dxf") - If My.Computer.FileSystem.FileExists(sCntPath) Then - nCrvId = LoadStandardContour(sCntPath, ptOri, dMMxPixel, nPixelY, dCoeff) - Else - nCrvId = LoadCustomContour(sPath, ptOri, dMMxPixel, nPixelY, dCoeff) - End If - ' Eseguo le semplificazioni - Dim nApprType As Integer = APP_TYPE.LEFT_LINES - Dim dTol As Double = GetMainPrivateProfileDouble(S_CAMERA, K_CAM_TOLERANCE, 5) - EgtApproxCurve(nCrvId, nApprType, dTol) - Dim ptNew As Point3d - EgtMidPoint(nCrvId, ptNew) - EgtChangeClosedCurveStartPoint(nCrvId, ptNew) - EgtApproxCurve(nCrvId, nApprType, dTol) - Return True - End Function - - Private Function LoadStandardContour(sPath As String, ptOri As Point3d, dMMxPixel As Double, nPixelY As Integer, dCoeff As Double) As Integer ' Carico Dxf del contorno - If Not EgtImportDxf(sPath, 1) Then Return GDB_ID.NULL + If Not EgtImportDxf(sPath, 1) Then Return False Dim nPartId As Integer = EgtGetLastPart() Dim nLayerId As Integer = EgtGetFirstLayer(nPartId) EgtSetName(nPartId, NAME_RAW_PHOTO_OUTLINE) EgtSetLevel(nPartId, GDB_LV.SYSTEM) - If nPartId = GDB_ID.NULL Or nLayerId = GDB_ID.NULL Then Return GDB_ID.NULL + EgtSetColor(nPartId, New Color3d(0, 255, 0)) + If nPartId = GDB_ID.NULL Or nLayerId = GDB_ID.NULL Then Return False ' Ribalto rispetto a YZ locale (i contorni da CW diventano CCW) - EgtMirror(nLayerId, New Point3d(0, nPixelY * dCoeff / 2, 0), Vector3d.Y_AX(), GDB_RT.GLOB) + EgtMirror(nLayerId, New Point3d(0, nPixelY / 2, 0), Vector3d.Y_AX(), GDB_RT.GLOB) ' Eseguo scalatura - Dim dScaCoeff As Double = dMMxPixel / dCoeff - EgtScale(nLayerId, New Frame3d(), dScaCoeff, dScaCoeff, dScaCoeff, GDB_RT.GLOB) + EgtScale(nLayerId, New Frame3d(), dMMxPixel, dMMxPixel, dMMxPixel, GDB_RT.GLOB) ' Eseguo spostamento EgtMove(nLayerId, (ptOri - Point3d.ORIG()), GDB_RT.GLOB) ' Eseguo concatenamento @@ -168,61 +149,133 @@ Module EstPhoto nCurrCrvId = EgtGetNext(nCurrCrvId) End If End While - EgtSetColor(nCrvId, New Color3d(0, 255, 0)) - Return nCrvId + If nCrvId = GDB_ID.NULL Then Return False + ' Eseguo le semplificazioni + Dim nApprType As Integer = APP_TYPE.RIGHT_LINES + Dim dTol As Double = Map.refMainWindowVM.m_Camera.Tolerance + EgtApproxCurve(nCrvId, nApprType, dTol) + Dim ptNew As Point3d + EgtMidPoint(nCrvId, ptNew) + EgtChangeClosedCurveStartPoint(nCrvId, ptNew) + EgtApproxCurve(nCrvId, nApprType, dTol) + Return True End Function - Private Function LoadCustomContour(sPath As String, ptOri As Point3d, dMMxPixel As Double, nPixelY As Integer, dCoeff As Double) As Integer - ' Definizione variabili - EgtLuaCreateGlobTable("RCT") - EgtLuaSetGlobStringVar("RCT.FILE", sPath) - ' Esecuzione - Dim nErr As Integer = 999 - If EgtLuaExecFile(OmagOFFICEMap.refMainWindowVM.MainWindowM.sImgAutoDir & "\ReadContour.lua") AndAlso - EgtLuaCallFunction("RCT.ReadContour") Then - ' Verifica stato di errore - EgtLuaGetGlobIntVar("RCT.ERR", nErr) - End If - If nErr <> 0 Then - EgtOutLog("Error in ReadContour : " & nErr.ToString()) - Return GDB_ID.NULL - End If - ' Leggo i risultati - Dim nPartId As Integer = GDB_ID.NULL - EgtLuaGetGlobIntVar("RCT.PARTID", nPartId) - If nPartId = GDB_ID.NULL Then Return GDB_ID.NULL - EgtSetName(nPartId, NAME_RAW_PHOTO_OUTLINE) - EgtSetLevel(nPartId, GDB_LV.SYSTEM) - Dim nCrvId As Integer = GDB_ID.NULL - EgtLuaGetGlobIntVar("RCT.CRVID", nCrvId) - EgtLuaResetGlobVar("RCT") - If nCrvId = GDB_ID.NULL Then Return GDB_ID.NULL - EgtSetColor(nCrvId, New Color3d(0, 255, 0)) - ' Ribalto rispetto a YZ locale (i contorni da CW diventano CCW) - EgtMirror(nCrvId, New Point3d(0, nPixelY * dCoeff / 2, 0), Vector3d.Y_AX(), GDB_RT.GLOB) - ' Eseguo scalatura - Dim dScaCoeff As Double = dMMxPixel / dCoeff - EgtScale(nCrvId, New Frame3d(), dScaCoeff, dScaCoeff, dScaCoeff, GDB_RT.GLOB) - ' Eseguo spostamento - EgtMove(nCrvId, (ptOri - Point3d.ORIG()), GDB_RT.GLOB) - ' Deve essere CCW - Dim dArea As Double = 0 - If EgtCurveAreaXY(nCrvId, dArea) AndAlso dArea < 0 Then - EgtInvertCurve(nCrvId) - End If - Return nCrvId - End Function + 'Private Function LoadStandardContour(sPath As String, ptOri As Point3d, dMMxPixel As Double, nPixelY As Integer, dCoeff As Double) As Integer + ' ' Carico Dxf del contorno + ' If Not EgtImportDxf(sPath, 1) Then Return GDB_ID.NULL + ' Dim nPartId As Integer = EgtGetLastPart() + ' Dim nLayerId As Integer = EgtGetFirstLayer(nPartId) + ' EgtSetName(nPartId, NAME_RAW_PHOTO_OUTLINE) + ' EgtSetLevel(nPartId, GDB_LV.SYSTEM) + ' If nPartId = GDB_ID.NULL Or nLayerId = GDB_ID.NULL Then Return GDB_ID.NULL + ' ' Ribalto rispetto a YZ locale (i contorni da CW diventano CCW) + ' EgtMirror(nLayerId, New Point3d(0, nPixelY * dCoeff / 2, 0), Vector3d.Y_AX(), GDB_RT.GLOB) + ' ' Eseguo scalatura + ' Dim dScaCoeff As Double = dMMxPixel / dCoeff + ' EgtScale(nLayerId, New Frame3d(), dScaCoeff, dScaCoeff, dScaCoeff, GDB_RT.GLOB) + ' ' Eseguo spostamento + ' EgtMove(nLayerId, (ptOri - Point3d.ORIG()), GDB_RT.GLOB) + ' ' Eseguo concatenamento + ' EgtSelectGroupObjs(nLayerId) + ' EgtCreateCurveCompoByReorder(nLayerId, 1, {GDB_ID.SEL}, New Point3d(), True) + ' ' Conservo la curva chiusa di area massima + ' Dim dAreaMax As Double = 0 + ' Dim nCrvId As Integer = GDB_ID.NULL + ' Dim nCurrCrvId As Integer = EgtGetFirstInGroup(nLayerId) + ' While nCurrCrvId <> GDB_ID.NULL + ' Dim dArea As Double = 0 + ' If Not EgtCurveAreaXY(nCurrCrvId, dArea) OrElse dArea <= dAreaMax Then + ' Dim nToEraseId = nCurrCrvId + ' nCurrCrvId = EgtGetNext(nCurrCrvId) + ' EgtErase(nToEraseId) + ' Else + ' dAreaMax = dArea + ' EgtErase(nCrvId) + ' nCrvId = nCurrCrvId + ' nCurrCrvId = EgtGetNext(nCurrCrvId) + ' End If + ' End While + ' EgtSetColor(nCrvId, New Color3d(0, 255, 0)) + ' Return nCrvId + 'End Function + + 'Private Function LoadCustomContour(sPath As String, ptOri As Point3d, dMMxPixel As Double, nPixelY As Integer, dCoeff As Double) As Integer + ' ' Definizione variabili + ' EgtLuaCreateGlobTable("RCT") + ' EgtLuaSetGlobStringVar("RCT.FILE", sPath) + ' ' Esecuzione + ' Dim nErr As Integer = 999 + ' If EgtLuaExecFile(OmagOFFICEMap.refMainWindowVM.MainWindowM.sImgAutoDir & "\ReadContour.lua") AndAlso + ' EgtLuaCallFunction("RCT.ReadContour") Then + ' ' Verifica stato di errore + ' EgtLuaGetGlobIntVar("RCT.ERR", nErr) + ' End If + ' If nErr <> 0 Then + ' EgtOutLog("Error in ReadContour : " & nErr.ToString()) + ' Return GDB_ID.NULL + ' End If + ' ' Leggo i risultati + ' Dim nPartId As Integer = GDB_ID.NULL + ' EgtLuaGetGlobIntVar("RCT.PARTID", nPartId) + ' If nPartId = GDB_ID.NULL Then Return GDB_ID.NULL + ' EgtSetName(nPartId, NAME_RAW_PHOTO_OUTLINE) + ' EgtSetLevel(nPartId, GDB_LV.SYSTEM) + ' Dim nCrvId As Integer = GDB_ID.NULL + ' EgtLuaGetGlobIntVar("RCT.CRVID", nCrvId) + ' EgtLuaResetGlobVar("RCT") + ' If nCrvId = GDB_ID.NULL Then Return GDB_ID.NULL + ' EgtSetColor(nCrvId, New Color3d(0, 255, 0)) + ' ' Ribalto rispetto a YZ locale (i contorni da CW diventano CCW) + ' EgtMirror(nCrvId, New Point3d(0, nPixelY * dCoeff / 2, 0), Vector3d.Y_AX(), GDB_RT.GLOB) + ' ' Eseguo scalatura + ' Dim dScaCoeff As Double = dMMxPixel / dCoeff + ' EgtScale(nCrvId, New Frame3d(), dScaCoeff, dScaCoeff, dScaCoeff, GDB_RT.GLOB) + ' ' Eseguo spostamento + ' EgtMove(nCrvId, (ptOri - Point3d.ORIG()), GDB_RT.GLOB) + ' ' Deve essere CCW + ' Dim dArea As Double = 0 + ' If EgtCurveAreaXY(nCrvId, dArea) AndAlso dArea < 0 Then + ' EgtInvertCurve(nCrvId) + ' End If + ' Return nCrvId + 'End Function Private Function ReadAuxData(sPath As String, - ByRef nSlabId As Integer, ByRef sBlockCode As String, ByRef sSlabCode As String, ByRef sSlabName As String, ByRef sMat As String, - ByRef dThick As Double, ByRef ptOri As Point3d, ByRef ptCen As Point3d, ByRef dMMxPixel As Double, ByRef dCoeff As Double) As Boolean - ' Se esiste file txt lancio lettore standard, altrimenti quello personalizzato + ByRef ptOri As Point3d, ByRef ptCen As Point3d, ByRef dMMxPixel As Double) As Boolean Dim sAuxPath As String = Path.ChangeExtension(sPath, ".txt") - If My.Computer.FileSystem.FileExists(sAuxPath) Then - Return ReadStandardAuxData(sAuxPath, nSlabId, sBlockCode, sSlabCode, sSlabName, sMat, dThick, ptOri, ptCen, dMMxPixel, dCoeff) - Else - Return ReadCustomAuxData(sPath, nSlabId, sBlockCode, sSlabCode, sSlabName, sMat, dThick, ptOri, ptCen, dMMxPixel, dCoeff) - End If + Try + Dim sLine As String = String.Empty + Dim sr As StreamReader = New StreamReader(sAuxPath) + Do While sr.Peek() > -1 + sLine = sr.ReadLine() + sLine = sLine.Replace(" ", "") + If sLine.StartsWith("X=") Then + StringToDouble(sLine.Substring(2), ptOri.x) + ElseIf sLine.StartsWith("Y=") Then + StringToDouble(sLine.Substring(2), ptOri.y) + ElseIf sLine.StartsWith("Z_Lastra=") Then + StringToDouble(sLine.Substring(9), ptOri.z) + ElseIf sLine.StartsWith("X_ScaleCenter=") Then + StringToDouble(sLine.Substring(14), ptCen.x) + ElseIf sLine.StartsWith("Y_ScaleCenter=") Then + StringToDouble(sLine.Substring(14), ptCen.y) + ElseIf sLine.StartsWith("Z_ScaleCenter=") Then + StringToDouble(sLine.Substring(14), ptCen.z) + ElseIf sLine.StartsWith("Pixelxmm=") Then + Dim dTmp As Double + StringToDouble(sLine.Substring(9), dTmp) + If dTmp > EPS_SMALL Then + dMMxPixel = 1 / dTmp + End If + End If + Loop + sr.Close() + Return True + Catch ex As Exception + EgtOutLog("LoadPhoto Error on auxfile : " & sAuxPath) + Return False + End Try End Function Private Function ReadStandardAuxData(sAuxPath As String, @@ -269,37 +322,37 @@ Module EstPhoto End Try End Function - Private Function ReadCustomAuxData(sPath As String, - ByRef nSlabId As Integer, ByRef sBlockCode As String, ByRef sSlabCode As String, ByRef sSlabName As String, ByRef sMat As String, - ByRef dThick As Double, ByRef ptOri As Point3d, ByRef ptCen As Point3d, ByRef dMMxPixel As Double, ByRef dCoeff As Double) As Boolean - ' Definizione variabili - EgtLuaCreateGlobTable("RDT") - EgtLuaSetGlobStringVar("RDT.FILE", sPath) - ' Esecuzione - Dim nErr As Integer = 999 - If EgtLuaExecFile(OmagOFFICEMap.refMainWindowVM.MainWindowM.sImgAutoDir & "\ReadData.lua") AndAlso - EgtLuaCallFunction("RDT.ReadData") Then - ' Verifica stato di errore - EgtLuaGetGlobIntVar("RDT.ERR", nErr) - End If - If nErr <> 0 Then - EgtOutLog("Error in ReadData : " & nErr.ToString()) - Return False - End If - ' Leggo i risultati - If Not EgtLuaGetGlobIntVar("RDT.SLABID", nSlabId) Then nSlabId = 0 - If Not EgtLuaGetGlobStringVar("RDT.SLABNAME", sSlabName) Then sSlabName = String.Empty - If Not EgtLuaGetGlobStringVar("RDT.BLOCKCODE", sBlockCode) Then sBlockCode = String.Empty - If Not EgtLuaGetGlobStringVar("RDT.SLABCODE", sSlabCode) Then sSlabCode = String.Empty - If Not EgtLuaGetGlobStringVar("RDT.MATERIAL", sMat) Then sMat = String.Empty - if Not EgtLuaGetGlobNumVar("RDT.TH", dThick) Then dThick = 0 - EgtLuaGetGlobPointVar("RDT.ORI", ptOri) - EgtLuaGetGlobPointVar("RDT.CEN", ptCen) - EgtLuaGetGlobNumVar("RDT.COEFF", dCoeff) - EgtLuaGetGlobNumVar("RDT.MMXPIXEL", dMMxPixel) - EgtLuaResetGlobVar("RDT") - Return True - End Function + 'Private Function ReadCustomAuxData(sPath As String, + ' ByRef nSlabId As Integer, ByRef sBlockCode As String, ByRef sSlabCode As String, ByRef sSlabName As String, ByRef sMat As String, + ' ByRef dThick As Double, ByRef ptOri As Point3d, ByRef ptCen As Point3d, ByRef dMMxPixel As Double, ByRef dCoeff As Double) As Boolean + ' ' Definizione variabili + ' EgtLuaCreateGlobTable("RDT") + ' EgtLuaSetGlobStringVar("RDT.FILE", sPath) + ' ' Esecuzione + ' Dim nErr As Integer = 999 + ' If EgtLuaExecFile(OmagOFFICEMap.refMainWindowVM.MainWindowM.sImgAutoDir & "\ReadData.lua") AndAlso + ' EgtLuaCallFunction("RDT.ReadData") Then + ' ' Verifica stato di errore + ' EgtLuaGetGlobIntVar("RDT.ERR", nErr) + ' End If + ' If nErr <> 0 Then + ' EgtOutLog("Error in ReadData : " & nErr.ToString()) + ' Return False + ' End If + ' ' Leggo i risultati + ' If Not EgtLuaGetGlobIntVar("RDT.SLABID", nSlabId) Then nSlabId = 0 + ' If Not EgtLuaGetGlobStringVar("RDT.SLABNAME", sSlabName) Then sSlabName = String.Empty + ' If Not EgtLuaGetGlobStringVar("RDT.BLOCKCODE", sBlockCode) Then sBlockCode = String.Empty + ' If Not EgtLuaGetGlobStringVar("RDT.SLABCODE", sSlabCode) Then sSlabCode = String.Empty + ' If Not EgtLuaGetGlobStringVar("RDT.MATERIAL", sMat) Then sMat = String.Empty + ' if Not EgtLuaGetGlobNumVar("RDT.TH", dThick) Then dThick = 0 + ' EgtLuaGetGlobPointVar("RDT.ORI", ptOri) + ' EgtLuaGetGlobPointVar("RDT.CEN", ptCen) + ' EgtLuaGetGlobNumVar("RDT.COEFF", dCoeff) + ' EgtLuaGetGlobNumVar("RDT.MMXPIXEL", dMMxPixel) + ' EgtLuaResetGlobVar("RDT") + ' Return True + 'End Function Public Function GetPhotoName() As String ' Recupero il nome del gruppo di lavoro corrente @@ -313,7 +366,8 @@ Module EstPhoto ' Recupero Id del gruppo delle foto Dim nPhGrpId As Integer = EgtGetFirstNameInGroup(GDB_ID.ROOT, PHOTO_GRP) ' Recupero Id della foto - Return EgtGetFirstNameInGroup(nPhGrpId, GetPhotoName()) + ' Return EgtGetFirstNameInGroup(nPhGrpId, GetPhotoName()) + Return EgtGetFirstNameInGroup(nPhGrpId, PHOTO_NAME) End Function Public Function GetPhotoTexturePath() As String @@ -386,14 +440,16 @@ Module EstPhoto ptOri.ToLoc(New Frame3d(ptTab)) ptCen.ToLoc(New Frame3d(ptTab)) ' Altezza eventuale tavola aggiuntiva - Dim dAddTable As Double = CurrentMachine.dAdditionalTable + 'Dim dAddTable As Double = CurrentMachine.dAdditionalTable ' Aggiusto dati per spessore grezzo (Coefficiente di scalatura) - Dim dFsca As Double = (ptCen.z - EstCalc.GetRawHeight() - dAddTable) / (ptCen.z - ptOri.z) + ' (ptCen.z - EstCalc.GetRawHeight() - dAddTable) + Dim dFsca As Double = (ptCen.z - EstCalc.GetRawHeight()) / (ptCen.z - ptOri.z) dDimX *= dFsca dDimY *= dFsca ptOri.x = ptCen.x + (ptOri.x - ptCen.x) * dFsca ptOri.y = ptCen.y + (ptOri.y - ptCen.y) * dFsca - ptOri.z = EstCalc.GetRawHeight() + dAddTable + ' ptOri.z = EstCalc.GetRawHeight() + dAddTable + ptOri.z = EstCalc.GetRawHeight() ' Porto i punti in globale ptOri.ToGlob(New Frame3d(ptTab)) ptCen.ToGlob(New Frame3d(ptTab)) @@ -483,16 +539,16 @@ Module EstPhoto Dim ptTab As Point3d If Not EgtGetTableRef(1, ptTab) Then Return False ' Altezza eventuale tavola aggiuntiva - Dim dAddTable As Double = CurrentMachine.dAdditionalTable + 'Dim dAddTable As Double = CurrentMachine.dAdditionalTable ' Recupero inizio contorno Dim ptStart As Point3d EgtStartPoint(nCrvId, GDB_ID.ROOT, ptStart) ' Calcolo coefficiente di scalatura - Dim dFsca As Double = (ptCen.z - ptTab.z - EstCalc.GetRawHeight() - dAddTable) / (ptCen.z - ptStart.z) + Dim dFsca As Double = (ptCen.z - ptTab.z - EstCalc.GetRawHeight()) / (ptCen.z - ptStart.z) ' Scalo opportunamente EgtScale(nCrvId, New Frame3d(ptCen), dFsca, dFsca, 1, GDB_RT.GLOB) ' Sposto in Z - Dim vtMove As New Vector3d(0, 0, ptTab.z + EstCalc.GetRawHeight() + dAddTable - ptStart.z) + Dim vtMove As New Vector3d(0, 0, ptTab.z + EstCalc.GetRawHeight() - ptStart.z) EgtMove(nCrvId, vtMove, GDB_RT.GLOB) Return True End Function diff --git a/EgtStoneLib/GeomCalc.vb b/EgtStoneLib/GeomCalc.vb index 2eeb6b5..b9004c7 100644 --- a/EgtStoneLib/GeomCalc.vb +++ b/EgtStoneLib/GeomCalc.vb @@ -112,4 +112,21 @@ Module GeomCalc Return ptResult End Function + ' restituisce l'Id della regione del pezzo + Public Function GetRegionFromPart(IdPart As Integer) As Integer + Dim nRegId As Integer = EgtGetFirstNameInGroup(IdPart, ConstGen.NAME_REGION) + If nRegId = GDB_ID.NULL Then + Return -1 + End If + ' Cerco prima regione nel layer + Dim nId = EgtGetFirstInGroup(nRegId) + While nId <> GDB_ID.NULL + If EgtGetType(nId) = GDB_TY.SRF_FRGN Then + Return nId + End If + nId = EgtGetNext(nId) + End While + Return -1 + End Function + End Module diff --git a/EgtStoneLib/VacuumCups.vb b/EgtStoneLib/VacuumCups.vb index a384c61..fcdbd14 100644 --- a/EgtStoneLib/VacuumCups.vb +++ b/EgtStoneLib/VacuumCups.vb @@ -333,7 +333,7 @@ Module VacuumCups b3Kerf As BBox3d, ptKerfCen As Point3d, nOutlineId As Integer, nRKerfId As Integer, ByRef rmData As RawMoveData, Optional sNameHead As String = VACUUM_HEAD) As Boolean ' Cerco migliore configurazione di ventose per prendere il grezzo - Const MAX_SEL As Integer = 20 + Const MAX_SEL As Integer = 24 For nI As Integer = 1 To MAX_SEL ' Recupero la configurazione di ventose nI-esima Dim sCups() As String = Nothing @@ -354,18 +354,33 @@ Module VacuumCups Dim bFirstSelection As Boolean = MyVacuumTest(sCups, b3Kerf, ptKerfCen, nOutlineId, nRKerfId, vtMove, ptRotCen, dRotAngDeg, sNameHead) Dim bSecondSelection As Boolean = False If Not bFirstSelection Then + ' se la prima selezione fallisce allora provo con un'altra complementare bSecondSelection = MyVacuumTest(sCups2, b3Kerf, ptKerfCen, nOutlineId, nRKerfId, vtMove2, ptRotCen2, dRotAngDeg2, sNameHead) End If If bSecondSelection Then + ' se la nuova selezione funziona allora salvo sCups = sCups2 vtMove = vtMove2 ptRotCen = ptRotCen2 dRotAngDeg = dRotAngDeg2 + rmData.m_bCupsSecondSel = True End If + ' se nessuna delle due proposte soluzioni ha funzionato allora provo con un'altra If Not bFirstSelection And Not bSecondSelection Then Continue For Else - ' se pallettizzatore imposto come angolo privilegiato C180 + ' se tavola 2 allora pallettizzatore imposto come angolo privilegiato C180 m_dPreferredRot = 180 + ' correggo l'uso delle ventose + If rmData.m_vtRect.x * 2 >= Map.refUnloadingAreaVM.MaxLength And Not IsNothing(sCups) Then + If sCups.Count = 1 Then + If Trim(sCups(0)) = "V4" Then Continue For + End If + ElseIf rmData.m_vtRect.x * 2 < Map.refUnloadingAreaVM.MaxLength And Not IsNothing(sCups) Then + ' se pezzo da depositare sui pallet + If sCups.Count = 2 Then + If ((sCups(0).Contains("V3") And sCups(1).Contains("V1")) Or (sCups(0).Contains("V1") And sCups(1).Contains("V3"))) Then Continue For + End If + End If dDist = TestVacuumCupSelection(sCups, b3Kerf, ptKerfCen, nOutlineId, nRKerfId, vtMove, ptRotCen, dRotAngDeg) If dDist > INFINITO - 1 Then Continue For End If @@ -378,8 +393,17 @@ Module VacuumCups ' dRotAngDeg = dRotAngDeg2 'End If - ' Eseguo il movimento + ' Eseguo il movimento della ventosa + + '' rappresento graficamente l'afferraggio dei pezzi + 'EgtSetMachineLook(MCH_LOOK.TAB_HEAD) + 'EgtSetAxisPos("X1", ptRawCen.x + 25) + 'EgtSetAxisPos("Y", ptRawCen.y - 729) + 'EgtSetAxisPos("W1", dRotAngDeg) + 'EgtDraw() + EgtMove(m_nVacId, vtMove, GDB_RT.GLOB) + ' allineo la ventosa EgtRotate(m_nVacId, ptRotCen, Vector3d.Z_AX(), dRotAngDeg, GDB_RT.GLOB) ' Visualizzo le ventose For nJ As Integer = 0 To sCups.Length() - 1 @@ -392,6 +416,8 @@ Module VacuumCups Dim vtDelta As Vector3d = frCurrRef.Orig() - ptRawCen ' correggo le coordinate (x,y) considerando il centro del minimo rettangolo Dim vtOffsetCenter As Vector3d = ptRawCen - rmData.m_ptCenMinRect + + ' la quota zeta in realtà è ignorata Dim zDelta As Double = vtDelta.z vtDelta = vtDelta + vtOffsetCenter ' reimposto il valore della z @@ -409,10 +435,11 @@ Module VacuumCups sVal &= "," & sCup End If Next + rmData.m_sCups = sVal - ' Eseguo il movimento + ' riposiziono la ventosa nel punto di partenza EgtMove(m_nVacId, -vtMove, GDB_RT.GLOB) - frCurrRef.Move(-vtMove) + ' controruoto la ventosa per tornare alla posizione di partenza EgtRotate(m_nVacId, ptRotCen, Vector3d.Z_AX(), -dRotAngDeg, GDB_RT.GLOB) frCurrRef.Rotate(ptRotCen, Vector3d.Z_AX(), -dRotAngDeg) Return True @@ -424,6 +451,7 @@ Module VacuumCups ByRef vtMove As Vector3d, ByRef ptRotCen As Point3d, ByRef dRotAngDeg As Double, sNameHead As String) As Boolean Dim dDist = TestVacuumCupSelection(sCups, b3Raw, ptRawCen, nOutlineId, nRawRegId, vtMove, ptRotCen, dRotAngDeg) If dDist < INFINITO - 1 Then + ' costruisco una copia del riferimento Dim frCurrRefTemp As New Frame3d EgtFrame(m_nRefId, GDB_ID.ROOT, frCurrRefTemp) @@ -432,9 +460,11 @@ Module VacuumCups ' calcolo l'offset dal centro del pezzo Dim vtDeltaTest As Vector3d = frCurrRefTemp.Orig() - ptRawCen ' dimensioni tavola - Dim MinX, MaxY As Double + Dim MinX, MaxY, MaxX, MinY As Double EgtGetInfo(EgtGetTableId(MAIN_TAB), "MaxTabY", MaxY) EgtGetInfo(EgtGetTableId(MAIN_TAB), "MinTabX", MinX) + EgtGetInfo(EgtGetTableId(MAIN_TAB), "MinTabY", MinY) + EgtGetInfo(EgtGetTableId(MAIN_TAB), "MaxTabX", MaxX) ' allineo il riferimeno della ventosa frCurrRefTemp.Rotate(ptRawCen, Vector3d.Z_AX, dRotAngDeg) vtDeltaTest.Rotate(Vector3d.Z_AX, dRotAngDeg) @@ -452,10 +482,10 @@ Module VacuumCups If bVerifyStroke Then Dim b3BoxVacuum As New BBox3d EgtGetBBoxGlob(m_nVacId, GDB_BB.STANDARD, b3BoxVacuum) - If b3BoxVacuum.Min.x < MinX Then + If b3BoxVacuum.Min.x < MinX Or b3BoxVacuum.Max.x > MaxX Then bVerifyStroke = False End If - If b3BoxVacuum.Max.y > MaxY Then + If b3BoxVacuum.Max.y > MaxY Or b3BoxVacuum.Min.y < MinY Then bVerifyStroke = False End If End If @@ -482,10 +512,10 @@ Module VacuumCups ' verifico di no sbattere contro la macchina Dim b3BoxVacuum As New BBox3d EgtGetBBoxGlob(m_nVacId, GDB_BB.STANDARD, b3BoxVacuum) - If b3BoxVacuum.Min.x < MinX Then + If b3BoxVacuum.Min.x < MinX Or b3BoxVacuum.Max.x > MaxX Then bVerifyStroke = False End If - If b3BoxVacuum.Max.y > MaxY Then + If b3BoxVacuum.Max.y > MaxY Or b3BoxVacuum.Min.y < MinY Then bVerifyStroke = False End If EgtRotate(m_nVacId, ptRawCen, Vector3d.Z_AX, -dRotAngDeg, GDB_RT.GLOB) @@ -513,7 +543,7 @@ Module VacuumCups If sVal.IndexOf("/") >= 0 Then Dim sSplit() As String = sVal.Split("/".ToCharArray) If sSplit.Length() >= 2 Then - ' slavo la prima selezione: v1,V2 + ' slavo la prima selezione: V1,V2 sCups = sSplit(0).Split(",".ToCharArray) ' salvo la seconda selezione: V5,V6 sCups2 = sSplit(1).Split(",".ToCharArray) @@ -870,6 +900,8 @@ Public Class RawMoveData Public m_vtOrtoDirX As New Vector3d ' centro del rettangolo minimo Public m_ptCenMinRect As New Point3d + ' posizione ventose perpendicolari + Public m_bCupsSecondSel As Boolean = False Sub New() m_nId = GDB_ID.NULL diff --git a/MainWindow/Camera.vb b/MainWindow/Camera.vb new file mode 100644 index 0000000..796be27 --- /dev/null +++ b/MainWindow/Camera.vb @@ -0,0 +1,431 @@ +'---------------------------------------------------------------------------- +' EgalTech 2015-2015 +'---------------------------------------------------------------------------- +' File : Camera.vb Data : 08.10.15 Versione : 1.6j1 +' Contenuto : Classe Camera (gestione della macchina fotografica). +' +' +' +' Modifiche : 08.10.15 DS Creazione modulo. +' +' +'---------------------------------------------------------------------------- + +Imports System.Threading +Imports System.IO +Imports EgtUILib +Imports EgtWPFLib5 + +Public Class Camera + + ' Riferimento alla MainWindow + 'Private m_MainWindow As MainWindow = DirectCast(Application.Current.MainWindow, MainWindow) + + ' Dati + Private m_bCameraLink As Boolean = False + Private m_bCalcContour As Boolean = False + Private m_nCameraCount As Integer = 0 + Private m_sCameraPath As String = String.Empty + Private m_sCameraPath2 As String = String.Empty + Private m_sCameraProcName As String = String.Empty + Private m_sCameraProcName2 As String = String.Empty + Private m_sImage As String = String.Empty + Private m_sImage2 As String = String.Empty + Private m_sInfo As String = String.Empty + Private m_sInfo2 As String = String.Empty + Private m_sResult As String = String.Empty + Private m_sResult2 As String = String.Empty + Private m_sContour As String = String.Empty + Private m_sContour2 As String = String.Empty + Private m_nThreshold As Integer = 60 + Private m_dTolerance As Double = 5 + Private m_nTimeout As Integer = 30 + Private m_sImageDir As String = String.Empty + + ' Flag per foto in esecuzione + Friend m_bBusy As Boolean = False + + Public Function Init() As Boolean + ' Lettura dati di configurazione da file Ini + m_bCameraLink = (GetPrivateProfileInt(S_GENERAL, K_CAMERALINK, 0, IniFile.m_sIniFile) <> 0) + ' Map.refMainWindowVM.MainWindowM.GetKeyOption(KEY_OPT.OFFICE_TYPE) + m_nCameraCount = GetPrivateProfileInt(S_CAMERA, K_CAM_COUNT, 1, IniFile.m_sIniFile) + GetPrivateProfileString(S_CAMERA, K_CAM_EXEPATH, "", m_sCameraPath, IniFile.m_sIniFile) + GetPrivateProfileString(S_CAMERA, K_CAM_IMAGE, "", m_sImage, IniFile.m_sIniFile) + GetPrivateProfileString(S_CAMERA, K_CAM_INFO, "", m_sInfo, IniFile.m_sIniFile) + GetPrivateProfileString(S_CAMERA, K_CAM_RESULT, "", m_sResult, IniFile.m_sIniFile) + GetPrivateProfileString(S_CAMERA, K_CAM_CONTOUR, "", m_sContour, IniFile.m_sIniFile) + GetPrivateProfileString(S_CAMERA, K_CAM_EXEPATH2, "", m_sCameraPath2, IniFile.m_sIniFile) + GetPrivateProfileString(S_CAMERA, K_CAM_IMAGE2, "", m_sImage2, IniFile.m_sIniFile) + GetPrivateProfileString(S_CAMERA, K_CAM_INFO2, "", m_sInfo2, IniFile.m_sIniFile) + GetPrivateProfileString(S_CAMERA, K_CAM_RESULT2, "", m_sResult2, IniFile.m_sIniFile) + GetPrivateProfileString(S_CAMERA, K_CAM_CONTOUR2, "", m_sContour2, IniFile.m_sIniFile) + m_nThreshold = GetPrivateProfileInt(S_CAMERA, K_CAM_THRESHOLD, 60, IniFile.m_sIniFile) + m_dTolerance = GetPrivateProfileDouble(S_CAMERA, K_CAM_TOLERANCE, 5, IniFile.m_sIniFile) + m_nTimeout = GetPrivateProfileInt(S_CAMERA, K_CAM_TIMEOUT, 30, IniFile.m_sIniFile) + GetPrivateProfileString(S_GENERAL, K_IMAGEDIR, "", m_sImageDir, IniFile.m_sIniFile) + ' Verifico abilitazione riconoscimento contorno automatico del grezzo + 'm_bCalcContour = Map.refMainWindowVM.MainWindowM.GetKeyOption(KEY_OPT.MAN_PHOTO) AndAlso (GetPrivateProfileInt(S_GENERAL, K_CONTOURFROMCAMERA, 1, IniFile.m_sIniFile) <> 0) + ' Ricavo il nome del processo associato + m_sCameraProcName = Path.GetFileNameWithoutExtension(m_sCameraPath) + m_sCameraProcName2 = Path.GetFileNameWithoutExtension(m_sCameraPath2) + ' Se camera abilitata, lancio l'esecuzione in cieco + If m_bCameraLink Then + If m_nCameraCount <> 2 Then + Dim bOk As Boolean = True + If Not CameraHide(1) Then + bOk = False + EgtOutLog("CameraMng not starting") + End If + Return bOk + Else + Dim bOk As Boolean = True + If Not CameraHide(1) Then + bOk = False + EgtOutLog("CameraMng 1 not starting") + End If + If Not CameraHide(2) Then + bOk = False + EgtOutLog("CameraMng 2 not starting") + End If + Return bOk + End If + Else + Return True + End If + End Function + + Public Function Close() As Boolean + If m_bBusy Then Return False + If m_bCameraLink Then + If m_nCameraCount <> 2 Then + KillProcess(1) + Else + KillProcess(1) + KillProcess(2) + End If + End If + Return True + End Function + + Public Function GetCalcContour() As Boolean + Return m_bCalcContour + End Function + + Public Function GetCameraLink() As Boolean + Return m_bCameraLink + End Function + + Friend Property Threshold As Integer + Get + Return m_nThreshold + End Get + Set(value As Integer) + ' Porto il valore nel range valido + If value < 10 Then + value = 10 + ElseIf value > 90 Then + value = 90 + End If + ' Se cambiato, aggiorno file INI + If value <> m_nThreshold And + WritePrivateProfileString(S_CAMERA, K_CAM_THRESHOLD, DoubleToString(value, 3), IniFile.m_sIniFile) Then + ' Aggiorno il valore corrente + m_nThreshold = value + End If + End Set + End Property + + Friend Property Tolerance As Double + Get + Return m_dTolerance + End Get + Set(value As Double) + ' Porto il valore nel range valido + If value < 100 * EPS_SMALL Then + value = 100 * EPS_SMALL + End If + ' Se cambiato, aggiorno file INI + If value <> m_dTolerance And + WritePrivateProfileString(S_CAMERA, K_CAM_TOLERANCE, DoubleToString(value, 3), IniFile.m_sIniFile) Then + ' Aggiorno il valore corrente + m_dTolerance = value + End If + End Set + End Property + + Public Function CameraHide(nInd As Integer) As Boolean + ' Lancio il programma in cieco, se già attivo lo nascondo + Try + Process.Start(If(nInd <> 2, m_sCameraPath, m_sCameraPath2), "0") + Return True + Catch ex As Exception + Return False + End Try + End Function + + Public Function CameraShow(nInd As Integer) As Boolean + ' Lancio il programma in modo visibile, se già attivo lo rendo visibile + Try + Process.Start(If(nInd <> 2, m_sCameraPath, m_sCameraPath2), "1") + Return True + Catch ex As Exception + Return False + End Try + End Function + + Public Function CameraTest(nInd As Integer) As Boolean + ' Cancello il risultato + If My.Computer.FileSystem.FileExists(If(nInd <> 2, m_sResult, m_sResult2)) Then + My.Computer.FileSystem.DeleteFile(If(nInd <> 2, m_sResult, m_sResult2)) + End If + ' Lancio il programma per sapere se macchina fotografica collegata + Try + ' Interrogo + Process.Start(If(nInd <> 2, m_sCameraPath, m_sCameraPath2), "3") + ' Ciclo di attesa risultato + Dim nMaxThick = 10 * 4 + For nThick As Integer = 0 To nMaxThick + ' Se esiste il file di risultato + Dim nErr = 999 + If VerifyResult(nInd, nErr) Then + Return (nErr = 0) + End If + ' Aspetto 100 ms + Thread.Sleep(100) + Next + Catch ex As Exception + ' + End Try + Return False + End Function + + Private Function PrepareCamera() As Integer + ' Determino la camera da utilizzare, se più di una (max 2) + Dim nInd As Integer = 1 + If m_nCameraCount = 2 Then + nInd = GetCurrentTable() + If nInd <> 1 And nInd <> 2 Then Return 0 + End If + ' Se gestore macchina non attivo, lo lancio in modo cieco + If Not ProcessIsRunning(nInd) Then + If Not CameraHide(nInd) Then + Return 0 + End If + ' Aspetto 5000 ms + Thread.Sleep(5000) + ' Altrimenti richiedo verifica di camera connessa + Else + If Not CameraTest(nInd) Then + Return 0 + End If + ' Aspetto 100 ms + Thread.Sleep(100) + End If + Return nInd + End Function + + Public Function CameraBackImage() As Boolean + ' Verifiche preliminari + Dim nInd As Integer = PrepareCamera() + If nInd = 0 Then Return False + ' Visualizzo progressbar + m_bBusy = True + 'm_MainWindow.m_CurrentProjectPageUC.PhotoProgress.Visibility = Visibility.Visible + 'm_MainWindow.m_CurrentProjectPageUC.PhotoProgress.Value = 1 + ' Cancellazione eventuali vecchi file rimasti + Try + If My.Computer.FileSystem.FileExists(If(nInd <> 2, m_sResult, m_sResult2)) Then + My.Computer.FileSystem.DeleteFile(If(nInd <> 2, m_sResult, m_sResult2)) + End If + Catch ex As Exception + End Try + ' Scatto una foto come sfondo (il programma deve essere già attivo) + Dim bOk As Boolean = False + Try + Process.Start(If(nInd <> 2, m_sCameraPath, m_sCameraPath2), "4") + bOk = WaitBackImage(nInd) + Catch ex As Exception + bOk = False + End Try + ' Nascondo progressbar + 'm_MainWindow.m_CurrentProjectPageUC.PhotoProgress.Visibility = Visibility.Hidden + m_bBusy = False + Return bOk + End Function + + Private Function WaitBackImage(nInd As Integer) As Boolean + ' Ciclo di ricerca foto scattata + Dim nMaxThick = 10 * m_nTimeout + For nThick As Integer = 0 To nMaxThick + ' Se esiste il file di risultato + Dim nErr = 999 + If VerifyResult(nInd, nErr) Then + If nErr = 0 Then + Return True + Else + EgtOutLog("Camera err=" & nErr.ToString()) + Return False + End If + ' Altrimenti aspetto + Else + ' Imposto ProgressBar + Dim nProgress As Integer = CInt(nThick * 100 / nMaxThick) + 'm_MainWindow.m_CurrentProjectPageUC.PhotoProgress.Value = nProgress + ' Costringo ad aggiornare UI + UpdateUI() + ' Aspetto 100 ms + Thread.Sleep(100) + End If + Next + EgtOutLog("Camera generic error") + ' Chiudo il gestore della macchina per resettarlo + KillProcess(nInd) + Return False + End Function + + Public Function CameraClick() As Boolean + ' Verifiche preliminari + Dim nInd As Integer = PrepareCamera() + If nInd = 0 Then Return False + ' Visualizzo progressbar + m_bBusy = True + 'm_MainWindow.m_CurrentProjectPageUC.PhotoProgress.Visibility = Visibility.Visible + 'm_MainWindow.m_CurrentProjectPageUC.PhotoProgress.Value = 1 + ' Cancellazione eventuali vecchi file rimasti + Try + If My.Computer.FileSystem.FileExists(If(nInd <> 2, m_sResult, m_sResult2)) Then + My.Computer.FileSystem.DeleteFile(If(nInd <> 2, m_sResult, m_sResult2)) + End If + If My.Computer.FileSystem.FileExists(If(nInd <> 2, m_sImage, m_sImage2)) Then + My.Computer.FileSystem.DeleteFile(If(nInd <> 2, m_sImage, m_sImage2)) + End If + If My.Computer.FileSystem.FileExists(If(nInd <> 2, m_sContour, m_sContour2)) Then + My.Computer.FileSystem.DeleteFile(If(nInd <> 2, m_sContour, m_sContour2)) + End If + If My.Computer.FileSystem.FileExists(If(nInd <> 2, m_sInfo, m_sInfo2)) Then + My.Computer.FileSystem.DeleteFile(If(nInd <> 2, m_sInfo, m_sInfo2)) + End If + Catch ex As Exception + End Try + ' Scatto una foto con eventuale riconoscimento del contorno (il programma deve essere già attivo) + Dim bOk As Boolean = False + Dim sArgs As String = "2 0" + If m_bCalcContour Then sArgs = " 5 0 " & m_nThreshold.ToString() & " 0" + Try + Process.Start(If(nInd <> 2, m_sCameraPath, m_sCameraPath2), sArgs) + bOk = WaitPhoto(nInd) + Catch ex As Exception + EgtOutLog(ex.Message()) + bOk = False + End Try + '' Nascondo progressbar + 'm_MainWindow.m_CurrentProjectPageUC.PhotoProgress.Visibility = Visibility.Hidden + m_bBusy = False + Return bOk + End Function + + Private Function WaitPhoto(nInd As Integer) As Boolean + ' Ciclo di ricerca foto scattata + Dim nMaxThick = 10 * m_nTimeout + For nThick As Integer = 0 To nMaxThick + ' Se esiste il file di risultato + Dim nErr = 999 + If VerifyResult(nInd, nErr) Then + If nErr = 0 Then + ' Copio i file + Dim sImageDest As String = m_sImageDir & "\" & Path.GetFileName(If(nInd <> 2, m_sImage, m_sImage2)) + Dim sInfoDest As String = Path.ChangeExtension(sImageDest, "txt") + File.Copy(If(nInd <> 2, m_sImage, m_sImage2), sImageDest, True) + File.Copy(If(nInd <> 2, m_sInfo, m_sInfo2), sInfoDest, True) + ' Se richiesto il riconoscimento del contorno + Dim sContourDest As String = String.Empty + If m_bCalcContour Then + sContourDest = Path.ChangeExtension(sImageDest, "dxf") + File.Copy(If(nInd <> 2, m_sContour, m_sContour2), sContourDest, True) + ' altrimenti cancello eventuale contorno presente + Else + 'm_MainWindow.m_CurrentProjectPageUC.RemoveContour() -> sostituito con la dichiarazione diretta + EgtErase(EgtGetFirstNameInGroup(GDB_ID.ROOT, NAME_RAW_PHOTO_OUTLINE)) + End If + '' Lancio caricamento della foto e del contorno + 'm_MainWindow.m_CadCutPageUC.PostPhoto(sImageDest, sContourDest) + + ' Lancio caricamento della foto e del contorno + EstPhoto.LoadPhoto(sImageDest) + ' Se richiesto il riconoscimento del contorno + If Not String.IsNullOrEmpty(sContourDest) Then + If Not EstPhoto.LoadContour(sContourDest) Then + 'm_MainWindow.m_CurrentProjectPageUC.SetWarningMessage(EgtMsg(90324)) 'Riconoscimento contorno non riuscito + EgtOutLog(EgtMsg(90324)) + End If + End If + ' Aggiorno visualizzazione + EgtZoom(ZM.ALL) + + Return True + Else + EgtOutLog("Camera err=" & nErr.ToString()) + Return False + End If + ' Altrimenti aspetto + Else + ' Imposto ProgressBar + Dim nProgress As Integer = CInt(nThick * 100 / nMaxThick) + 'm_MainWindow.m_CurrentProjectPageUC.PhotoProgress.Value = nProgress + ' Costringo ad aggiornare UI + UpdateUI() + ' Aspetto 100 ms + Thread.Sleep(100) + End If + Next + EgtOutLog("Camera generic error") + ' Chiudo il gestore della macchina per resettarlo + KillProcess(nInd) + Return False + End Function + + Private Function VerifyResult(nInd As Integer, ByRef nErr As Integer) As Boolean + ' Se non esiste il file con il risultato + If Not My.Computer.FileSystem.FileExists(If(nInd <> 2, m_sResult, m_sResult2)) Then + Return False + End If + ' Leggo il file + Dim bOk As Boolean = False + Try + ' Controllo errori nel file di info + Dim sLine As String = String.Empty + Dim sr As StreamReader = New StreamReader(If(nInd <> 2, m_sResult, m_sResult2)) + Do While sr.Peek() > -1 + sLine = sr.ReadLine() + sLine = sLine.Replace(" ", "") + If sLine.StartsWith("Err=") Then + If Int32.TryParse(sLine.Substring(4), nErr) Then + bOk = True + Exit Do + End If + End If + Loop + sr.Close() + Catch ex As Exception + bOk = False + End Try + Return bOk + End Function + + Private Function ProcessIsRunning(nInd As Integer) As Boolean + Dim Procs() As Process + Procs = Process.GetProcessesByName(If(nInd <> 2, m_sCameraProcName, m_sCameraProcName2)) + Return (Procs.Length() > 0) + End Function + + Private Sub KillProcess(nInd As Integer) + Dim Procs() As Process + Procs = Process.GetProcessesByName(If(nInd <> 2, m_sCameraProcName, m_sCameraProcName2)) + For i As Integer = 0 To Procs.Length() - 1 + Procs(i).Kill() + Procs(i).WaitForExit(2000) + Next i + End Sub + +End Class diff --git a/MainWindow/MainWindowM.vb b/MainWindow/MainWindowM.vb index 7201f79..15e234d 100644 --- a/MainWindow/MainWindowM.vb +++ b/MainWindow/MainWindowM.vb @@ -206,9 +206,11 @@ Public Class MainWindowM Dim bKey As Boolean = EgtGetKeyLevel(9423, 19, 1, m_nKeyLevel) And EgtGetKeyOptions(9423, 19, 1, m_nKeyOptions) ' Verifico abilitazione prodotto - Dim bProd As Boolean = GetKeyOption(KEY_OPT.MAN_MANIP) And GetKeyOption(KEY_OPT.AUTO_MANIP) And GetKeyOption(KEY_OPT.PROCUCTION_LINE) + Dim bProd As Boolean = GetKeyOption(KEY_OPT.MAN_MANIP) And GetKeyOption(KEY_OPT.AUTO_MANIP) And GetKeyOption(KEY_OPT.PRODUCTION_LINE) ' Inizializzazione generale di EgtInterface m_nDebug = GetMainPrivateProfileInt(S_GENERAL, K_DEBUG, 0) + ' se 1 allora stampo messaggi di log, altrimenti no + Utility.m_PrintLogProces = GetMainPrivateProfileInt(S_GENERAL, K_LOGPROCES, 0) = 1 m_sLogFile = m_sTempDir & "\" & GENLOG_FILE_NAME.Replace("#", m_nInstance.ToString()) Dim sLogMsg As String = "User " & Environment.MachineName & "\" & Environment.UserName & " (" & m_nInstance.ToString() & ")" & vbLf & My.Application.Info.Title.ToString() & " ver. " & @@ -322,54 +324,52 @@ Public Class MainWindowM EgtSetInfo(nMachGroupId, "Machine", m_sCurrMachine) ' salvo le modifiche nel nuov file EgtSaveFile(m_sTempDir & "\" & CURR_PROJ_NAME, NGE.BIN) - - '---------------------------------------------------------- - 'SOLO PER SIMULAZIONE INTERNA - 'm_nProjInd = ProjIndList.Count + 1 - '---------------------------------------------------------- - - ' aggliungo il progetto alla lista dei progetti caricati dalla tavola1 + ' verifico che non esista nessun altro progetto con lo stesso indice + Dim bProjExist As Boolean = If(m_ProjIndList.Count() > 0, True, False) + While bProjExist + For Each ItemProj In m_ProjIndList + bProjExist = False + If ItemProj.nProjInd = m_nProjInd Then + ' se il progetto esiste incremento il valore di 100 + m_nProjInd = m_nProjInd + 100 + bProjExist = True + ' riverifico da capo tutto l'elenco di progetti + Exit For + End If + Next + End While + ' aggiungo il progetto alla lista dei progetti caricati dalla tavola1 m_ProjIndList.Add(New Proj(m_nProjInd)) ' Nascondo eventuali info su aree EgtSetStatus(nMarkId, GDB_ST.OFF) + ' Rendo corrente il primo (e unico gruppo di lavoro) If Not EgtSetCurrMachGroup(nMachGroupId) Then Return False ' Visualizzo solo la tavola della macchina EgtShowOnlyTable(True) - ' attivo la prima fase - EgtSetCurrPhase(1) - Dim b3FirstPhase As New BBox3d() - Dim nRawPartID As Integer = EgtGetFirstRawPart() - While nRawPartID <> GDB_ID.NULL - If EgtVerifyRawPartPhase(nRawPartID, 1) Then - Dim b3CurrRawPart As New BBox3d - EgtGetRawPartBBox(nRawPartID, b3CurrRawPart) - b3FirstPhase.Add(b3CurrRawPart) - End If - nRawPartID = EgtGetNextRawPart(nRawPartID) - - End While - + ' ricerco l'ultima fase Dim nLastPhase = EgtGetPhaseCount() ' Attivo ultima fase di lavorazione EgtSetCurrPhase(nLastPhase) - + ' costruisco il bbox con tutti i grezzi dell'ultima fase Dim b3LastPhase As New BBox3d() - nRawPartID = EgtGetFirstRawPart() + Dim nRawPartID = EgtGetFirstRawPart() While nRawPartID <> GDB_ID.NULL If EgtVerifyRawPartPhase(nRawPartID, nLastPhase) Then Dim b3CurrRawPart As New BBox3d EgtGetRawPartBBox(nRawPartID, b3CurrRawPart) b3LastPhase.Add(b3CurrRawPart) End If + ' rimuovo la texture + EgtRemoveTextureData(EgtGetFirstNameInGroup(nRawPartID, NAME_RAW_SOLID)) nRawPartID = EgtGetNextRawPart(nRawPartID) End While - + ' definisco il vettore di traslazione tra origine tavola e il punto minimo del bbox generato sopra Dim vtRawOffset As New Vector3d Dim ptTable1 As New Point3d EgtGetTableRef(1, ptTable1) vtRawOffset.x = ptTable1.x - b3LastPhase.Min().x - + ' traslo tutti i pezzi dell'ultima fase della quantità appena calcolata nRawPartID = EgtGetFirstRawPart() While nRawPartID <> GDB_ID.NULL If EgtVerifyRawPartPhase(nRawPartID, nLastPhase) Then @@ -378,7 +378,7 @@ Public Class MainWindowM nRawPartID = EgtGetNextRawPart(nRawPartID) End While - ' salvo le modifiche nel nuov file + ' salvo le modifiche nel nuovo file EgtSaveFile(m_sTempDir & "\" & CURR_PROJ_NAME, NGE.BIN) ' Nascondo lavorazioni @@ -419,18 +419,76 @@ Public Class MainWindowM While nId <> GDB_ID.NULL If EgtGetType(nId) = GDB_TY.SRF_FRGN Then EgtSetColor(nId, New Color3d(0, 255, 255, 80)) ' Aqua + EgtSetAlpha(nId, 40) Exit While End If nId = EgtGetNext(nId) End While nInd += 1 End While + ' Posiziono griglia su grezzo + 'Dim p3TableOrig As Point3d + 'EgtGetTableRef(1, p3TableOrig) + 'EgtSetGridFrame(New Frame3d(New Point3d(p3TableOrig.x, p3TableOrig.y, p3TableOrig.z + b3LastPhase.DimZ))) + 'EgtSetGridShow(True, True) ' Imposto lo zoom EgtZoom(ZM.ALL) OutLogProcess("LoadProject() -> Caricato il progetto '" & m_sProjDir & "\" & CURR_PROJ_NAME) Return True End Function + Public Function GetCameraPhoto() As Boolean + EgtSetCurrentContext(Map.refSceneHostVM.MainScene.GetCtx()) + EstCalc.UpdateRawPart() + Dim bOk As Boolean = True + ' Se macchina fotografica collegata, faccio una foto + If Map.refMainWindowVM.m_Camera.GetCameraLink() Then + If Not Map.refMainWindowVM.m_Camera.CameraClick() Then + EgtOutLog(EgtMsg(90313)) + bOk = True + End If + Else + bOk = False + End If + Return bOk + End Function + + Public Function GetRegister() As Boolean + Dim bOk As Boolean = False + ' Deseleziono tutto + EgtDeselectAll() + ' Se c'è la foto devo sistemare + If GetPhoto() <> GDB_ID.NULL Then + ' Salvo il riferimento della texture originale di ogni grezzo + Dim nRawId As Integer = EgtGetFirstRawPart() + While nRawId <> GDB_ID.NULL + Dim nSolidId As Integer = EgtGetFirstNameInGroup(nRawId, NAME_RAW_SOLID) + ' Recupero il riferimento originale e lo salvo nelle info + Dim refTxr As New Frame3d + EgtGetTextureFrame(nSolidId, GDB_ID.ROOT, refTxr) + EgtSetInfo(nSolidId, "OriTxrRef", refTxr) + ' Passo al successivo + nRawId = EgtGetNextRawPart(nRawId) + End While + ' Modifiche sull'unico grezzo della prima fase + Dim nSolId = EgtGetFirstNameInGroup(EgtGetFirstRawPart(), NAME_RAW_SOLID) + ' Disabilito la texture sul grezzo + EgtRemoveTextureData(nSolId) + ' Sistemo il colore + Dim Col As Color3d + EgtGetCalcColor(nSolId, Col) + Col.A = 20 + EgtSetColor(nSolId, Col, True) + ' Visualizzo la foto + EstPhoto.ShowPhoto(True) + ' Aggiorno visualizzazione + EgtDraw() + bOk = True + End If + + Return bOk + End Function + Private Function HideAllMachinings() As Boolean Dim nId As Integer = EgtGetFirstOperation() While nId <> GDB_ID.NULL diff --git a/MainWindow/MainWindowV.xaml b/MainWindow/MainWindowV.xaml index bc92d60..6ce006b 100644 --- a/MainWindow/MainWindowV.xaml +++ b/MainWindow/MainWindowV.xaml @@ -8,9 +8,9 @@ Title="{Binding Title}" Icon="/Resources/OmagVIEWPlus.ico" MinHeight="600" MinWidth="800" - AboutBoxCommand="{Binding AboutBoxCommand}"> - + AboutBoxCommand="{Binding AboutBoxCommand}" + WindowStyle="None" ResizeMode="NoResize" + CloseCommand="{Binding CloseApplicationCommand,Mode=OneWay,UpdateSourceTrigger=PropertyChanged}"> diff --git a/MainWindow/MainWindowVM.vb b/MainWindow/MainWindowVM.vb index 5519663..2738a4a 100644 --- a/MainWindow/MainWindowVM.vb +++ b/MainWindow/MainWindowVM.vb @@ -7,10 +7,16 @@ Public Class MainWindowVM Private m_SceneHostV As SceneHostV Private m_UnloadingAreaV As UnloadingAreaV - Private m_MySceneHostVM As MySceneHostVM Private m_UnloadingAreaVM As UnloadingAreaVM + ' dichiarazione della classe camera + Friend m_Camera As Camera + + ' Dichiarazione della classe di connessione al PLC + Friend m_CNCommunication As NCCommunication + + ' attendo la conferma dello scarico manuale Private m_WaitingConfirmManualPart As Boolean = False Public ReadOnly Property WaitingConfirmManualPart As Boolean Get @@ -18,6 +24,14 @@ Public Class MainWindowVM End Get End Property + ' attendo lo scatto della fotografia + Private m_WaitingPhoto As Boolean = True + Public ReadOnly Property WaitingPhoto As Boolean + Get + Return m_WaitingPhoto + End Get + End Property + Private m_SceneIsChecked As Boolean = False Public Property SceneIsChecked As Boolean Get @@ -68,9 +82,6 @@ Public Class MainWindowVM End Get End Property - ' Dichiarazione della classe di connessione al PLC - Friend m_CNCommunication As NCCommunication - ' Variabile che indica che il programma è stato avviato correttamente (sia la mappa che l'ambiente Egt) Private m_bInitStatus As Boolean Friend ReadOnly Property bInitStatus As Boolean @@ -122,6 +133,12 @@ Public Class MainWindowVM m_UnloadingAreaVM = New UnloadingAreaVM ' Genero UnloadingArea m_UnloadingAreaV = New UnloadingAreaV + ' Genero Camera + m_Camera = New Camera + ' inizializzo la camera + m_Camera.Init() + ' inizilizzo lo stato di attesa foto + m_WaitingPhoto = m_Camera.GetCameraLink() End Sub #End Region ' CONSTRUCTOR @@ -133,6 +150,7 @@ Public Class MainWindowVM NotifyPropertyChanged("Title") End Sub + ' al termine della creazione della pagina principale Friend Sub ContentRendered() ' Verifico che l'inizializzazione di tutte le parti del programma sia andata a buon fine If Map.EndInit() Then @@ -147,23 +165,35 @@ Public Class MainWindowVM End Sub Friend Function StartUnloadingProject() As Boolean - ' prima di iniziare verifico la presenza del file .new - ' carico progetto corrente solo se il file non è stato confermato If Not m_WaitingConfirmManualPart Then m_WaitingConfirmManualPart = MainWindowM.LoadProject() SetTitle("CurrProj " & m_MainWindowM.nProjInd.ToString & " - OmagVIEWPlus") + ' se camera fotografica collegata allora impongo la selezione manuale + If Map.refMainWindowVM.m_Camera.GetCameraLink() Then + Map.refUnloadingAreaVM.IsChecked_Manual = True + End If End If - ' se non sono riuscito a caricare esco - If Not m_WaitingConfirmManualPart Then Return False ' rendo visibile la freccia rossa Map.refUnloadingAreaVM.Table1ArrowVisibility = Visibility.Visible + ' se non sono riuscito a caricare oppure la selezione manuale non è stata confermata esco + If Not m_WaitingConfirmManualPart Then Return False + ' scatto una foto della tavola + If m_WaitingPhoto Then + ' se CameraManager è attivo + m_WaitingPhoto = Not Map.refMainWindowVM.MainWindowM.GetCameraPhoto() + End If + If m_WaitingPhoto Then Return False ' eventualmente rendo visibilie il bottone per la conferma selezione manuale Map.refSceneHostVM.NotifyPropertyChanged("VisibilityManulaPartCommand") ' se non ho dato conferma del pezzo allora aspetto (bottone acceso) If Map.refUnloadingAreaVM.IsChecked_Manual Then Return False ' significa che la selezione è avvenuta m_WaitingConfirmManualPart = False + ' significa che attendo lo scatto della prossima foto + m_WaitingPhoto = True + '' salvo le modifiche nel nuovo file + 'EgtSaveFile(m_MainWindowM.sTempDir & "\" & CURR_PROJ_NAME, NGE.BIN) ' nascondo la freccia rossa Map.refUnloadingAreaVM.Table1ArrowVisibility = Visibility.Collapsed ' passo al posizionamento delle ventose @@ -211,6 +241,8 @@ Public Class MainWindowVM Public Sub CloseApplication(ByVal param As Object) ' Termino il Model m_MainWindowM.Close() + ' chiudo il programma CameraManager + m_Camera.Close() ' Termino il programma Application.Current.Shutdown() End Sub diff --git a/MainWindow/Part.vb b/MainWindow/Part.vb index b521ae8..33ddaca 100644 --- a/MainWindow/Part.vb +++ b/MainWindow/Part.vb @@ -76,6 +76,7 @@ Public Class Part End Set End Property + ' definsce se il pezzo è l'ultimo del progetto Private m_IsLast As Boolean Public ReadOnly Property IsLast As Boolean Get @@ -83,6 +84,41 @@ Public Class Part End Get End Property + ' indica il livello da occupare nel pallet (partendo da 0) + Private m_nLayer As Integer = 0 + Public Property nLayer As Integer + Get + Return m_nLayer + End Get + Set(value As Integer) + m_nLayer = value + PartWritePrivateProfileInt(m_IdProject, ConstIni.S_PART & m_IdPart.ToString, "IdLayer", CInt(m_nLayer)) + End Set + End Property + + ' se pezzo inserito nell'elenco dei pezzi da scaricare dopo il Nesting + Private m_bInsert As Boolean = False + Public Property bInsert As Boolean + Get + Return m_bInsert + End Get + Set(value As Boolean) + m_bInsert = value + End Set + End Property + + ' offsetY rispetto allo zero del pallet + Private m_OffsetPartY As Double = 0 + Public Property dOffestPartY As Double + Get + Return m_OffsetPartY + End Get + Set(value As Double) + m_OffsetPartY = value + PartWritePrivateProfileDouble(m_IdProject, ConstIni.S_PART & m_IdPart.ToString, "OffsetY", m_OffsetPartY) + End Set + End Property + ' coordinate del pezzo ripsetto alla tavola Private m_CenterPartTable As New Point3d Public ReadOnly Property CeneterPartTable As Point3d @@ -216,6 +252,14 @@ Public Class Part m_IsLast = bIsLast End Sub + Public Sub SetLayer(IdLayer As Integer) + m_nLayer = IdLayer + End Sub + + Public Sub SetOffsetY(dOffsetY As Double) + m_OffsetPartY = dOffsetY + End Sub + ' cordinate del centro del pezzo rispetto alla tavola Public Sub SetCenterPartTable(ptCenter As Point3d) ' salvo le coordinate di riferimento della tavola @@ -252,31 +296,42 @@ Public Class Part End Function ' quando calcolo le posizioni delle ventose devo recuperare queste info - Public Function GetloadingPosStrip() As Point3d + Public Function GetloadingPosStrip(ByRef dAngC As Double) As Point3d Dim ptUnLoad As New Point3d - - If m_MoveTable1.m_sCups.Contains("V8") Then + Dim C_Ang As Double = 0 + If m_MoveTable1.m_bCupsSecondSel Then ' controruoto e mi porto in posizione posizione di scarico - m_MoveTable1.m_vtDelta.Rotate(Vector3d.Z_AX, 180) + C_Ang = -m_MoveTable1.m_dAngRotDeg - 90 + m_MoveTable1.m_vtDelta.Rotate(Vector3d.Z_AX, -m_MoveTable1.m_dAngRotDeg - 90) + ' verifico che le vetose siano sopra alla tavola + If m_MoveTable1.m_vtDelta.y > 0 Then + m_MoveTable1.m_vtDelta.Rotate(Vector3d.Z_AX, 180) + dAngC = 180 + dAngC + End If Else ' ruoto gli offset per allinearmi al tappeto di scarico + C_Ang = -m_MoveTable1.m_dAngRotDeg m_MoveTable1.m_vtDelta.Rotate(Vector3d.Z_AX, -m_MoveTable1.m_dAngRotDeg) + If m_MoveTable1.m_vtDelta.x > 0 Then + m_MoveTable1.m_vtDelta.Rotate(Vector3d.Z_AX, 180) + dAngC = 180 + dAngC + End If End If Dim vtResult As Vector3d = m_MoveTable1.m_vtDelta - m_MoveTable1.m_vtRect ' se la distanza x è minore della larghezza della ventosa correggo - If Not m_MoveTable1.m_sCups.Contains("V8") And vtResult.x + 1534 / 2 > 0 Then - ptUnLoad.x = -1534 / 2 + If Not m_MoveTable1.m_bCupsSecondSel And vtResult.x + Map.refUnloadingAreaVM.VacuumDimX / 2 > 0 Then + ptUnLoad.x = -Map.refUnloadingAreaVM.VacuumDimX / 2 Else ptUnLoad.x = vtResult.x End If ' se la distanza y è minore della lunghezza della ventosa allo ra correggo - If vtResult.y + 350 / 2 > 0 Then - ptUnLoad.y = -350 / 2 - Else - ptUnLoad.y = vtResult.y - End If + 'If vtResult.y + Map.refUnloadingAreaVM.VacuumDimY / 2 > 0 Then + ' ptUnLoad.y = -Map.refUnloadingAreaVM.VacuumDimY / 2 + 'Else + ptUnLoad.y = vtResult.y + 'End If ptUnLoad.z = m_Height Return ptUnLoad End Function @@ -294,10 +349,15 @@ Public Class Part End Function ' restituisce la posizione di deposito sul pallet (riceve l'offset attuale del pellet in funzione dei pezzi già caricati) - Public Function GetUnloadingPosBox(vtCurrOffset As Vector3d) As Point3d + Public Function GetUnloadingPosBox(vtCurrOffset As Vector3d, Optional ByVal bRotate As Boolean = False) As Point3d Dim ptUnload As New Point3d + Dim vtCurrDelta As Vector3d = m_MoveTable2.m_vtDelta + ' se sto per scaricare nei pallet dispari allora girare la testa + If bRotate Then + vtCurrDelta.Rotate(Vector3d.Z_AX, 180) + End If 'correggo il vettore Delta a causa di un pivot dell'asse di rotazione - Dim vtResult As Vector3d = m_MoveTable2.m_vtDelta + vtCurrOffset + Dim vtResult As Vector3d = vtCurrDelta + vtCurrOffset ptUnload.x = vtResult.x ptUnload.y = vtResult.y ptUnload.z = vtCurrOffset.z @@ -307,19 +367,12 @@ Public Class Part ' restituisce la posizione di deposito sul pallet (riceve l'offset attuale del pellet in funzione dei pezzi già caricati) Public Function GetUnloadingPosRack(vtCurrOffset As Vector3d) As Point3d Dim ptUnload As New Point3d - m_MoveTable2.m_vtDelta.z = 0 - 'correggo il vettore Delta a causa di un pivot dell'asse di rotazione - m_MoveTable2.m_vtDelta = m_MoveTable2.m_vtDelta + New Vector3d(Map.refUnloadingAreaVM.PivotBX, Map.refUnloadingAreaVM.PivotBY, 0) - ' cambio il sitema di riferimento per posizionarmi allineato alla piastrella - m_MoveTable2.m_vtDelta.Rotate(Vector3d.Z_AX, -90) - m_MoveTable2.m_vtDelta.Rotate(Vector3d.Y_AX, -90) - ' salvo la coordinata x (punto di appoggio della piastrella) - Dim posX As Double = vtCurrOffset.x - Dim vtResult As Vector3d = m_MoveTable2.m_vtDelta + vtCurrOffset - ' considero di traslare il vettore così ottenuto nel punto posX - vtResult.x = 0 - vtResult.Rotate(Vector3d.Y_AX, 90 - Map.refUnloadingAreaVM.AngRack) - ptUnload.x = posX + vtResult.x + Dim OffsetX As Double = vtCurrOffset.z + vtCurrOffset.z = m_Height + Dim vtResult As Vector3d = vtCurrOffset + vtResult.Rotate(Vector3d.Z_AX, +90) + vtResult.Rotate(Vector3d.Y_AX, Map.refUnloadingAreaVM.AngRack) + ptUnload.x = OffsetX + vtResult.x ptUnload.y = vtResult.y ptUnload.z = vtResult.z Return ptUnload @@ -461,6 +514,12 @@ Public Class Part ' IsLast Dim bIsLats As Boolean = sItemIdPart(nInd - 2) = ItemPart LocalPart.SetIsLast(bIsLats) + ' nLayer + Dim nIdLayer As Integer = 0 + LocalPart.SetLayer(PartGetPrivateProfileIntger(nIdProj, ConstIni.S_PART & nIdPart.ToString, "IdLayer", nIdLayer)) + ' OffsetPartY + Dim dOffsetY As Double = 0 + LocalPart.SetOffsetY(PartGetPrivateProfileDouble(nIdProj, ConstIni.S_PART & nIdPart.ToString, "OffsetY", dOffsetY)) ' info Table 1 For nIndex As Integer = 1 To 2 @@ -498,6 +557,7 @@ Public Class Part ' ricavo il magazzino corrente If ItemWarehouse.Id = CType(nIdWarehouse, Warehouses) Then For Each ItemBox In ItemWarehouse.Boxes + ItemBox.State = States.LOADING If ItemBox.Id = LocalPart.IdBox Then ItemBox.MyListPart.Add(LocalPart) End If diff --git a/My Project/AssemblyInfo.vb b/My Project/AssemblyInfo.vb index 05c1be3..f4e85c4 100644 --- a/My Project/AssemblyInfo.vb +++ b/My Project/AssemblyInfo.vb @@ -70,5 +70,5 @@ Imports System.Windows ' by using the '*' as shown below: ' - - + + diff --git a/MySceneHost/MySceneHostVM.vb b/MySceneHost/MySceneHostVM.vb index 1e0f4cd..b7667d1 100644 --- a/MySceneHost/MySceneHostVM.vb +++ b/MySceneHost/MySceneHostVM.vb @@ -110,7 +110,7 @@ Public Class MySceneHostVM Public Overrides Sub InitSceneEvents() AddHandler MainScene.OnMouseDownScene, AddressOf OnMouseDownScene - 'AddHandler MainScene.OnMouseMoveScene, AddressOf OnMouseMoveScene + AddHandler MainScene.OnMouseMoveScene, AddressOf OnMouseMoveScene AddHandler MainScene.OnMouseUpScene, AddressOf OnMouseUpScene 'AddHandler MainScene.KeyDown, AddressOf OnKeyDownScene 'AddHandler MainScene.OnCursorPos, AddressOf OnCursorPos @@ -411,8 +411,19 @@ Public Class MySceneHostVM Private m_bDrag As Boolean = False Private m_nIdToSel As Integer = GDB_ID.NULL Private m_nIdToDesel As Integer = GDB_ID.NULL + Private m_bDragToStart As Boolean = False + Private m_locPrev As System.Drawing.Point + Private m_ptPrev As Point3d + Private m_bVerify As Boolean = False + Private m_vtTotMove As Vector3d + Private m_bDragging As Boolean = False + Private m_nRestRadius As Integer = 3 + Private m_Rotate As Boolean = False + + ' selezione degli oggetti nella grafica Friend Sub OnMouseDownScene(sender As Object, e As Windows.Forms.MouseEventArgs) + If Not e.Button = Forms.MouseButtons.Left Then Return ' devo attendere che sia terminato lo scarico della tavola 1 -> GetPart(Place.ON_TABLE).Count = 0 If Not IsNothing(Map.refUnloadingAreaVM) AndAlso Not Map.refUnloadingAreaVM.IsChecked_Manual Then Return ' Per default no drag @@ -423,7 +434,7 @@ Public Class MySceneHostVM EgtSelect(e.Location, Scene.DIM_SEL, Scene.DIM_SEL, nSel) Dim nId As Integer = EgtGetFirstObjInSelWin() - ' usato come test (tutto inuna sola funzione) + ''usato come test (tutto in una sola funzione) 'Dim nPartId As Integer = EgtGetParent(EgtGetParent(nId)) 'If EgtGetRawPartFromPart(nPartId) = GDB_ID.NULL Then Return 'Dim nStat As Integer = GDB_ST.ON_ @@ -440,6 +451,7 @@ Public Class MySceneHostVM Dim bPartInTable As Boolean = (EgtGetParent(nPartId) = GetRawId()) If EgtGetRawPartFromPart(nPartId) <> GDB_ID.NULL Then Dim nStat As Integer = GDB_ST.ON_ + ' recupero lo stato del pezzo EgtGetStatus(nPartId, nStat) ' Se già selezionato If nStat = GDB_ST.SEL Then @@ -456,12 +468,108 @@ Public Class MySceneHostVM nId = EgtGetNextObjInSelWin() End While - '' Dati per drag - 'm_locPrev = e.Location - 'm_bDrag = m_bDrag AndAlso EgtUnProjectPoint(e.Location, m_ptPrev) - 'm_bDragToStart = m_bDrag - 'm_bVerify = m_bDrag AndAlso (Keyboard.Modifiers And ModifierKeys.Shift) > 0 - 'm_vtTotMove = Vector3d.NULL() + ' Dati per drag + m_locPrev = e.Location + m_bDrag = m_bDrag AndAlso EgtUnProjectPoint(e.Location, m_ptPrev) + m_bDragToStart = m_bDrag + m_bVerify = m_bDrag AndAlso (Keyboard.Modifiers And ModifierKeys.Shift) > 0 + m_vtTotMove = Vector3d.NULL() + m_Rotate = m_bDrag AndAlso (Keyboard.Modifiers And ModifierKeys.Control) > 0 + + End Sub + + ' movimento degli oggetti nella scena + Friend Sub OnMouseMoveScene(sender As Object, e As System.Windows.Forms.MouseEventArgs) + ' Se drag non abilitato o già in esecuzione, esco + If Not m_bDrag Or m_bDragging Then Return + ' Se primo movimento di drag, verifico di aver superato la soglia di movimento in pixel + If m_bDragToStart Then + If Math.Abs(e.Location.X - m_locPrev.X) < m_nRestRadius And + Math.Abs(e.Location.Y - m_locPrev.Y) < m_nRestRadius Then + Return + End If + m_bDragToStart = False + End If + ' Determino cosa muovere + Dim nMoveId = If(m_nIdToSel <> GDB_ID.NULL, m_nIdToSel, GDB_ID.SEL) + '' Verifico se in tavola o in parcheggio + 'Dim nTestId = If(nMoveId <> GDB_ID.SEL, nMoveId, EgtGetFirstSelectedObj()) + 'If EgtGetParent(nTestId) <> GetRawId() Then + ' ' Dal parcheggio ammesso drag di un singolo pezzo + ' If nMoveId = GDB_ID.SEL Then Return + ' ' Applico le lavorazioni al pezzo + ' Dim b3Curr As New BBox3d + ' EgtGetBBoxGlob(EgtGetFirstNameInGroup(nTestId, NAME_REGION), BBFLAG, b3Curr) + ' If Not EstCalc.PreInsertOnePart(nTestId) Then Return + ' Dim b3Ins As New BBox3d + ' EgtGetBBoxGlob(EgtGetFirstNameInGroup(nTestId, NAME_REGION), BBFLAG, b3Ins) + ' Dim vtDiff As New Vector3d(b3Curr.Min().x - b3Ins.Min().x, b3Curr.Min().y - b3Ins.Min().y, 0) + ' EgtMove(nMoveId, vtDiff) + ' '' Gestione VeinMatching + ' 'VeinMatching.OnInsertPartInRaw(nMoveId) + ' ' Imposto stato + ' m_bVerify = True + ' m_bFromParking = True + 'End If + ' Inizio esecuzione di drag + m_bDragging = True + ' Ricavo il punto corrente in coordinate mondo + Dim ptCurr As Point3d + EgtUnProjectPoint(e.Location, ptCurr) + ' Ricavo il vettore di movimento + Dim vtMove As New Vector3d(ptCurr.x - m_ptPrev.x, ptCurr.y - m_ptPrev.y, 0) + ' Muovo i pezzi selezionati di quanto possibile + If vtMove.SqLen() > EPS_SMALL * EPS_SMALL Then + ' Se movimento con sola verifica finale + If m_bVerify Then + EgtMove(nMoveId, vtMove) + m_vtTotMove += vtMove + ' altrimenti caso con verifica durante il movimento + 'Else + ' ' Aggiorno regioni per nesting + ' UpdateNestRegions() + ' EnableReferenceRegion(False) + ' ' muovo il pezzo + ' EgtMovePart(nMoveId, CurrentMachine.bReducedCut, vtMove) + ' EgtSaveCollInfo() + ' ' se movimento risultante nullo, provo con movimento tangente + ' Dim bTgMoved As Boolean = False + ' If vtMove.IsSmall() Then + ' ' riprovo con movimento tangente + ' Dim vtTgMove As Vector3d = ptCurr - m_ptPrev + ' EgtTgMovePartOnCollision(nMoveId, CurrentMachine.bReducedCut, vtTgMove) + ' bTgMoved = (Not vtTgMove.IsSmall()) + ' End If + ' ' se abilitato magnetico (allineamento + snap), lo provo + ' Dim bAlignMoved As Boolean = False + ' Dim bSnapMoved As Boolean = False + ' If m_bMagnetic Then + ' If Not GetLockOnRotation(nMoveId) Then + ' EgtAlignPartOnCollision(nMoveId, CurrentMachine.bReducedCut, bAlignMoved) + ' End If + ' If m_dSnapDist > EPS_SMALL Then + ' EgtRestoreCollInfo() + ' EgtMovePartToSnapPointOnCollision(nMoveId, CurrentMachine.bReducedCut, m_dSnapDist, bSnapMoved) + ' End If + ' End If + ' EstCalc.ResetOrderMachiningFlag() + ElseIf m_Rotate Then + Dim ptCen As Point3d + If Not EgtGetPartPartClusterCenterGlob(nMoveId, ptCen) Then Return + Dim dLen, dAngV, dAngHPrev, dAngHCurr As Double + Dim vtPrev As Vector3d = m_ptPrev - ptCen + Dim vtCurr As Vector3d = ptCurr - ptCen + vtPrev.ToSpherical(dLen, dAngV, dAngHPrev) + vtCurr.ToSpherical(dLen, dAngV, dAngHCurr) + Dim dAngRotDeg As Double = If(dAngHCurr < 0, 360 + dAngHCurr, dAngHCurr) - If(dAngHPrev < 0, 360 + dAngHPrev, dAngHPrev) + EgtRotate(nMoveId, ptCen, Vector3d.Z_AX(), dAngRotDeg, GDB_RT.GLOB) + End If + EgtDraw() + End If + ' Aggiorno il punto precedente + m_ptPrev = ptCurr + ' Terminata esecuzione di drag + m_bDragging = False End Sub Private m_nPartPos As Integer = PART_POS.NONE_TABLE @@ -473,63 +581,48 @@ Public Class MySceneHostVM Friend Sub OnMouseUpScene(sender As Object, e As System.Windows.Forms.MouseEventArgs) ' Se eseguito drag - 'If Not m_bDragToStart Then - ' ' Se movimento con sola verifica finale - ' If m_bVerify Then - ' ' Determino cosa verificare - ' Dim nMoveId = If(m_nIdToSel <> GDB_ID.NULL, m_nIdToSel, GDB_ID.SEL) - ' ' Aggiorno regioni per nesting - ' UpdateNestRegions() - ' EnableReferenceRegion(False) - ' ' Eseguo verifica - ' If EgtVerifyPart(nMoveId, CurrentMachine.bReducedCut) Then - ' EstCalc.ResetOrderMachiningFlag() - ' ' Non superata riporto alla posizione iniziale - ' Else - ' If m_bFromParking Then - ' PreRemoveOnePart(nMoveId) - ' VeinMatching.OnRemovePartFromRaw(nMoveId) - ' Else - ' EgtMove(nMoveId, -m_vtTotMove) - ' ' Eventuale notifica al VeinMatching - ' If nMoveId = GDB_ID.SEL Then - ' Dim nId As Integer = EgtGetFirstSelectedObj() - ' While nId <> GDB_ID.NULL - ' VeinMatching.OnMovePartInRaw(nId) - ' nId = EgtGetNextSelectedObj() - ' End While - ' Else - ' VeinMatching.OnMovePartInRaw(nMoveId) - ' End If - ' End If - ' End If - ' m_bFromParking = False - ' ' altrimenti caso con verifica durante il movimento - ' Else - ' ' Basta reset alla fine - ' End If - ' ' Se selezione da eseguire ---> ElseIf - If m_nIdToSel <> GDB_ID.NULL Then - '' Determino se pezzo in tavola o in parcheggio - 'Dim bPartInTable As Boolean = (EgtGetParent(m_nIdToSel) = GetRawId()) - '' Se ci sono pezzi già selezionati nella posizione opposta, li deseleziono - 'If (bPartInTable And m_nPartPos = PART_POS.OUT_TABLE) Or - ' (Not bPartInTable And m_nPartPos = PART_POS.IN_TABLE) Then - ' EgtDeselectAll() - ' ' Aggiornamento eventuale VeinMatching - ' VeinMatching.OnDeselectAll() + If Not m_bDragToStart Then + ''Se movimento con sola verifica finale + 'If m_bVerify Then + '' Determino cosa verificare + 'Dim nMoveId = If(m_nIdToSel <> GDB_ID.NULL, m_nIdToSel, GDB_ID.SEL) + '' Aggiorno regioni per nesting + ' UpdateNestRegions() + ' EnableReferenceRegion(False) + '' Eseguo verifica + ' If EgtVerifyPart(nMoveId, CurrentMachine.bReducedCut) Then + ' EstCalc.ResetOrderMachiningFlag() + ' Non superata riporto alla posizione iniziale + ' Else + ' If m_bFromParking Then + ' PreRemoveOnePart(nMoveId) + ' VeinMatching.OnRemovePartFromRaw(nMoveId) + ' Else + ' EgtMove(nMoveId, -m_vtTotMove) + '' Eventuale notifica al VeinMatching + ' If nMoveId = GDB_ID.SEL Then + ' Dim nId As Integer = EgtGetFirstSelectedObj() + ' While nId <> GDB_ID.NULL + ' VeinMatching.OnMovePartInRaw(nId) + ' nId = EgtGetNextSelectedObj() + ' End While + ' Else + ' VeinMatching.OnMovePartInRaw(nMoveId) + ' End If + ' End If + ' End If + ' m_bFromParking = False + '' altrimenti caso con verifica durante il movimento + 'Else + '' Basta Reset alla fine 'End If + 'Se selezione da eseguire ---> ElseIf + ElseIf m_nIdToSel <> GDB_ID.NULL Then ' Eseguo la selezione EgtSelectObj(m_nIdToSel) - ''' Eventuale aggiornamento VeinMatching - 'VeinMatching.OnSelectPart(m_nIdToSel) - '' Set flag posizione selezionati - 'm_nPartPos = If(bPartInTable, PART_POS.IN_TABLE, PART_POS.OUT_TABLE) ' Se deselezione da eseguire ElseIf m_nIdToDesel <> GDB_ID.NULL Then EgtDeselectObj(m_nIdToDesel) - '' Eventuale aggiornamento VeinMatching - 'VeinMatching.OnDeselectPart(m_nIdToDesel) End If ' Reset m_bDrag = False @@ -555,10 +648,11 @@ Public Class MySceneHostVM End Get End Property - ' scarico tutti i pezzi manuali rimasti sulla rulliera + ' comunico che è terminata la selezione dei pezzi manuali Public Sub ConfirmManualPart() If VisibilityManulaPartCommand <> Visibility.Visible Then Return Map.refUnloadingAreaVM.IsChecked_Manual = False + NotifyPropertyChanged("VisibilityManulaPartCommand") End Sub diff --git a/NCCommunication/NCCommunication.vb b/NCCommunication/NCCommunication.vb index bb580bc..7cd45c4 100644 --- a/NCCommunication/NCCommunication.vb +++ b/NCCommunication/NCCommunication.vb @@ -26,6 +26,13 @@ Public Class NCCommunication Private m_bFirst As Boolean = True 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_bAdjustNesting As Boolean = False + ' indica il pezzo che è attulamene agganciato alla ventosa + ' pezzo precedente, il primo è creato in modo fittizio + Private m_LocalPrecPart As New Part(-10, -10) ' Timer Private m_TimerIsBusy As Boolean = False @@ -34,6 +41,10 @@ Public Class NCCommunication 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) @@ -119,6 +130,7 @@ Public Class NCCommunication '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 @@ -127,6 +139,14 @@ Public Class NCCommunication 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") @@ -144,7 +164,7 @@ Public Class NCCommunication ' leggo se lo scarico manuale è terminato (nValue=0) solo quando sono terminati quello automatici If m_bWaitingManualUnloading Then - If ReadInt("rUnloadManual", nValue) Then + If ReadInt("UnloadManualRead", nValue) Then bRaededVariable = True If nValue = 0 Then ' svuoto la rulliera dai pezzi manuali @@ -161,7 +181,7 @@ Public Class NCCommunication 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 (rUnloadManual) + ' 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 @@ -177,22 +197,31 @@ Public Class NCCommunication ' 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 - ' Se c'è file segnalazione nuovo lo trasformo in segnalazione bloccato - If My.Computer.FileSystem.FileExists(sProjNew) 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") + ' 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 + '' 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 @@ -212,7 +241,7 @@ Public Class NCCommunication ' leggo lo stato SCARICATORE StatusMachine1 Dim StatusMachine1 As StatusMachine = StatusMachine.MOVING - If ReadInt("rStatusMachine1", nValue) Then + If ReadInt("StatusMachine1Read", nValue) Then bRaededVariable = True ' converto in Enum If nValue >= 0 OrElse nValue <= 4 Then @@ -233,20 +262,30 @@ Public Class NCCommunication 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() - + Map.refUnloadingAreaVM.CurrPartTable1 = UnLoadTable1(SimulPosTab, SimulPosStrip, SimulCAng) + ' + m_bAdjustNesting = False Case StatusMachine.CHANGE_POINT OutLogProcess("[1] Stato macchina 1: 3") - ' la macchina è ferma ed è pronta a ricevere le nuove coordinate - ' 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 + ' ricalcolo il Nesting dei pezzi StatusPart.GOOD + If Not m_bAdjustNesting Then + m_bAdjustNesting = True + AdjustNesting1D(Map.refUnloadingAreaVM.CurrPartTable1) + End If + End If - ' passo al pezzo successivo, e lo rendo corrente - Map.refUnloadingAreaVM.CurrPartTable1 = UnLoadTable1() + ' passo al pezzo successivo, e lo rendo corrente + Map.refUnloadingAreaVM.CurrPartTable1 = UnLoadTable1(SimulPosTab, SimulPosStrip, SimulCAng) End Select @@ -256,8 +295,27 @@ Public Class NCCommunication Map.refUnloadingAreaVM.NotifyPropertyChanged("TableDifference") End If - ' mentre scarico la macchina1 attendo che la macchina2 sia pronta - Dim bFoundStorage As Boolean = False + ' 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è il 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) @@ -312,7 +370,7 @@ Public Class NCCommunication ' leggo lo stao del pallettizzatore Dim StatusMachine2 As StatusMachine = StatusMachine.MOVING - If ReadInt("rStatusMachine2", nValue) Then + If ReadInt("StatusMachine2Read", nValue) Then bRaededVariable = True ' converto in Enum If nValue >= 0 OrElse nValue <= 4 Then @@ -323,13 +381,15 @@ Public Class NCCommunication Case StatusMachine.WAITING_POINT OutLogProcess("[3] Stato macchina 2: 0") + ' 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 Then Map.refUnloadingAreaVM.CurrPartTable2.enPlace = Place.ON_BOX OutLogProcess("[3] Pezzo depositato nel Box: " & Map.refUnloadingAreaVM.CurrPartTable2.IdPart.ToString & " - " & Map.refUnloadingAreaVM.CurrPartTable2.IdBox.ToString) + 'EgtSetStatus(Map.refUnloadingAreaVM.CurrPartTable2.IdPart, GDB_ST.OFF) ' 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 è stato elaborato + ' 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) @@ -339,22 +399,29 @@ Public Class NCCommunication My.Computer.FileSystem.DeleteFile(sFile) OutLogProcess("[3] Eliminato file: " & sFile) End If + Map.refUnloadingAreaVM.CurrPartTable2 = Nothing End If ' nascondo la freccia rossa sulla rulliera Map.refUnloadingAreaVM.RullerArrowVisibility = Visibility.Collapsed End If - ' salvo le coordinate per afferrare e depositare i pezzi (solo quelli automatici) - Map.refUnloadingAreaVM.CurrPartTable2 = UnLoadTable2(CurrWarehouse, Map.refUnloadingAreaVM.IdProjTable2.nProjInd) - + ' verifico che un intero Layer sia stato depositato sulla ruelliera + If CompleteLayerForUnloading(Map.refUnloadingAreaVM.IdProjTable2.nProjInd) Then + ' salvo le coordinate per afferrare e depositare i pezzi (solo quelli automatici) + Map.refUnloadingAreaVM.CurrPartTable2 = UnLoadTable2(CurrWarehouse, Map.refUnloadingAreaVM.IdProjTable2.nProjInd) + End If Case StatusMachine.CHANGE_POINT OutLogProcess("[3] Stato macchina 2: 3") ' rendo visibile la freccia rossa sulla rulliera Map.refUnloadingAreaVM.RullerArrowVisibility = Visibility.Visible + ' scarico i pezzi manualmente + UnloadManualPart(CurrWarehouse) ' verifico che il pezzo sia stato prelevato prima di passare al successivo (bottone di scarico manuale) - If ReadInt("rUnloadManual", nValue) Then + If ReadInt("UnloadManualRead", nValue) Then bRaededVariable = True ' se nValue = 1 signifa che non è ancora stato scaricato If nValue = 0 Then + Map.refUnloadingAreaVM.ClearOutputMessage() + m_bErrorLoading = False ' significa che il pezzo è stato tolto a mano (dove è finito?) If Not IsNothing(Map.refUnloadingAreaVM.CurrPartTable2) AndAlso Map.refUnloadingAreaVM.CurrPartTable2.enUnloading = Unloading.AUTOMATIC Then @@ -362,12 +429,11 @@ Public Class NCCommunication Map.refUnloadingAreaVM.CurrPartTable2.enPlace = Place.ON_WASTE_BOX OutLogProcess("[3] Pezzo non prelevabile : " & Map.refUnloadingAreaVM.IdProjTable2.nProjInd.ToString) End If - ' nessun pezzo, aspetto che la macchina torni as assere in stato 0->WAITING_POINT (comandato dalla macchina) - Map.refUnloadingAreaVM.CurrPartTable2 = Nothing - ' attendo che il pezzo sia scaricato a mano End If End If - + WriteReal("UnloadManual", 1) + ' nessun pezzo, aspetto che la macchina torni as assere in stato 0->WAITING_POINT (comandato dalla macchina) + Map.refUnloadingAreaVM.CurrPartTable2 = Nothing End Select End If ' Pezzi attualmente sulla rulliera motorizzata @@ -378,30 +444,26 @@ Public Class NCCommunication End Sub ' salvo le coordinate per afferrare e depositare il pezzo sulla tavola 1 - Private Function UnLoadTable1() As Part + 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) - Dim PosTable1 As Point3d = LocalPart.GetUnloadingPosTable1 + + 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) - '' rappresento graficamente l'afferraggio dei pezzi - 'EgtSetMachineLook(MCH_LOOK.TAB_HEAD) - 'EgtSetAxisPos("X1", PosTable1.x + LocalPart.ptTable1.x) - 'EgtSetAxisPos("Y", PosTable1.y + LocalPart.ptTable1.y) - 'EgtSetAxisPos("W1", LocalPart.DegAngOnTable) - 'EgtDraw() + ' salvo le informazioni del pezzo manipolatore per il deposito - Dim C_Ang As Double = 0 - If LocalPart.MoveTable1.m_sCups.Contains("V8") Then + C_Ang = 0 + If LocalPart.MoveTable1.m_bCupsSecondSel Then C_Ang = -90 End If - Dim PosStrip As Point3d = LocalPart.GetloadingPosStrip + PosStrip = LocalPart.GetloadingPosStrip(C_Ang) WriteReal("X_MotorStrip", PosStrip.x) WriteReal("Y_MotorStrip", PosStrip.y) WriteReal("Z_MotorStrip", PosStrip.z) @@ -418,26 +480,40 @@ Public Class NCCommunication 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 = GetRegionFromPart(LocalPart.IdPart) + Dim nIdRegion As Integer = GeomCalc.GetRegionFromPart(LocalPart.IdPart) If nIdRegion > 0 Then - EgtSetColor(nIdRegion, New Color3d(225, 0, 0, 80)) + 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) + '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 If + Return LocalPart End Function ' verifico se ho terminato il carcio dei Box @@ -453,22 +529,38 @@ Public Class NCCommunication Return True End Function - ' restituisce l'Id della regione del pezzo - Private Function GetRegionFromPart(IdPart As Integer) As Integer - Dim nRegId As Integer = EgtGetFirstNameInGroup(IdPart, ConstGen.NAME_REGION) - If nRegId = GDB_ID.NULL Then - Return -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 + + 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 - ' Cerco prima regione nel layer - Dim nId = EgtGetFirstInGroup(nRegId) - While nId <> GDB_ID.NULL - If EgtGetType(nId) = GDB_TY.SRF_FRGN Then - Return nId - End If - nId = EgtGetNext(nId) - End While - Return -1 - End Function + ' 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 @@ -497,8 +589,9 @@ Public Class NCCommunication 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("rActiveStorage", dValue) Then + 'If ReadReal("ActiveStorageRead", dValue) Then ' Dim enIdStorage As Warehouses ' nValue = CInt(dValue) ' If nValue >= 0 OrElse nValue <= 4 Then @@ -538,6 +631,51 @@ Public Class NCCommunication Return bStorageFound End Function + 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 @@ -555,7 +693,6 @@ Public Class NCCommunication For Each ItemPart In ItemBox.MyListPart If ItemPart.IdPart = LocalPart.IdPart AndAlso ItemPart.IdProject = LocalPart.IdProject Then - ' mi basta che un solo pezzo sia stato depositato per definire il box FULL (non disponibile per altri progetti) ItemBox.State = States.LOADING Map.refUnloadingAreaVM.CurrBox = ItemBox ' comunico le coordinte di afferraggio pezzo (indipendenti dal tipo di Box) @@ -565,6 +702,10 @@ Public Class NCCommunication 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 + SimulLouadingTab2(LocalPart, PointRuller) + ' restitusco la dimensione x del pezzo WriteReal("Rect2DimX", LocalPart.MoveTable2.m_vtRect.x * 2) ' cumunico l'id del box ativo @@ -575,29 +716,44 @@ Public Class NCCommunication If ItemBox.enConfigBox = ConfigBox.PALLET Then ' deposito sempre com la ventosa 8 rivolta verso i cancelli C_Ang = 180 - - Dim vtCurrOffset As New Vector3d(Map.refUnloadingAreaVM.OffsetPalletX, Map.refUnloadingAreaVM.OffsetPalletY, ItemBox.GetPalletOffsetZ()) - Dim PointPallet As Point3d = LocalPart.GetUnloadingPosBox(vtCurrOffset) + ' 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 + SimulLoadingPallet(LocalPart, PointPallet, ItemBox.Id, CurrWarehouse.Id) + Else - C_Ang = 90 + C_Ang = -90 B_Ang = -Map.refUnloadingAreaVM.AngRack - ' ottengo il vettore del baricentro (con piastrella verticale - Dim vtCurrOffset As New Vector3d(ItemBox.GetRackOffsetX(), Map.refUnloadingAreaVM.OffsetRackY, ItemBox.GetRackOffsetZ(ItemPart.MoveTable1.m_vtRect.y)) + ' 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.z) + 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) + SimulUnloadingRack(LocalPart, PointRacks, ItemBox.Id, CurrWarehouse.Id) + End If ' salvo le ventose che devono essere attivate For IndexVacuum = 1 To 8 @@ -605,7 +761,6 @@ Public Class NCCommunication Next bFoundBox = True WriteInt("StatusMachine2", CInt(StatusMachine.LOADED_POINT)) - 'EgtUILib.WritePrivateProfileString("0", "81.192", "1", "c:\EgtData\OmagVIEWPlus\Config\NC_Debug.ini") OutLogProcess("UnLoadTable2() -> Communico punto di prelievo pezzo: " & LocalPart.IdPart.ToString) OutLogProcess("UnLoadTable2() -> Stato macchina 2: 1") Exit For @@ -617,6 +772,343 @@ Public Class NCCommunication Return LocalPart End Function + ' trasformo tutti i pezzi che devono essere depositati sui pallet 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 + + Private Sub AdjustNesting1D(WastePart As Part) + Dim nCurrLayer As Integer = 0 + ' recupero l'eleco dei pezzi che stanno sulla rulliera e sulla tavola + Dim PartListTable As New ObservableCollection(Of Part) + PartListTable = Map.refUnloadingAreaVM.GetParts(Place.ON_TABLE) + ' se non ci sno pezzi sulla tavola esco + If PartListTable.Count() < 1 Then + Return + End If + + Dim CurrBox As Box = Nothing + Dim CurrWarehouse As WarehouseVM = Map.refUnloadingAreaVM.GetCurrentWarehouse() + ' prima di cambiare Layer verifico di poter continuare ad usare lo stesso + If Not IsNothing(CurrWarehouse) And WastePart.IdBox > -1 Then + For Each ItemGridBox In CurrWarehouse.GridBoxList + Dim bFoundBox As Boolean = False + For Each ItemBox In ItemGridBox.CurrBoxList + If ItemBox.Id = WastePart.IdBox Then + CurrBox = ItemBox + bFoundBox = True + Exit For + End If + Next + If bFoundBox Then + Exit For + End If + Next + ' verifico quanti pezzi contiene il Layer del pezzo non prelevato + Dim CounterPartLayer As Integer = 0 + 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 layer successivi in basso + For Each ItemLayer In CurrBox.MyListPart + ItemLayer.nLayer = ItemLayer.nLayer - 1 + Next + Return + + End If + + ' lista dei pezzi presenti sulll'ultimo Layer + Dim LastLayerList As New List(Of Part) + 'Dim PartListOnRuller As New List(Of Part) + Dim PartListMedium As New List(Of Part) + Dim PartListMin As New List(Of Part) + Dim dDiffY As Double = Map.refUnloadingAreaVM.OffsetPalletY * 2 + + ' classifico i pezzi (medi e piccoli) sul tavolo + For Each ItemPartTable In PartListTable + If ItemPartTable.MinRectX > 600 AndAlso ItemPartTable.MinRectX <= Map.refUnloadingAreaVM.MaxLength AndAlso ItemPartTable.IdBox = WastePart.IdBox Then + PartListMedium.Add(ItemPartTable) + ElseIf ItemPartTable.MinRectX <= 600 AndAlso ItemPartTable.IdBox = WastePart.IdBox Then + PartListMin.Add(ItemPartTable) + End If + Next + + EgtOutLog("Start Nesting") + nCurrLayer = 0 + + ' eseguo il Nesting1D dei pezzi correnti, costruisco l'enco 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 renest part.") + Return + End If + ' recupero l'indice dell'ultimo Layer calcolato + If LastLayerList.Count > 0 Then nCurrLayer = LastLayerList(0).nLayer + ' eseguo il nestin 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 renest part.") + Return + End If + ' comunico che il processo di Nesting è terminato + EgtOutLog("End Nesting") + + Dim ActualListPart As New List(Of Part) + ' riordino l'elenco dei pezzi (dal Primo Layer all'ultimo Layer) + Dim StartLayer As Integer = 0 + Dim bLayerExist As Boolean = True + While bLayerExist + bLayerExist = False + For Each ItemPart In PartListMedium + If ItemPart.nLayer = StartLayer Then + ActualListPart.Add(ItemPart) + Dim IndexPart As Integer = 0 + ' rimuovo i pezzi appena ricalcolati 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 + StartLayer = StartLayer + 1 + End While + bLayerExist = True + StartLayer = StartLayer - 1 + While bLayerExist + bLayerExist = False + 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 + 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 + + ' cerco il primo pallet disponibile + Dim IdBoxAvailable As Integer = -1 + Dim NewBox As Box = Nothing + Dim OldBox As Box = Nothing + If Not IsNothing(CurrWarehouse) Then + Dim OldIdBox As Integer = -1 + If ActualListPart.Count > 0 Then + OldIdBox = ActualListPart(0).IdBox + End If + For Each ItemGridBox In CurrWarehouse.GridBoxList + For Each ItemBox In ItemGridBox.CurrBoxList + If ItemBox.Id = OldIdBox Then + ItemBox.MyListPart.Clear() + End If + Next + Next + + For Each ItemGridBox In CurrWarehouse.GridBoxList + For Each ItemBox In ItemGridBox.CurrBoxList + If ItemBox.State = States.AVAILABLE Then + If ItemGridBox.IsPallet Then + IdBoxAvailable = ItemBox.Id + NewBox = ItemBox + Exit For + End If + End If + Next + If IdBoxAvailable <> -1 Then Exit For + Next + End If + + Dim IndexMaualPart As Integer = 0 + For IndexMaualPart = 0 To Map.refUnloadingAreaVM.ListPart.Count - 1 + If Map.refUnloadingAreaVM.ListPart(IndexMaualPart).enUnloading = Unloading.MANUAL Then + Exit For + End If + Next + + ' reinserisco i pezzi nella lista + For Each ActualItemPart In ActualListPart + Map.refUnloadingAreaVM.ListPart.Insert(IndexMaualPart, ActualItemPart) + 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 + NewBox.MyListPart.Add(ActualItemPart) + End If + Next + + ' salvo tutto nel file PartList.ini + Dim nListCount As Integer = 0 + For Each ItemCurrList In Map.refUnloadingAreaVM.ListPart + If ItemCurrList.IdProject = nIdProj Then + nListCount = nListCount + 1 + ItemCurrList.SavePart(ItemCurrList.IdPart) + ItemCurrList.IdBox = IdBoxAvailable + ItemCurrList.dOffestPartY = ItemCurrList.dOffestPartY + PartWritePrivateProfileString(ItemCurrList.IdProject, "PartList", "IdPart" & nListCount.ToString, ItemCurrList.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 + ' definito il nome della variabile recupero l'inidirzzo variabile PLC e restituisco il valore letto da PLC Private Function ReadInt(sVarName As String, ByRef nValue As Integer) As Boolean Dim bok As Boolean = True @@ -861,20 +1353,6 @@ Public Class NCCommunication Return False End If - '' controllo che scrittura sia disponibile - 'Dim WriteValue As Integer = 0 - 'For Index = 0 To 10 - ' m_NC.ReadInt(DbNumber, Start, 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, Start, CShort(nValue)) Then ' scrivo in backup Dim sBackupFolder As String = Map.refMainWindowVM.MainWindowM.sLogDir & "\" & Date.Today.Year & "-" & @@ -918,20 +1396,6 @@ Public Class NCCommunication Return False End If - '' controllo che scrittura sia disponibile - 'Dim WriteValue As Integer = 0 - 'For Index = 0 To 10 - ' m_NC.ReadInt(DbNumber, Start, 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, Start, CSng(dValue)) Then ' scrivo in backup Dim sBackupFolder As String = Map.refMainWindowVM.MainWindowM.sLogDir & "\" & Date.Today.Year & "-" & diff --git a/OmagVIEWPlus.vbproj b/OmagVIEWPlus.vbproj index fce8340..c742c57 100644 --- a/OmagVIEWPlus.vbproj +++ b/OmagVIEWPlus.vbproj @@ -138,6 +138,7 @@ + @@ -147,10 +148,8 @@ WarehouseV.xaml + - - SceneWindowV.xaml - @@ -250,10 +249,6 @@ MSBuild:Compile Designer - - Designer - MSBuild:Compile - MSBuild:Compile Designer diff --git a/UnloadingArea/UnloadingAreaV.xaml b/UnloadingArea/UnloadingAreaV.xaml index a4ed0ff..cfb3192 100644 --- a/UnloadingArea/UnloadingAreaV.xaml +++ b/UnloadingArea/UnloadingAreaV.xaml @@ -43,7 +43,6 @@ - @@ -85,5 +84,16 @@ IsChecked="{Binding refScenaIsChecked}"/> + + + + + diff --git a/UnloadingArea/UnloadingAreaVM.vb b/UnloadingArea/UnloadingAreaVM.vb index 8192fe5..4e0a42c 100644 --- a/UnloadingArea/UnloadingAreaVM.vb +++ b/UnloadingArea/UnloadingAreaVM.vb @@ -5,15 +5,13 @@ Imports EgtWPFLib5 Public Class UnloadingAreaVM Inherits VMBase - '----------------------------------------------------------------------------------------- - ' non è più utilizzato perchè sono solo due oggetti! + ' lista dei magazzini disponibii (A, B) Private m_WarehouseList As New ObservableCollection(Of WarehouseVM) Public ReadOnly Property WarehouseList As ObservableCollection(Of WarehouseVM) Get Return m_WarehouseList End Get End Property - '----------------------------------------------------------------------------------------- ' definsice se deve ricalcolato la disposizione dei pezzi nel magazzino Private m_bOrganizeWarehouse As Boolean = True @@ -26,22 +24,6 @@ Public Class UnloadingAreaVM End Set End Property - '' magazzino A: contiene 3 GridBox per un totale di 6 pallet e 3 rack - 'Private m_WarehouseA As WarehouseVM - 'Public ReadOnly Property WarehouseA As WarehouseVM - ' Get - ' Return m_WarehouseA - ' End Get - 'End Property - - '' magazzino A: contiene 3 GridBox per un totale di 6 pallet e 3 rack - 'Private m_WarehouseB As WarehouseVM - 'Public ReadOnly Property WarehouseB As WarehouseVM - ' Get - ' Return m_WarehouseB - ' End Get - 'End Property - ' indica il magazzino attivo (letto dalla macchina) Private m_ActiveWarehouse As Warehouses Public ReadOnly Property ActiveWarehouse As Warehouses @@ -50,7 +32,7 @@ Public Class UnloadingAreaVM End Get End Property - ' attendo la definizione dei pezzi manuali + ' attendo la definizione dei pezzi manuali, Associato al bottone Reserve Private m_IsChecked_Manual As Boolean = False Public Property IsChecked_Manual As Boolean Get @@ -58,7 +40,8 @@ Public Class UnloadingAreaVM If m_IsChecked_Manual AndAlso GetParts(Place.ON_TABLE).Count = 0 Then Map.refSceneHostVM.MainScene.SetObjFilterForSel(False, False, True, False, False) Else - Map.refSceneHostVM.MainScene.SetStatusNull() + Map.refSceneHostVM.MainScene.SetObjFilterForSel(False, False, False, False, False) + 'Map.refSceneHostVM.MainScene.SetStatusNull() End If Return m_IsChecked_Manual End Get @@ -70,6 +53,28 @@ Public Class UnloadingAreaVM End Set End Property + ' messaggio da mostrare a video + Private m_OutputMessage As String + Public Property OutputMessage As String + Get + Return m_OutputMessage + End Get + Set(value As String) + m_OutputMessage = value + End Set + End Property + + ' colore del carattere del messaggio + Private m_OutputMessage_Foreground As Brush = Brushes.Black + Public Property OutputMessage_Foreground As Brush + Get + Return m_OutputMessage_Foreground + End Get + Set(value As Brush) + m_OutputMessage_Foreground = value + End Set + End Property + #Region "PARTS" ' elenco pezzi da scaricare (già ordinati) definita dalla funzione: CamAuto/MyUpdateVacuumsForUnloading() @@ -189,34 +194,6 @@ Public Class UnloadingAreaVM End Get End Property - Private m_PivotCX As Double - Public ReadOnly Property PivotCX As Double - Get - Return m_PivotCX - End Get - End Property - - Private m_PivotCY As Double - Public ReadOnly Property PivotCY As Double - Get - Return m_PivotCY - End Get - End Property - - Private m_PivotBX As Double - Public ReadOnly Property PivotBX As Double - Get - Return m_PivotBX - End Get - End Property - - Private m_PivotBY As Double - Public ReadOnly Property PivotBY As Double - Get - Return m_PivotBY - End Get - End Property - ' altezza massima sul pallet Private m_MaxHeight As Double Public ReadOnly Property MaxHeight As Double @@ -231,11 +208,26 @@ Public Class UnloadingAreaVM Return m_MaxLength End Get End Property - ' larghezza massima caricabile su pallet - Private m_MaxWidth As Double - Public ReadOnly Property MaxWidth As Double + + '' larghezza massima caricabile su pallet + 'Private m_MaxWidth As Double + 'Public ReadOnly Property MaxWidth As Double + ' Get + ' Return m_MaxWidth + ' End Get + 'End Property + + Private m_MaxTollerance As Double + Public ReadOnly Property MaxTollerance As Double Get - Return m_MaxWidth + Return m_MaxTollerance + End Get + End Property + + Private m_MinTollerance As Double + Public ReadOnly Property MinTollerance As Double + Get + Return m_MinTollerance End Get End Property @@ -247,6 +239,23 @@ Public Class UnloadingAreaVM End Get End Property + ' dimensione X del telaio porta ventose + Private m_VacuumDimX As Double = 1350 + Public ReadOnly Property VacuumDimX As Double + Get + Return m_VacuumDimX + End Get + End Property + + ' dimensione Y del telaio porta ventose + Private m_VacuumDimY As Double = 350 + Public ReadOnly Property VacuumDimY As Double + Get + Return m_VacuumDimY + End Get + End Property + + #End Region ' Offset pallet/rack #Region "PROPERTIES" @@ -406,6 +415,8 @@ Public Class UnloadingAreaVM #End Region ' PROPERTIES +#Region "OLD PROPERTIES" + Private m_TileType As Integer Public ReadOnly Property TileType As String Get @@ -441,8 +452,9 @@ Public Class UnloadingAreaVM End Get End Property +#End Region ' Old Properties + ' definizione comandi - Private m_cmdChangeWarehouse As ICommand Private m_cmdUnloadedWaistPart As ICommand Private m_cmdUnloadedManualPart As ICommand @@ -459,7 +471,7 @@ Public Class UnloadingAreaVM #Region "METHODS" - ' Modificato eliminando la lista m_WarehouseList + ' Rendo attivo il magazzino indicato (e disattivo l'altro) Friend Sub SetActiveWarehouse(ActiveWarehouse As Warehouses) ' verifico che il valore sia corretto, alrimenti assegno 0-> entrambi i magazzini sono disattivi If ActiveWarehouse < 0 OrElse ActiveWarehouse > 2 Then @@ -483,7 +495,10 @@ Public Class UnloadingAreaVM End If End Sub - '-------------------------------------------------------------------------------------- +#End Region ' METHODS + +#Region "OLD METHODS" + Friend Sub SetBoxIsActive(BoxId As Integer) If Not m_ActiveWarehouse > 0 AndAlso m_ActiveWarehouse <= 2 Then m_WarehouseList(GetWarehouseIndex(Warehouses.A)).SetBoxIsActive(0) @@ -550,10 +565,10 @@ Public Class UnloadingAreaVM Return 0 End If End Function - '-------------------------------------------------------------------------------------- -#End Region ' METHODS -#Region "New METHODS" +#End Region ' Old Methods + +#Region "NEW METHODS" Public Function Init() As Boolean ' verifico che siano state caricate correttamente le costanti @@ -565,18 +580,46 @@ Public Class UnloadingAreaVM SetOffset(K_RACKY, m_OffsetRackY) AndAlso SetOffset(K_ANGRACK, m_AngRack) AndAlso SetOffset(K_RULLERX, m_OffsetRullerX) AndAlso - SetOffset(K_RULLERY, m_OffsetRullerY) AndAlso - SetOffset(K_PIVOTCX, m_PivotCX) AndAlso - SetOffset(K_PIVOTCY, m_PivotCY) AndAlso - SetOffset(K_PIVOTBX, m_PivotBX) AndAlso - SetOffset(K_PIVOTBX, m_PivotBX) + SetOffset(K_RULLERY, m_OffsetRullerY) Dim bSetMaxPallet As Boolean = SetMaxPallet(K_MAX_HEIGHT, m_MaxHeight) AndAlso SetMaxPallet(K_MAX_LENGTH, m_MaxLength) AndAlso - SetMaxPallet(K_MAX_WIDTH, m_MaxWidth) + SetMaxPallet(K_MAX_TOL, m_MaxTollerance) AndAlso + SetMaxPallet(K_MIN_TOL, m_MinTollerance) + Dim bSetMaxRack As Boolean = SetMaxTileRack(K_MAX_TILE, m_MaxTile) + + Dim bSetVacuumDimension As Boolean = SetDimVacuum(K_VACUUM_DIMX, m_VacuumDimX) AndAlso + SetDimVacuum(K_VACUUM_DIMY, m_VacuumDimY) + Return bSetOffset And bSetMaxPallet And bSetMaxRack End Function + Public Overloads Sub SetOutputMessage(sMessage As String, Optional nMsgType As MSG_TYPE = MSG_TYPE.INFO) + SetMsgColor(nMsgType) + m_OutputMessage = sMessage + NotifyPropertyChanged("OutputMessage") + End Sub + + + Public Sub SetMsgColor(nMsgType As MSG_TYPE) + Select Case nMsgType + Case MSG_TYPE.INFO + m_OutputMessage_Foreground = Brushes.Black + Case MSG_TYPE.WARNING + m_OutputMessage_Foreground = Brushes.SaddleBrown + Case MSG_TYPE.ERROR_ + m_OutputMessage_Foreground = Brushes.Red + End Select + NotifyPropertyChanged("OutputMessage_Foreground") + End Sub + + Public Overridable Sub ClearOutputMessage() + m_OutputMessage_Foreground = Brushes.Black + NotifyPropertyChanged("MsgColor") + m_OutputMessage = String.Empty + NotifyPropertyChanged("OutputMessage") + End Sub + ' leggo dalla configurazione gli offset dei pallet e dei rack Public Function SetOffset(sName As String, ByRef dVal As Double) As Boolean Dim sVal As String = String.Empty @@ -592,6 +635,20 @@ Public Class UnloadingAreaVM Return True End Function + Public Function SetDimVacuum(sName As String, ByRef dVal As Double) As Boolean + Dim sVal As String = String.Empty + If GetMainPrivateProfileString(S_DIM_VACUMM, sName, "0", sVal) < 0 Then + EgtOutLog("Error reading file Config.ini [Vacuum] -> " & sName) + Return False + Else + If Not StringToLen(sVal, dVal) Then + EgtOutLog("Error reading file Config.ini [Vacuum] -> " & sName & " is not numeric") + Return False + End If + End If + Return True + End Function + ' leggo le dimensioni massime caricabili su pallet Public Function SetMaxPallet(ByVal sName As String, ByRef dVal As Double) As Boolean Dim sVal As String = String.Empty @@ -607,7 +664,7 @@ Public Class UnloadingAreaVM Return True End Function - ' leggo del dimansioni massim e caricabili su rack + ' leggo del dimansioni massime caricabili su rack Public Function SetMaxTileRack(ByVal sName As String, ByRef nVal As Integer) As Boolean Dim sVal As String = String.Empty If GetMainPrivateProfileString(S_BOX, sName, "0", sVal) < 0 Then @@ -623,7 +680,7 @@ Public Class UnloadingAreaVM Return True End Function - ' restituisco la lista di tutti i pezzi identificati dalla stessa posizione (di default quelli buoni) del progetto corrente + ' restituisco la lista di tutti i pezzi identificati dalla stessa posizione (di default quelli buoni) del progetto corrente sul tavolo Public Function GetParts(DefinePlce As Place, Optional DefineStatus As StatusPart = StatusPart.GOOD) As ObservableCollection(Of Part) Dim CurrList As New ObservableCollection(Of Part) For Each Item In Map.refUnloadingAreaVM.ListPart @@ -656,6 +713,7 @@ Public Class UnloadingAreaVM Return CurrList End Function + ' restituisce l'oggetto magazzino Public Function GetWarehouse(WarehouseId As Warehouses) As WarehouseVM For Each ItemWarehouse In m_WarehouseList If ItemWarehouse.Id = WarehouseId Then Return ItemWarehouse @@ -677,13 +735,17 @@ Public Class UnloadingAreaVM Public Function OrganaizeWarehouse(Optional ByVal Me_Warehouse As WarehouseVM = Nothing) As Boolean ' Se il progetto è terminato (scarico dell'ultimo pezzo avvenuto) If m_IdProjTable2.enStatus = StatusProj.DONE Then + Dim bNewProjectExist As Boolean = False ' ricerco il primo proggetto in attesa di essere alaborato dalla tavola 2 (LOADING) For Each ItemProj In Map.refMainWindowVM.MainWindowM.ProjIndList If ItemProj.enStatus = StatusProj.LOADING Then m_IdProjTable2 = ItemProj + bNewProjectExist = True Exit For End If Next + ' se non c'è un nuovo progetto allora esco + If Not bNewProjectExist Then Return True ElseIf m_IdProjTable2.enStatus = StatusProj.WORKING Then Return True ElseIf Map.refMainWindowVM.MainWindowM.ProjIndList.Count = 0 Then @@ -733,10 +795,9 @@ Public Class UnloadingAreaVM OutLogProcess("OrganaizeWarehouse() -> Pezzi sulla rulliera: " & ListMotorRuller.Count) For Each ItemPart In ListMotorRuller If ItemPart.enUnloading = Unloading.AUTOMATIC Then - If ItemPart.MinRectX > m_MaxLength Or ItemPart.MinRectY > m_MaxWidth Then + If ItemPart.MinRectX > m_MaxLength Then RackPartList.Add(ItemPart) nPartOnRack = nPartOnRack + 1 - OutLogProcess("OrganaizeWarehouse() -> Pezzo fuori dalle dimensioni massime pallet: " & ItemPart.IdPart.ToString) Else PalletPartList.Add(ItemPart) nPartOnPallet = nPartOnPallet + 1 @@ -748,10 +809,9 @@ Public Class UnloadingAreaVM OutLogProcess("OrganaizeWarehouse() -> Pezzi sul tavolo: " & ListTable.Count) For Each ItemPart In ListTable If ItemPart.enUnloading = Unloading.AUTOMATIC Then - If ItemPart.MinRectX > m_MaxLength Or ItemPart.MinRectY > m_MaxWidth Then + If ItemPart.MinRectX > m_MaxLength Then RackPartList.Add(ItemPart) nPartOnRack = nPartOnRack + 1 - OutLogProcess("OrganaizeWarehouse() -> Pezzo fuori dalle dimensioni massime rack: " & ItemPart.IdPart.ToString) Else PalletPartList.Add(ItemPart) nPartOnPallet = nPartOnPallet + 1 @@ -772,55 +832,107 @@ Public Class UnloadingAreaVM Dim nTemRack As Integer = CInt(Math.Ceiling(nPartOnRack / m_MaxTile)) If nTemRack > nRack Then EgtOutLog("Error: needs rack for unloading some parts") - Return False - End If - ' verifico numero di pallet necessari-> cambio magazzino - Dim nTemPallet As Integer = CInt(Math.Ceiling((nPartOnPallet * dHeightTile) / (m_MaxHeight))) - If nTemPallet > nPallet Then - EgtOutLog("Error: needs more pallets for unloading") + SetOutputMessage("You need " & nTemRack.ToString & " rack for unloading.") Return False End If - ' riempio i box con i part che ho trovato, partendo dai rack perchè sono i pezzi più grandi - For IndexPart = 0 To RackPartList.Count - 1 - For IndexBox = 0 To nTemRack - 1 - If IndexPart <= RackPartList.Count - 1 Then - RackPartList(IndexPart).IdBox = AvailableRackList(IndexBox).Id - ' salvo l'informazione nel file PartList - PartWritePrivateProfileInt(PalletPartList(IndexPart).IdProject, ConstIni.S_PART & PalletPartList(IndexPart).IdPart.ToString, "IdBox", PalletPartList(IndexPart).IdBox) - RackPartList(IndexPart).enWarehouse = CurrWarehause.Id - AvailableRackList(IndexBox).MyListPart.Add(RackPartList(IndexPart)) - IndexPart = IndexPart + 1 - End If - If IndexPart > 0 Then - IndexPart = IndexPart - 1 - End If - Next + ' recupero l'indice di Layer massimo + Dim nMaxLayer As Integer = 0 + For Each ItemPart In PalletPartList + If ItemPart.nLayer > nMaxLayer Then + nMaxLayer = ItemPart.nLayer + End If Next + Dim nTemPallet As Integer = CInt(Math.Ceiling((nMaxLayer + 1) * dHeightTile / m_MaxHeight)) + ' se non ci sono abbastanza pallet allora resituisco falso + If nTemPallet > nPallet Then + EgtOutLog("Error: needs more pallets for unloading") + SetOutputMessage("You need " & nTemPallet.ToString & " pallet for unloading.") + Return False + End If + + ' ripulisco i messaggi + ClearOutputMessage() + + ' verico che i rack non siano stati già riempiti + Dim bOrganizeRack As Boolean = True + If RackPartList.Count > 0 Then + If RackPartList(0).IdBox > -1 Then + OutLogProcess("OrganaizeWarehouse() -> Magazzino rack già organizzato per progetto: " & m_IdProjTable2.nProjInd.ToString) + bOrganizeRack = False + End If + End If + + If bOrganizeRack Then + ' riempio i box con i part che ho trovato, partendo dai rack perchè sono i pezzi più grandi + For IndexPart = 0 To RackPartList.Count - 1 + For IndexBox = 0 To nTemRack - 1 + If IndexPart <= RackPartList.Count - 1 Then + ' recupero e salvo l'indice del rack disponibile + RackPartList(IndexPart).IdBox = AvailableRackList(IndexBox).Id + RackPartList(IndexPart).enWarehouse = CurrWarehause.Id + RackPartList(IndexPart).nLayer = -1 + AvailableRackList(IndexBox).MyListPart.Add(RackPartList(IndexPart)) + ' passo al prossimo pezzo + IndexPart = IndexPart + 1 + End If + If IndexPart > 0 Then + IndexPart = IndexPart - 1 + End If + Next + Next + End If + + ' verifico che il magazzino no sua già stato organizzato + If PalletPartList.Count > 0 Then + If PalletPartList(0).IdBox > -1 Then + OutLogProcess("OrganaizeWarehouse() -> Magazzino pallet già organizzato per progetto: " & m_IdProjTable2.nProjInd.ToString) + Return True + End If + End If + + ' parto dal primo layer calcolato + Dim nCurrLayer As Integer = 0 + ' definisco quale Layer deve essere riempito per tutti i pallet + Dim SetCurrLayer As Integer = 0 For IndexPart = 0 To PalletPartList.Count - 1 For IndexBox = 0 To nTemPallet - 1 - If IndexPart <= PalletPartList.Count - 1 Then - PalletPartList(IndexPart).IdBox = AvailablePalletList(IndexBox).Id - ' salvo l'informazione nel file PartList - PartWritePrivateProfileInt(PalletPartList(IndexPart).IdProject, ConstIni.S_PART & PalletPartList(IndexPart).IdPart.ToString, "IdBox", PalletPartList(IndexPart).IdBox) - PalletPartList(IndexPart).enWarehouse = CurrWarehause.Id - AvailablePalletList(IndexBox).MyListPart.Add(PalletPartList(IndexPart)) + While IndexPart <= PalletPartList.Count - 1 + If nCurrLayer = PalletPartList(IndexPart).nLayer Then + ' recupero e salvo l'indice del pallet disponibile + PalletPartList(IndexPart).IdBox = AvailablePalletList(IndexBox).Id + ' salvo l'informazione del layer Corrente sul pallet + PalletPartList(IndexPart).nLayer = SetCurrLayer + ' indico il magazzno di appartenenza + PalletPartList(IndexPart).enWarehouse = CurrWarehause.Id + ' salvo le informazioni del pezzo nella lista del Boox + AvailablePalletList(IndexBox).MyListPart.Add(PalletPartList(IndexPart)) + Else + Exit While + End If + ' passo al prossimo pezzo del layer corrente (altrimenti è il primo pezzo del layer successivo) IndexPart = IndexPart + 1 - End If + End While + ' il prossimo pallet conterrà lo strato di layer successivo + nCurrLayer = nCurrLayer + 1 Next + ' ho terminato di riempire la stessa quota di layer su tutti i pallet disponibili If IndexPart > 0 Then + ' perchè il ciclo "For" incrementa l'inidce dei pezzi (incrementati manualmente nel ciclo While) IndexPart = IndexPart - 1 End If + ' indicizzo il nuovo strato di layer da salvare per i pallet + SetCurrLayer = SetCurrLayer + 1 Next OutLogProcess("OrganaizeWarehouse() -> Organizzato magazzino per progetto: " & m_IdProjTable2.nProjInd.ToString) Return True End Function -#End Region 'New METHODS +#End Region 'New Methods #Region "COMMANDS" -#Region "Confirm" +#Region "UnloadTable1" ' Returns a command that manage the MainWindow_Unloaded command Public ReadOnly Property UnloadedWaistPart_Command() As ICommand @@ -841,9 +953,9 @@ Public Class UnloadingAreaVM NotifyPropertyChanged("TableDifference") End Sub -#End Region ' Confirm +#End Region ' UnloadTable1 -#Region "Unloaded" +#Region "UnloadedManualPart" Public ReadOnly Property UnloadedManualPart_Command() As ICommand Get @@ -854,7 +966,7 @@ Public Class UnloadingAreaVM End Get End Property - ' scarico tutti i pezzi manuali rimasti sulla rulliera + ' scarico tutti i pezzi MANUALI rimasti sulla rulliera Public Sub UnloadedManualPart() Dim bManualUnloaded As Boolean = False For Each ItemPart In GetParts(Place.ON_MOTOR_RULLER, StatusPart.GOOD) @@ -880,9 +992,15 @@ Public Class UnloadingAreaVM My.Computer.FileSystem.DeleteFile(sFile) OutLogProcess("UnloadedManualPart() -> Eliminato file: " & sFile) End If + ' 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 End Sub -#End Region ' Unloaded +#End Region ' UnloadedManualPart #End Region ' COMMANDS diff --git a/Utility/Map.vb b/Utility/Map.vb index 27e52a8..6606531 100644 --- a/Utility/Map.vb +++ b/Utility/Map.vb @@ -55,6 +55,7 @@ Module Map Friend Function BeginInit(MainWindowVM As MainWindowVM) As Boolean m_refMainWindowVM = MainWindowVM + ' quando avvio il programma creo la classe per la camera Return Not IsNothing(m_refMainWindowVM) End Function diff --git a/Utility/Utility.vb b/Utility/Utility.vb index 54bc3e3..8c74d2a 100644 --- a/Utility/Utility.vb +++ b/Utility/Utility.vb @@ -3,8 +3,17 @@ Imports EgtUILib Module Utility + Friend Sub UpdateUI() + ' Costringo ad aggiornare UI + Dim nDummy As Integer + Application.Current.Dispatcher.Invoke(Windows.Threading.DispatcherPriority.Background, + New Action(Function() nDummy = 0)) + End Sub + Friend m_WarehouseIniFile As String = String.Empty + Friend m_PrintLogProces As Boolean = True + ' leggo le informazioni del magazzino Friend Function WarehauseGetPrivateProfileString(ByVal IpAppName As String, ByVal IpKeyName As String, ByVal IpDefault As String, ByRef IpString As String) As Integer Return EgtUILib.GetPrivateProfileString(IpAppName, IpKeyName, IpDefault, IpString, m_WarehouseIniFile) @@ -187,6 +196,8 @@ Module Utility ' scrivo in un file di testo le infomrazioni tutte le info che mi servono per studiare il percorso dei dati Friend Sub OutLogProcess(sRow As String) Dim file As System.IO.StreamWriter + ' scrivo questo file solo se attvo LogProces = 1 in [General] del file OmagVIEWPlus.ini + If Not m_PrintLogProces Then Return file = My.Computer.FileSystem.OpenTextFileWriter(Map.refMainWindowVM.MainWindowM.sTempDir & "\ProcessLog.txt", True) file.WriteLine(sRow) file.Close() diff --git a/Warehouse/Box.vb b/Warehouse/Box.vb index d9185a4..d25e647 100644 --- a/Warehouse/Box.vb +++ b/Warehouse/Box.vb @@ -258,9 +258,9 @@ Public Class Box End Function ' restituisce la coordinata X in funzione delle dimensioni del pezzo da depositare - Public Function GetRackOffsetX() As Double + Public Function GetRackOffsetZ(LocalPart As Part) As Double ' decido di lavorare nel piano della piastrella - Dim nCounter As Double = 1 + Dim nCounter As Double = 0 Dim dHeight As Double = 1 ' inizializzo l'altezza di deposito con lo spessore del pezzo For Each ItemPart In MyListPart @@ -279,10 +279,18 @@ Public Class Box Return OffsetX End Function - ' restituisce la coordinata Z in funzione delle dimensioni del pezzo da depositare - Public Function GetRackOffsetZ(MinRectY As Double) As Double - ' ricevo la coordinata y del vettore che unisce il centro allo spigolo in altoa snistra - Return MinRectY + ' restituisce la coordinata X in funzione delle dimensioni del pezzo da depositare + Public Function GetRackOffsetY(LocalPart As Part) As Double + Dim OffsetY As Double = 0 + OffsetY = LocalPart.MinRectY / 2 - (Map.refUnloadingAreaVM.VacuumDimY / 2 - LocalPart.MoveTable2.m_vtDelta.y) + Return OffsetY + End Function + + ' restituisce la coordinata X in funzione delle dimensioni del pezzo da depositare + Public Function GetRackOffsetX(LocalPart As Part) As Double + Dim OffsetX As Double = Map.refUnloadingAreaVM.OffsetRackY + OffsetX = OffsetX + LocalPart.MoveTable2.m_vtDelta.x + Return OffsetX End Function '-------------------------------------------------------------------------------------------------------------------- diff --git a/Warehouse/WarehouseVM.vb b/Warehouse/WarehouseVM.vb index 9daee50..32fb63d 100644 --- a/Warehouse/WarehouseVM.vb +++ b/Warehouse/WarehouseVM.vb @@ -391,7 +391,13 @@ Public Class WarehouseVM Dim enStatus As States = States.NOT_AVAILABLE ' carico lo STATO del Box (di default non è disponibile) If sItems.Count >= 1 And IsNumeric(sItems(0)) Then - enStatus = CType(CInt(sItems(0)), States) + ' se il box è in fase di carico lo ridefinisco come non disponibile + If CInt(sItems(0)) = 3 Then + enStatus = CType(0, States) + Else + enStatus = CType(CInt(sItems(0)), States) + End If + End If ' carico la definizione della sua origine Dim nOrig As Integer = 0