Imports EgtUILib Imports EgtWPFLib5 Public Class MyMachGroupPanelM Inherits MachGroupPanelM #Region "FIELDS & PROPERTIES" #End Region ' FIELDS & PROPERTIES #Region "CONSTRUCTOR" Public Shared Function CreateMyMachGroupPanel(MachineList As List(Of Machine)) As MachGroupPanelM ' Assegno nome base ' Recupero lista macchine ' Assegno macchina di default Dim NewMyMachGroupPanelM As New MyMachGroupPanelM With { .m_IsMultiMachGroup = False, .m_BaseName = "", .m_MachineList = MachineList, .m_DefaultMachine = "" } ' aggiorno copie UpdateAllDuplo() ' recupero i MachGroup NewMyMachGroupPanelM.m_MachGroupMList = LoadMyMachGroups(MachineList) Return NewMyMachGroupPanelM End Function #End Region ' CONSTRUCTOR #Region "METHODS" Public Shared Function LoadMyMachGroups(MachineList As List(Of Machine)) As List(Of MachGroupM) Dim TempList As New List(Of MachGroupM) ' Carico i gruppi di lavorazione nella lista Dim nId = EgtGetFirstMachGroup() While nId <> GDB_ID.NULL EgtSetCurrMachGroup(nId) Dim sName As String = String.Empty Dim sMachine As String = String.Empty EgtGetMachGroupName(nId, sName) EgtGetMachGroupMachineName(nId, sMachine) ' cerco la macchina tra quelle presenti Dim UsedMachine As MyMachine = Nothing Dim bOk As Boolean = Machine.SearchMachine(sMachine, MachineList, UsedMachine) If Not bOk OrElse UsedMachine.nType = MachineType.NULL Then EgtOutLog("Machine incompatible with beam & wall machining!!") Else Dim nBTLInfoLayerId As Integer = EgtGetFirstNameInGroup(GDB_ID.ROOT, BTLINFO) Dim nPROJTYPE As Integer = BWType.NULL EgtGetInfo(nBTLInfoLayerId, BTL_GEN_PROJTYPE, nPROJTYPE) If nPROJTYPE = BWType.BEAM Or nPROJTYPE = BWType.WALL Then TempList.Add(MyMachGroupM.CreateMyMachGroup(nPROJTYPE, nId, sName, sMachine)) Else EgtOutLog("Machine of beam & wall type, but project type not found!!") End If End If nId = EgtGetNextMachGroup(nId) End While EgtResetCurrMachGroup() Return TempList End Function ' funzione che restituisce il gruppo di lavorazione dato l'Id geometrico Public Shared Function LoadMyMachGroupFromId(nId As Integer, MachineList As List(Of Machine)) As MachGroupM If nId <= 0 Then Return Nothing If Not EgtSetCurrMachGroup(nId) Then Return Nothing Dim sName As String = String.Empty Dim sMachine As String = String.Empty EgtGetMachGroupName(nId, sName) EgtGetMachGroupMachineName(nId, sMachine) ' cerco la macchina tra quelle presenti Dim UsedMachine As MyMachine = Nothing Dim bOk As Boolean = Machine.SearchMachine(sMachine, MachineList, UsedMachine) If Not bOk OrElse UsedMachine.nType = MachineType.NULL Then EgtOutLog("Machine incompatible with beam & wall machining!!") Else Dim nBTLInfoLayerId As Integer = EgtGetFirstNameInGroup(GDB_ID.ROOT, BTLINFO) Dim nPROJTYPE As Integer = BWType.NULL EgtGetInfo(nBTLInfoLayerId, BTL_GEN_PROJTYPE, nPROJTYPE) If nPROJTYPE = BWType.BEAM Or nPROJTYPE = BWType.WALL Then Return MyMachGroupM.CreateMyMachGroup(nPROJTYPE, nId, sName, sMachine) Else EgtOutLog("Machine of beam & wall type, but project type not found!!") End If End If Return Nothing End Function ' funzione che restituisce solo i gruppi di lavorazione creati nel nesting Public Shared Function UpdateFromNestingMyMachGroups(MachineList As List(Of Machine)) As List(Of MachGroupM) Dim TempList As New List(Of MachGroupM) ' Carico i gruppi di lavorazione nella lista Dim nId = EgtGetFirstMachGroup() While nId <> GDB_ID.NULL Dim UpdateUI As Integer = 0 If EgtGetInfo(nId, "UPDATEUI", UpdateUI) AndAlso UpdateUI = 1 Then TempList.Add(LoadMyMachGroupFromId(nId, MachineList)) ' rimuovo info EgtRemoveInfo(nId, "UPDATEUI") End If nId = EgtGetNextMachGroup(nId) End While EgtResetCurrMachGroup() Return TempList End Function Public Function NewMyMachGroup(sMachName As String, nMachineType As MachineType) As MachGroupM ' Sistemazioni preliminari OnPreNewMachGroup() ' Se non ci sono macchine disponibili esco con errore If m_MachineList.Count <= 0 Then Return Nothing ' Creo il nuovo gruppo di lavorazione con i dati ottenuti a seconda del caso in cui mi trovo Dim MachGroupM As MachGroupM If nMachineType = MachineType.NULL Then EgtOutLog("Machine incompatible with beam & wall machining!!") Return Nothing Else MachGroupM = MyMachGroupM.CreateMyMachGroup(nMachineType, NewMachGroupID(), sMachName) End If If IsNothing(MachGroupM) Then Return Nothing AddMachGroup(MachGroupM) ' Sistemazioni finali m_DefaultMachine = sMachName OnPostNewMachGroup() Return MachGroupM End Function Public Overrides Function OnPreNewMachGroup() As Boolean Return True End Function ' NB: Anche se ho già aggiunto il nuovo gruppo di lavorazione, non l'ho ancora reso corrente (viene fatto dopo), quindi ' non posso usare CurrentMachine perchè è ancora impostata quella precedente!!! Public Overrides Function OnPostNewMachGroup() As Boolean ' Salvo macchina del gruppo come nuovo default Dim sCurrMachName As String = String.Empty EgtGetCurrMachineName(sCurrMachName) WriteMainPrivateProfileString(S_MACH, K_CURRMACH, sCurrMachName) Return True End Function Public Overrides Function OnPreRemoveCurrMachGroup() As Boolean 'EgtSetCurrentContext(Map.refSceneHostVM.MainScene.GetCtx()) Return True End Function Public Function NewMachGroupID() As Integer Dim nTemp As Integer = 0 If Not IsNothing(MachGroupMList) AndAlso MachGroupMList.Count > 0 Then Return MachGroupMList.Select(Of Integer)(Function(x) If(Integer.TryParse(x.Name, nTemp), nTemp, 0)).Max() + 1 Return 1 End Function ' funzione che fa l'update di tutte le copie dei pezzi modificati Public Shared Sub UpdateAllDuplo() ' verifico tipo di progetto Dim nBtlInfoId As Integer = EgtGetFirstNameInGroup(GDB_ID.ROOT, BTLINFO) Dim nBWType As Integer = 0 EgtGetInfo(nBtlInfoId, BTL_GEN_PROJTYPE, nBWType) ' ciclo sui pezzi Dim bTotIsModified As Boolean = False Dim nPartId As Integer = EgtGetFirstPart() While nPartId <> GDB_ID.NULL Dim bIsModified As Boolean = False If EgtDuploGetModified(nPartId, bIsModified) AndAlso bIsModified Then UpdateDuplo(nPartId) End If nPartId = EgtGetNextPart(nPartId) End While If bTotIsModified Then Dim CurrFilePath As String = "" EgtGetCurrFilePath(CurrFilePath) EgtSaveFile(CurrFilePath, NGE.CMPTEXT) End If End Sub Public Shared Sub UpdateDuplo(nPartId As Integer) ' verifico tipo di progetto Dim nBtlInfoId As Integer = EgtGetFirstNameInGroup(GDB_ID.ROOT, BTLINFO) Dim nBWType As Integer = 0 EgtGetInfo(nBtlInfoId, BTL_GEN_PROJTYPE, nBWType) ' ciclo sui pezzi Dim bTotIsModified As Boolean = False Dim bIsModified As Boolean = False ' verifico se c'é PRID sugli outline Dim nPRId As Integer = 1 Dim nOutlineLayer As Integer = EgtGetFirstNameInGroup(nPartId, OUTLINE) If nOutlineLayer <> GDB_ID.NULL Then Dim nOutlineId As Integer = EgtGetFirstInGroup(nOutlineLayer) While nOutlineId <> GDB_ID.NULL ' verifico che sia feature If EgtExistsInfo(nOutlineId, MGR_FTR_PRC) Then Dim nCurrPrId As Integer = GDB_ID.NULL If EgtGetInfo(nOutlineId, MGR_FTR_PRID, nCurrPrId) AndAlso nCurrPrId <> GDB_ID.NULL Then If nCurrPrId < nPRId Then EgtSetInfo(nOutlineId, MGR_FTR_PRID, nPRId) nPRId += 1 End If nPRId = Math.Max(nPRId - 1, nCurrPrId) + 1 nOutlineId = EgtGetNext(nOutlineId) Continue While Else EgtSetInfo(nOutlineId, MGR_FTR_PRID, nPRId) nPRId += 1 End If End If nOutlineId = EgtGetNext(nOutlineId) End While End If bTotIsModified = True Dim DuploList As New List(Of Integer) EgtDuploList(nPartId, DuploList) Dim DuploArray() As Integer Dim RotArray(DuploList.Count) As Integer Dim FlipArray(DuploList.Count) As Integer Dim QArray(DuploList.Count) As Dictionary(Of String, Dictionary(Of String, String)) DuploArray = DuploList.ToArray() ' recupero ROT (gradi) e FLIP (0/1) per non perderli For Duploindex = 0 To DuploArray.Length - 1 RotArray(Duploindex) = 0 EgtGetInfo(DuploArray(Duploindex), MGR_PRT_ROT, RotArray(Duploindex)) FlipArray(Duploindex) = 0 EgtGetInfo(DuploArray(Duploindex), MGR_PRT_FLIP, FlipArray(Duploindex)) If FlipArray(Duploindex) <> 0 Then FlipArray(Duploindex) = 180 If nBWType = BWType.WALL Then ' salvo parametri Q QArray(Duploindex) = New Dictionary(Of String, Dictionary(Of String, String)) ' ciclo sugli outline nOutlineLayer = EgtGetFirstNameInGroup(DuploArray(Duploindex), OUTLINE) If nOutlineLayer <> GDB_ID.NULL Then Dim nGlobPRId As Integer = 1 Dim nOutlineId As Integer = EgtGetFirstInGroup(nOutlineLayer) While nOutlineId <> GDB_ID.NULL ' verifico che sia feature Dim nPRC As Integer If EgtGetInfo(nOutlineId, MGR_FTR_PRC, nPRC) Then nPRId = 0 If EgtGetInfo(nOutlineId, MGR_FTR_PRID, nPRId) Then If nPRId < nGlobPRId Then EgtSetInfo(nOutlineId, MGR_FTR_PRID, nGlobPRId) nPRId = nGlobPRId nGlobPRId += 1 End If nGlobPRId = Math.Max(nGlobPRId - 1, nPRId) + 1 Else EgtSetInfo(nOutlineId, MGR_FTR_PRID, nGlobPRId) nPRId = nGlobPRId nGlobPRId += 1 End If Dim sKey As String = nPRId & "." & nPRC QArray(Duploindex).Add(sKey, New Dictionary(Of String, String)) For QIndex = 1 To 10 Dim QKey As String = "Q" & QIndex.ToString("D2") Dim QValue As Integer = 0 If EgtGetInfo(nOutlineId, QKey, QValue) Then QArray(Duploindex)(sKey).Add(QKey, QValue) End If Next End If nOutlineId = EgtGetNext(nOutlineId) End While End If ' ciclo sulle feature Dim nFeatureLayer As Integer = EgtGetFirstNameInGroup(DuploArray(Duploindex), PROCESSINGS) If nFeatureLayer <> GDB_ID.NULL Then Dim nFeatureId As Integer = EgtGetFirstInGroup(nFeatureLayer) While nFeatureId <> GDB_ID.NULL ' verifico che sia feature Dim nPRC As Integer If EgtGetInfo(nFeatureId, MGR_FTR_PRC, nPRC) Then nPRId = 0 EgtGetInfo(nFeatureId, MGR_FTR_PRID, nPRId) Dim sKey As String = nPRId & "." & nPRC QArray(Duploindex).Add(sKey, New Dictionary(Of String, String)) For QIndex = 1 To 10 Dim QKey As String = "Q" & QIndex.ToString("D2") Dim QValue As Integer = 0 If EgtGetInfo(nFeatureId, QKey, QValue) Then QArray(Duploindex)(sKey).Add(QKey, QValue) End If Next End If nFeatureId = EgtGetNext(nFeatureId) End While End If End If Next ' aggiornamento dei Duplo EgtDuploUpdate(nPartId) ' ripristino i valori di ROT e FLIP For Duploindex = 0 To DuploArray.Length - 1 ' ripristino info rot e flip EgtSetInfo(DuploArray(Duploindex), MGR_PRT_ROT, RotArray(Duploindex)) EgtSetInfo(DuploArray(Duploindex), MGR_PRT_FLIP, FlipArray(Duploindex)) If nBWType = BWType.WALL Then ' ciclo sugli outline nOutlineLayer = EgtGetFirstNameInGroup(DuploArray(Duploindex), OUTLINE) If nOutlineLayer <> GDB_ID.NULL Then Dim nOutlineId As Integer = EgtGetFirstInGroup(nOutlineLayer) While nOutlineId <> GDB_ID.NULL ' verifico che sia feature Dim nPRC As Integer If EgtGetInfo(nOutlineId, MGR_FTR_PRC, nPRC) Then nPRId = 0 EgtGetInfo(nOutlineId, MGR_FTR_PRID, nPRId) Dim sKey As String = nPRId & "." & nPRC ' ripristino parametri Q If QArray(Duploindex).ContainsKey(sKey) Then For Each QPar In QArray(Duploindex)(sKey) EgtSetInfo(nOutlineId, QPar.Key, QPar.Value) Next End If End If nOutlineId = EgtGetNext(nOutlineId) End While End If ' ciclo sulle feature Dim nFeatureLayer As Integer = EgtGetFirstNameInGroup(DuploArray(Duploindex), PROCESSINGS) If nFeatureLayer <> GDB_ID.NULL Then Dim nFeatureId As Integer = EgtGetFirstInGroup(nFeatureLayer) While nFeatureId <> GDB_ID.NULL ' verifico che sia feature Dim nPRC As Integer If EgtGetInfo(nFeatureId, MGR_FTR_PRC, nPRC) Then nPRId = 0 EgtGetInfo(nFeatureId, MGR_FTR_PRID, nPRId) Dim sKey As String = nPRId & "." & nPRC ' ripristino parametri Q If QArray(Duploindex).ContainsKey(sKey) Then For Each QPar In QArray(Duploindex)(sKey) EgtSetInfo(nFeatureId, QPar.Key, QPar.Value) Next End If End If nFeatureId = EgtGetNext(nFeatureId) End While End If End If Next End Sub Public Shared Sub SetDuploModified(nPartId As Integer) If Configuration.bOnlyProd Then ' segno modificato e aggiorno duplo EgtDuploSetModified(nPartId) UpdateDuplo(nPartId) ' aggiorno grafica duplo Dim DuploIdList As New List(Of Integer) EgtDuploList(nPartId, DuploIdList) Dim DuploList As List(Of MachGroupVM) = CoreMap.refMachGroupPanelVM.MachGroupVMList.Where(Function(x) tt(x, DuploIdList)).ToList() For Each CurrMachGroup As MyMachGroupVM In DuploList CurrMachGroup.RefreshMachGroup() Next Else EgtDuploSetModified(nPartId) End If End Sub Private Shared Function tt(x As MachGroupVM, DuploIdList As List(Of Integer)) As Boolean Dim TempMyMachGroupVM As MyMachGroupVM = DirectCast(x, MyMachGroupVM) Return TempMyMachGroupVM.PartVMList.Any(Function(y) DuploIdList.Contains(y.nPartId)) End Function Class DuploFeature ' Id geometrico della feature Friend nFeatureId As Integer Friend nPRC As Integer Friend nPRID As Integer End Class ' funzione che cancella tutti i pezzi segnati da eliminare Public Shared Function DeleteDuplo() As List(Of Integer) Dim ToRedrawMachGroupList As New List(Of Integer) ' reset necessario per poter accedere direttamente al grezzo dalle info pezzo e al MachGroup tramite la gerarchia Db geometrico EgtResetCurrMachGroup() Dim nPartId As Integer = EgtGetFirstPart() While nPartId <> GDB_ID.NULL Dim bIsToDelete As Boolean = False If DuploGetToDelete(nPartId, bIsToDelete) AndAlso bIsToDelete Then ' verifico se ci sono copie Dim nDuploCount As Integer = 0 EgtDuploCount(nPartId, nDuploCount) Dim DuploList As New List(Of Integer) If nDuploCount > 0 AndAlso EgtDuploList(nPartId, DuploList) Then ' cancello tutti i pezzi copia nelle barre For Each nDuploId In DuploList ' recupero grezzo cui appartiene Dim nRawPartId As Integer = DuploGetRawPart(nDuploId) ' recupero gruppo di lavorazione Dim nMachGroupId As Integer = EgtGetParent(EgtGetParent(EgtGetParent(nRawPartId))) ' elimino eventuali successive info pezzi di troppo Dim nIndex As Integer = 0 Dim sTemp As String = "" While EgtGetInfo(nMachGroupId, MGR_RPT_PART & nIndex, sTemp) Dim PartData() As String = sTemp.Split(","c) If PartData(0) <> nDuploId Then EgtSetInfo(nMachGroupId, MGR_RPT_PART & nIndex, sTemp) nIndex += 1 End If End While ToRedrawMachGroupList.Add(nMachGroupId) ' lo setto come corrente EgtSetCurrMachGroup(nMachGroupId) ' elimino pezzo copia EgtRemovePartFromRawPart(nDuploId) EgtErase(nDuploId) Next End If DuploResetToDelete(nPartId) End If nPartId = EgtGetNextPart(nPartId) End While EgtResetCurrMachGroup() Return ToRedrawMachGroupList End Function Friend Shared Function DuploGetToDelete(nSouId As Integer, ByRef bToDelete As Boolean) As Boolean If IsNothing(nSouId) Then Return False Return EgtGetInfo(nSouId, DUPLO_TODELETE, bToDelete) End Function Public Shared Function DuploSetToDelete(nSouId As Integer) As Boolean If IsNothing(nSouId) Then Return False Return EgtSetInfo(nSouId, DUPLO_TODELETE, True) End Function Private Shared Function DuploResetToDelete(nSouId As Integer) As Boolean If IsNothing(nSouId) Then Return False Return EgtSetInfo(nSouId, DUPLO_TODELETE, "") End Function ' funzione che restituisce il pezzo di origine di un Duplo ' sostituisce EgtDuploGetOriginal che funziona solo all'interno del MachGroup del Duplo Public Shared Function DuploGetOriginal(nDuploId As Integer) As Integer Dim nOrigId As Integer = GDB_ID.NULL If EgtGetInfo(nDuploId, GDB_SI_DUPSOU, nOrigId) AndAlso nOrigId > 0 Then Return nOrigId Else Return GDB_ID.NULL End If End Function Public Shared Function DuploGetRawPart(nDuploId As Integer) As Integer Dim nSwapItem As Integer = GDB_ID.NULL Dim sSwapItem As String = String.Empty EgtGetInfo(nDuploId, "!LST", sSwapItem) Dim LSTValues() As String = sSwapItem.Split(","c) If Not IsNothing(LSTValues(LSTValues.Count - 1)) AndAlso Integer.TryParse(LSTValues(LSTValues.Count - 1), nSwapItem) AndAlso nSwapItem > 0 Then Return EgtGetParent(nSwapItem) End If Return GDB_ID.NULL End Function #End Region ' METHODS End Class