Imports System.IO Imports System.Threading Imports System.Globalization Imports EgtUILib Imports EgtWPFLib5 Imports EgtBEAMWALL.Core.ConstBeam Imports EgtBEAMWALL.Core Public Class CalcIntegration Private _thread As System.Threading.Thread Public Enum CmdType As Integer GENERATE = 0 MODIFY = 1 SIMULATE = 2 CHECK = 3 CHECKGEN = 4 POINT_CLOUD = 5 RAWPART = 6 End Enum Public Class Bar 'Public piInfo As PatternInfo Public nBarState As Integer Public nBarId As Integer Public sBarPath As String Public bBarOk As Boolean Public nCmdType As Integer Public nBarType As ProjectType End Class Private Structure MyProc Public bEnable As Boolean Public Proc As Process Public nBar As Integer End Structure Public Sub New() End Sub Delegate Sub CallbackDlg(dProgress As Double, sProgress As String, ByRef bCancel As Boolean) Public Sub Run(vBar As Bar(), sProjDirPath As String, callback As CallbackDlg) _thread = New Thread(Sub() DoJob(vBar, sProjDirPath, callback) End Sub) _thread.Start() End Sub Private Shared Sub DoJob(vBar As Bar(), sProjDirPath As String, callback As CallbackDlg) Dim bCancel As Boolean = False callback(0, "Init", bCancel) ' creo progetti a seconda del tipo For Each Bar In vBar If Bar.nBarType = ProjectType.PROJ Then Bar.sBarPath = CreateNewProjectFromPart(Bar.nBarId, sProjDirPath) ElseIf Bar.nBarType = ProjectType.PROD Then Bar.sBarPath = CreateNewProjectFromMachGroup(Bar.nBarId, sProjDirPath) End If Next callback(0.1, "", bCancel) Dim ExePath As String = String.Empty GetMainPrivateProfileString(S_BEAM, K_CALCPATH, "", ExePath) ' Numero di barre Dim numBars As Integer = vBar.Count If numBars = 0 Then Return ' Numero di core logici da utilizzare (minimo tra presenti sul PC e imposti da INI) Dim nMaxThread As Integer = Math.Min(Environment.ProcessorCount, Map.refMainWindowVM.MainWindowM.GetMaxInstances()) ' Frazione di avanzamento del lavoro (in piu) Dim dProgress As Double = 0 'indice incremento progress durante calcolo barra Dim nPgsCurrBar As Integer = 0 Dim nPgsClock As Integer = 0 ' Lancio in parallelo più processi (senza superare il numero di core logici presenti) Dim vProc As MyProc() = New MyProc(nMaxThread - 1) {} For j As Integer = 0 To nMaxThread - 1 vProc(j).nBar = -1 vProc(j).bEnable = True Next ' Processo i Btl in parallelo Dim nCurrBar As Integer = 0 Dim nDoneBar As Integer = 0 Dim nShiftBar As Integer = 0 Dim nActProc As Integer = 0 While nCurrBar < numBars + nShiftBar OrElse nActProc > 0 For j As Integer = 0 To nMaxThread - 1 If Not vProc(j).bEnable Then Continue For Dim bDone As Boolean = False If vProc(j).nBar = -1 Then If nCurrBar < numBars + nShiftBar Then If vBar(nCurrBar).bBarOk Then vProc(j).Proc = New Process() vProc(j).Proc.StartInfo.FileName = ExePath vProc(j).Proc.StartInfo.Arguments = """" & vBar(nCurrBar).sBarPath & """ " & """" & Map.refMachinePanelVM.SelectedMachine.nType & """ " & """" & Map.refMachinePanelVM.SelectedMachine.Name & """ " & vBar(nCurrBar).nCmdType vProc(j).Proc.StartInfo.UseShellExecute = False If vProc(j).Proc.Start() Then vProc(j).nBar = nCurrBar nCurrBar += 1 nActProc += 1 End If Else If vBar(nCurrBar).nCmdType = CmdType.CHECK OrElse vBar(nCurrBar).nCmdType = CmdType.CHECKGEN Then ProcessResults(vBar(nCurrBar)) bDone = True nCurrBar += 1 End If End If Else If vProc(j).Proc.HasExited Then ' se terminato con successo If vProc(j).Proc.ExitCode = 0 Then ' salvo il risultato If vBar(vProc(j).nBar).nCmdType = CmdType.CHECK OrElse vBar(vProc(j).nBar).nCmdType = CmdType.CHECKGEN Then ProcessResults(vBar(vProc(j).nBar)) bDone = True vProc(j).nBar = -1 nActProc -= 1 ' se superato il numero di processi eseguibili in parallelo ElseIf vProc(j).Proc.ExitCode = 1 Then ' aggiungo il pezzo in coda If numBars + nShiftBar < numBars + nMaxThread Then vBar(numBars + nShiftBar) = vBar(vProc(j).nBar) nShiftBar += 1 End If ' disabilito il processo vProc(j).bEnable = False vProc(j).nBar = -1 nActProc -= 1 ' altrimenti (errore generico di esecuzione) Else ' salvo il risultato If vBar(vProc(j).nBar).nCmdType = CmdType.CHECK OrElse vBar(vProc(j).nBar).nCmdType = CmdType.CHECKGEN Then ProcessResults(vBar(vProc(j).nBar)) bDone = True vProc(j).nBar = -1 nActProc -= 1 End If Else vProc(j).Proc.Refresh() End If End If If bDone Then ' Dialog con Progress Bar nDoneBar += 1 dProgress = 1 / numBars * nDoneBar Dim sProg As String = (dProgress * 100).ToString("F1", CultureInfo.InvariantCulture) callback(dProgress, " Progress: " & sProg & "% Count: " & nDoneBar & " / " & numBars, bCancel) If bCancel Then ' fine callback(1, "", bCancel) Return End If nPgsCurrBar = 0 nPgsClock = 0 Else If nPgsClock >= 100 AndAlso nPgsCurrBar < 149 Then nPgsCurrBar += 1 dProgress = 1 / numBars * nDoneBar + 1 / numBars / 150 * nPgsCurrBar Dim sProg As String = (dProgress * 100).ToString("F1", CultureInfo.InvariantCulture) callback(dProgress, " Progress: " & sProg & "% Count: " & nDoneBar & " / " & numBars, bCancel) nPgsClock = 0 End If End If nPgsClock += 1 Thread.Sleep(1) Next ' Verifico che i processi non siano andati tutti in errore Dim bAllKO As Boolean = True For j As Integer = 0 To nMaxThread - 1 If vProc(j).bEnable Then bAllKO = False Next If bAllKO Then MessageBox.Show("Execution error (all processes are disabled)") Exit While End If Thread.Sleep(10) End While Thread.Sleep(300) ' fine callback(1, "Done", bCancel) Map.refMyStatusBarVM.ResetStopProgress() End Sub Private Shared Function CreateNewProjectFromPart(nPartId As Integer, sProjDirPath As String) As String ' Aggiorno identificativi per segnalazione errori UpdateCutIdAndTaskId(nPartId) ' Disabilito segnalazione modificato Dim DisableMgr As New DisableModifiedMgr ' Recupero visibilita' pezzo e lo imposto a visibile Dim nOldPartMode As Integer EgtGetMode(nPartId, nOldPartMode) EgtSetMode(nPartId, GDB_MD.STD) ' Salvo pezzo nel suo progetto Dim bOk As Boolean = False Dim nPDN As Integer = 0 EgtGetInfo(nPartId, BTL_PRT_PDN, nPDN) Dim sPartFilePath As String = sProjDirPath & "\" & nPDN.ToString() & ".bwe" bOk = EgtSaveObjToFile(nPartId, sPartFilePath, NGE.BIN) ' Ripristino visibilita' pezzo EgtSetMode(nPartId, nOldPartMode) ' Ripristino stato segnalazione modifica DisableMgr.ReEnable() Return If(bOk, sPartFilePath, String.Empty) End Function Private Shared Function CreateNewProjectFromMachGroup(nMachGroupId As Integer, sProjDirPath As String) As String ' Aggiorno identificativi per segnalazione errori Dim nOldMachGroup As Integer = EgtGetCurrMachGroup() If nMachGroupId <> nOldMachGroup Then EgtSetCurrMachGroup(nMachGroupId) Dim nRawId As Integer = EgtGetFirstRawPart() While nRawId <> GDB_ID.NULL If EgtVerifyRawPartPhase(nRawId, 1) Then Dim nPartId As Integer = EgtGetFirstPartInRawPart(nRawId) While nPartId <> GDB_ID.NULL UpdateCutIdAndTaskId(nPartId) nPartId = EgtGetNextPartInRawPart(nPartId) End While End If nRawId = EgtGetNextRawPart(nRawId) End While If nMachGroupId <> nOldMachGroup Then If nOldMachGroup <> GDB_ID.NULL Then EgtSetCurrMachGroup(nOldMachGroup) Else EgtResetCurrMachGroup() End If End If ' Salvo gruppo di lavorazione nel suo progetto Dim sMachGroupFilePath As String = sProjDirPath & "\" & nMachGroupId.ToString() & ".bwe" If EgtSaveObjToFile(nMachGroupId, sMachGroupFilePath, NGE.BIN) Then Return sMachGroupFilePath End If Return String.Empty End Function Private Shared Function UpdateCutIdAndTaskId(nPartId As Integer) As Boolean ' Assegno Id a CutId per calcoli EgtSetInfo(nPartId, "CUTID", nPartId, True) ' Assegno TASKID alle feature per calcoli Dim nProcessingId As Integer = EgtGetFirstNameInGroup(nPartId, PROCESSINGS) Dim nFeatureId As Integer = EgtGetFirstInGroup(nProcessingId) While nFeatureId <> GDB_ID.NULL ' verifico che sia una feature Dim nGRP As Integer If EgtGetInfo(nFeatureId, BTL_FTR_GRP, nGRP) Then ' assegno TASKID alla feature per calcoli EgtSetInfo(nFeatureId, "TASKID", nFeatureId, True) End If nFeatureId = EgtGetNext(nFeatureId) End While Return True End Function Private Shared Sub ProcessResults(Bar As Bar) Dim BtlPath As String = Bar.sBarPath Dim ResPath As String = Path.ChangeExtension(BtlPath, ".txt") Dim bErrors As Boolean = False Dim nLastErr As Integer = 0 Dim sLastMsg As String = "" Dim nCurrCutId As Integer = 0 Dim nTotTime As Integer = 0 If File.Exists(ResPath) Then Dim nErr As Integer = 0 Dim sMsg As String = "" Dim dRot As Double = 0 Dim nFall As Integer = 0 Dim dPartRot As Double = 0 Dim dTotRot As Double = 0 Dim cutId As Integer = 0 Dim taskId As Integer = 0 Dim prevCutId As Integer = GDB_ID.NULL Dim currBTLPart As BTLPartVM = Nothing Dim currPart As PartVM Dim lines As String() = System.IO.File.ReadAllLines(ResPath) For Each line As String In lines If line.StartsWith("ERR=") Then Dim nVal As Integer? = GetVal(line, "ERR") nErr = (If(nVal IsNot Nothing, nVal.Value, 0)) sMsg = "" dRot = 0 cutId = 0 taskId = 0 ElseIf line.StartsWith("ROT=") Then Dim nVal As Integer? = GetVal(line, "ROT") Dim nRot As Integer = (If(nVal IsNot Nothing, nVal.Value, 0)) dRot = Math.Abs(((4 - nRot) Mod 4) * 90) dPartRot = Math.Max(dPartRot, dRot) dTotRot = Math.Max(dTotRot, dRot) ElseIf line.StartsWith("CUTID=") Then Dim nVal As Integer? = GetVal(line, "CUTID") cutId = (If(nVal IsNot Nothing, nVal.Value, 0)) If cutId <> prevCutId Then ' aggiornamento globale pezzo precedente If prevCutId <> GDB_ID.NULL Then EgtSetInfo(prevCutId, If(Bar.nBarType = ProjectType.PROJ, ITG_PROJ_ROT, ITG_PROD_ROT), dTotRot, True) dTotRot = 0 End If ' aggiornamento risultati in struttura BTL If Bar.nBarType = ProjectType.PROJ Then ' cerco pezzo in btl structure da id For Each Part In Map.refProjectVM.BTLStructureVM.BTLPartVMList If Part.nPartId = cutId Then currBTLPart = Part End If Next ElseIf Bar.nBarType = ProjectType.PROD Then For Each MachGroup As MyMachGroupVM In Map.refMachGroupPanelVM.MachGroupVMList For Each Part In MachGroup.PartVMList If Part.nPartId = cutId Then currPart = Part End If Next Next End If prevCutId = cutId End If ElseIf line.StartsWith("TASKID=") Then Dim nVal As Integer? = GetVal(line, "TASKID") taskId = (If(nVal IsNot Nothing, nVal.Value, 0)) ' se taskid diverso da zero, errore feature If taskId <> 0 Then EgtSetInfo(taskId, If(Bar.nBarType = ProjectType.PROJ, ITG_PROJ_ERR, ITG_PROD_ERR), nErr, True) EgtSetInfo(taskId, If(Bar.nBarType = ProjectType.PROJ, ITG_PROJ_MSG, ITG_PROD_MSG), sMsg, True) EgtSetInfo(taskId, If(Bar.nBarType = ProjectType.PROJ, ITG_PROJ_ROT, ITG_PROD_ROT), dRot, True) ' aggiornamento risultati in struttura BTL If Bar.nBarType = ProjectType.PROJ Then ' cerco task in btl structure da id If Not IsNothing(currBTLPart) Then For Each Feature In currBTLPart.BTLFeatureVMList If Feature.nFeatureId = taskId Then DirectCast(Feature, BTLFeatureVM).CalcFeatureUpdate(True, nErr, dRot, nFall, sMsg) End If Next End If ElseIf Bar.nBarType = ProjectType.PROD Then ' cerco task in MachGroupList da id If Not IsNothing(currPart) Then For Each Feature In currPart.FeaturevMList If Feature.nFeatureId = taskId Then DirectCast(Feature, BTLFeatureVM).CalcFeatureUpdate(True, nErr, dRot, nFall, sMsg) End If Next End If End If ' se taskid uguale a zero, errore pezzo ElseIf cutId <> 0 Then EgtSetInfo(cutId, If(Bar.nBarType = ProjectType.PROJ, ITG_PROJ_ERR, ITG_PROD_ERR), nErr, True) EgtSetInfo(cutId, If(Bar.nBarType = ProjectType.PROJ, ITG_PROJ_MSG, ITG_PROD_MSG), sMsg, True) ' aggiorno in struttura btl If Bar.nBarType = ProjectType.PROJ Then If Not IsNothing(currBTLPart) Then currBTLPart.CalcPartUpdate(True, nErr, dRot, nFall, sMsg) ElseIf Bar.nBarType = ProjectType.PROD Then If Not IsNothing(currPart) Then currPart.CalcPartUpdate(True, nErr, dRot, nFall, sMsg) End If End If ElseIf line.StartsWith("FALL=") Then Dim nVal As Integer? = GetVal(line, "FALL") If Not IsNothing(nVal) Then nFall = nVal Else nFall = 0 End If ElseIf line.StartsWith("TIME=") Then Dim nVal As Integer? = GetVal(line, "TIME") nTotTime = (If(nVal IsNot Nothing, nVal.Value, 0)) If Bar.nBarType = ProjectType.PROJ AndAlso Not IsNothing(currBTLPart) Then EgtSetInfo(currBTLPart.nPartId, If(Bar.nBarType = ProjectType.PROJ, ITG_PROJ_TIME, ITG_PROD_TIME), nTotTime, True) End If ElseIf Not String.IsNullOrWhiteSpace(line) AndAlso line <> "---" Then sMsg = line End If Next Else bErrors = True nLastErr = 25 sLastMsg = "Execution Error" End If ' aggiornamento risultati in struttura BTL If Bar.nBarType = ProjectType.PROJ Then ' cerco pezzo in btl structure da id For Each Part In Map.refProjectVM.BTLStructureVM.BTLPartVMList If Part.nPartId = Bar.nBarId Then ' leggo errori da geometria e li aggiorno in struttura btl DirectCast(Part, BTLPartVM).CalcFeatureUpdate() ' aggiungo nota che indica macchina End If Next ElseIf Bar.nBarType = ProjectType.PROD Then ' cerco pezzo in MachGroupList da id For Each MachGroup As MyMachGroupVM In Map.refMachGroupPanelVM.MachGroupVMList If MachGroup.Id = Bar.nBarId Then For Each Part In MachGroup.PartVMList ' leggo errori da geometria e li aggiorno in struttura btl Part.CalcFeatureUpdate() Next MachGroup.CalcMachGroupUpdate() End If Next End If End Sub Private Shared Function GetVal(sText As String, sKey As String) As Integer? Dim sParts As String() = sText.Split("="c) If String.Compare(sParts(0), sKey) <> 0 Then Return Nothing Dim nVal As Integer = Nothing If Not Integer.TryParse(sParts(1), nVal) Then Return Nothing Else Return nVal End If End Function End Class