Imports System.IO Imports System.Threading Imports System.Globalization Imports EgtUILib Imports EgtWPFLib5 Imports EgtBEAMWALL.Core.ConstBeam Imports EgtBEAMWALL.Core Public Module CalcIntegration Private _thread As System.Threading.Thread Public Event Calc_Ended As EventHandler(Of CalcEndEventArgs) Public Event Calc_ProcessResult As EventHandler(Of CalcResultEventArgs) Public Event Calc_ProcessEnd As EventHandler(Of CalcProcessEndEventArgs) Public Enum CmdType As Integer GENERATE = 0 MODIFY = 1 SIMULATE = 2 CHECK = 3 CHECKGEN = 4 POINT_CLOUD = 5 RAWPART = 6 End Enum Private Structure MyProc Public bEnable As Boolean Public Proc As Process Public nBar As Integer End Structure Private m_MaxCamInstances As Integer = 1 Public Sub SetMaxCamInstances(value As Integer) m_MaxCamInstances = value 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 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.nProgramPage = ProjectType.PROJ Then Bar.sBarPath = CreateNewProjectFromPart(Bar.nBarId, sProjDirPath) ElseIf Bar.nProgramPage = ProjectType.PROD Then Bar.sBarPath = CreateNewProjectFromMachGroup(Bar.nBarId, sProjDirPath) End If Next Dim bIsSimulation As Boolean = False ' se sono in simulazione If vBar.Count > 0 AndAlso vBar(0).nCmdType = CmdType.SIMULATE Then bIsSimulation = True callback(0, "Simulation opened", bCancel) Else callback(0.1, "", bCancel) End If 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, m_MaxCamInstances) ' 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 Dim bAllKO As Boolean 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 & """ " & """" & vBar(nCurrBar).nProjType & """ " & """" & vBar(nCurrBar).nMachineName & """ " & 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 RaiseEvent Calc_ProcessResult(Nothing, New CalcResultEventArgs(vBar(nCurrBar))) 'ProcessResults(vBar(nCurrBar)) ElseIf vBar(nCurrBar).nCmdType = CmdType.GENERATE Then RaiseEvent Calc_ProcessEnd(Nothing, New CalcProcessEndEventArgs(vBar(nCurrBar))) 'ProcessResults(vBar(nCurrBar)) End If 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 RaiseEvent Calc_ProcessResult(Nothing, New CalcResultEventArgs(vBar(vProc(j).nBar))) ' ProcessResults(vBar(vProc(j).nBar)) ElseIf vBar(vProc(j).nBar).nCmdType = CmdType.GENERATE Then RaiseEvent Calc_ProcessEnd(Nothing, New CalcProcessEndEventArgs(vBar(vProc(j).nBar))) 'ProcessResults(vBar(nCurrBar)) End If 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 RaiseEvent Calc_ProcessResult(Nothing, New CalcResultEventArgs(vBar(vProc(j).nBar))) ' ProcessResults(vBar(vProc(j).nBar)) ElseIf vBar(vProc(j).nBar).nCmdType = CmdType.GENERATE Then RaiseEvent Calc_ProcessEnd(Nothing, New CalcProcessEndEventArgs(vBar(vProc(j).nBar))) 'ProcessResults(vBar(nCurrBar)) End If bDone = True vProc(j).nBar = -1 nActProc -= 1 End If Else vProc(j).Proc.Refresh() End If End If If bDone Then ' se non sono in simulazione If bIsSimulation Then callback(0, "Simulation closing", bCancel) Else ' 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) End If If bCancel Then ' fine callback(1, "", bCancel) ' riabilito interfaccia RaiseEvent Calc_Ended(Nothing, New CalcEndEventArgs(CalcEndEventArgs.Results.OK)) Return End If nPgsCurrBar = 0 nPgsClock = 0 Else ' se non sono in simulazione If Not bIsSimulation Then ' aggiorno conteggio 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 End If nPgsClock += 1 Thread.Sleep(1) Next ' Verifico che i processi non siano andati tutti in errore bAllKO = True For j As Integer = 0 To nMaxThread - 1 If vProc(j).bEnable Then bAllKO = False Next If bAllKO Then Exit While End If Thread.Sleep(10) End While Thread.Sleep(300) ' se sono in simulazione If bIsSimulation Then callback(1, "Simulation closed", bCancel) Else callback(1, "Done", bCancel) End If ' riabilito interfaccia RaiseEvent Calc_Ended(Nothing, New CalcEndEventArgs(If(bAllKO, CalcEndEventArgs.Results.ERROR_, CalcEndEventArgs.Results.OK))) End Sub Private 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.CMPTEXT) ' Ripristino visibilita' pezzo EgtSetMode(nPartId, nOldPartMode) ' Ripristino stato segnalazione modifica DisableMgr.ReEnable() Return If(bOk, sPartFilePath, String.Empty) End Function Private 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 sMachGroupName As String = "" EgtGetMachGroupName(nMachGroupId, sMachGroupName) Dim sMachGroupFilePath As String = sProjDirPath & "\" & sMachGroupName & ".bwe" If EgtSaveObjToFile(nMachGroupId, sMachGroupFilePath, NGE.CMPTEXT) Then Return sMachGroupFilePath End If Return String.Empty End Function Private Function UpdateCutIdAndTaskId(nPartId As Integer) As Boolean ' Assegno Id a CutId per calcoli EgtSetInfo(nPartId, "CUTID", nPartId, True) ' Assegno TASKID agli outline per calcoli Dim nOutLayerId As Integer = EgtGetFirstNameInGroup(nPartId, OUTLINE) Dim nOutlineId As Integer = EgtGetFirstInGroup(nOutLayerId) While nOutlineId <> GDB_ID.NULL ' verifico che sia una feature Dim nGRP As Integer If EgtGetInfo(nOutlineId, BTL_FTR_GRP, nGRP) Then ' verifico se ha un principale Dim nMainOffsId As Integer If EgtGetInfo(nOutlineId, BTL_FTR_MAINID, nMainOffsId) Then ' assegno TASKID alla feature per calcoli EgtSetInfo(nOutlineId, "TASKID", nOutlineId + nMainOffsId, True) Else ' assegno TASKID alla feature per calcoli EgtSetInfo(nOutlineId, "TASKID", nOutlineId, True) End If End If nOutlineId = EgtGetNext(nOutlineId) End While ' 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 ' verifico se ha un principale Dim nMainOffsId As Integer If EgtGetInfo(nFeatureId, BTL_FTR_MAINID, nMainOffsId) Then ' assegno TASKID alla feature per calcoli EgtSetInfo(nFeatureId, "TASKID", nFeatureId + nMainOffsId, True) Else ' assegno TASKID alla feature per calcoli EgtSetInfo(nFeatureId, "TASKID", nFeatureId, True) End If End If nFeatureId = EgtGetNext(nFeatureId) End While Return True End Function End Module 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 nProgramPage As ProjectType Public nProjType As BWType Public nMachineName As String End Class Public Class ProcessResult Public Enum ProcessResultTypes As Integer BAR = 1 PART = 2 TASKID = 3 FALL = 4 TIME = 5 End Enum Private m_Type As ProcessResultTypes Public ReadOnly Property Type As ProcessResultTypes Get Return m_Type End Get End Property Private m_nCUTID As Integer Public ReadOnly Property nCUTID As Integer Get Return m_nCUTID End Get End Property Private m_nTASKID As Integer Public ReadOnly Property nTASKID As Integer Get Return m_nTASKID End Get End Property Private m_nERR As Integer Public ReadOnly Property nERR As Integer Get Return m_nERR End Get End Property Private m_sMSG As String Public ReadOnly Property sMSG As String Get Return m_sMSG End Get End Property Private m_dROT As Double Public ReadOnly Property dROT As Double Get Return m_dROT End Get End Property Public Sub SetROT(value As Double) m_dROT = value End Sub Private m_nFALL As Integer Public ReadOnly Property nFALL As Integer Get Return m_nFALL End Get End Property Private m_nTIME As Integer Public ReadOnly Property nTIME As Integer Get Return m_nTIME End Get End Property Public Shared Function CreateTaskResult(CUTID As Integer, TASKID As Integer, ERR As Integer, MSG As String, ROT As Double) As ProcessResult If CUTID <> 0 Then If TASKID = 0 Then Return New ProcessResult(ProcessResultTypes.PART, CUTID, TASKID, ERR, MSG, ROT, 0, 0) End If Return New ProcessResult(ProcessResultTypes.TASKID, CUTID, TASKID, ERR, MSG, ROT, 0, 0) End If Return New ProcessResult(ProcessResultTypes.BAR, CUTID, TASKID, ERR, MSG, ROT, 0, 0) End Function Public Shared Function CreateFallResult(CUTID As Integer, ERR As Integer, MSG As String, FALL As Integer) As ProcessResult Return New ProcessResult(ProcessResultTypes.FALL, CUTID, 0, ERR, MSG, 0, FALL, 0) End Function Public Shared Function CreateTimeResult(CUTID As Integer, TIME As Integer) As ProcessResult Return New ProcessResult(ProcessResultTypes.TIME, CUTID, 0, 0, "", 0, 0, TIME) End Function Protected Sub New(Type As ProcessResultTypes, CUTID As Integer, TASKID As Integer, ERR As Integer, MSG As String, ROT As Double, FALL As Integer, TIME As Integer) m_Type = Type m_nCUTID = CUTID m_nTASKID = TASKID m_nERR = ERR m_sMSG = MSG m_dROT = ROT m_nFALL = FALL m_nTIME = TIME End Sub End Class