Files
egtbeamwall/EgtBEAMWALL.Core/MachGroupModel/MyMachGroupPanelM.vb
T
Emmanuele Sassi cfabbc6eff - correzione su creazione Id delle lavorazioni
- gestione sezione ruotata
- corretto visibilita' colonna materiale
- migliorata gestione materiale nullo
- migliorata conversione file warehouse su Db
2024-07-02 10:55:48 +02:00

453 lines
20 KiB
VB.net

Imports System.Collections.ObjectModel
Imports System.IO
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
Dim NewMyMachGroupPanelM As New MyMachGroupPanelM
NewMyMachGroupPanelM.m_IsMultiMachGroup = False
' Assegno nome base
NewMyMachGroupPanelM.m_BaseName = ""
' Recupero lista macchine
NewMyMachGroupPanelM.m_MachineList = MachineList
' Assegno macchina di default
NewMyMachGroupPanelM.m_DefaultMachine = ""
' aggiorno copie
UpdateDuplo()
' 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
'EgtSetCurrentContext(Map.refSceneHostVM.MainScene.GetCtx())
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)
'' leggo nome attrezzaggio di default
'Dim sDefaultSetUpName As String = String.Empty
'Dim sMachineIniPath As String = Map.refMainWindowVM.MainWindowM.sMachinesRoot & "\" & sCurrMachName & "\" & sCurrMachName & ".ini"
'EgtUILib.GetPrivateProfileString(S_SETUP, K_DEFAULT, "", sDefaultSetUpName, sMachineIniPath)
'' se è attiva l'opzione, rendo corrente l'attrezzaggio di default
'If Not String.IsNullOrEmpty(sDefaultSetUpName) Then
' If Not EgtImportSetup(sDefaultSetUpName) Then
' EgtOutLog("Error loading default setup " & sDefaultSetUpName)
' MessageBox.Show(EgtMsg(MSG_SETUPERRORS + 9) & " " & sDefaultSetUpName, EgtMsg(MSG_MESSAGEBOX + 1), MessageBoxButton.OK, MessageBoxImage.Exclamation)
' End If
'End If
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 UpdateDuplo()
' 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
' 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
If EgtExistsInfo(nOutlineId, MGR_FTR_PRID) Then
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 sulle feature
Dim nGlobPRId As Integer = 1
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)
If nPRId > nGlobPRId Then nGlobPRId = 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
' 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
If Not EgtGetInfo(nOutlineId, MGR_FTR_PRID, nPRId) OrElse nPRId < nGlobPRId Then
nGlobPRId += 1
EgtSetInfo(nOutlineId, MGR_FTR_PRID, nGlobPRId)
nPRId = nGlobPRId
Else
If nPRId > nGlobPRId Then nGlobPRId = nPRId
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
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 If
nPartId = EgtGetNextPart(nPartId)
End While
If bTotIsModified Then
Dim CurrFilePath As String = ""
EgtGetCurrFilePath(CurrFilePath)
EgtSaveFile(CurrFilePath, NGE.CMPTEXT)
End If
End Sub
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)
'' elimino vecchio grezzo ed eseguo script creazione nuovo
'Dim nRawId As Integer = EgtGetFirstRawPart()
'While nRawId <> GDB_ID.NULL
' EgtRemovePartFromRawPart(EgtGetFirstPartInRawPart(nRawId))
' EgtRemoveRawPart(nRawId)
' nRawId = EgtGetFirstRawPart()
'End While
'If Not ExecBeam(Map.refMainWindowVM.MainWindowM.sTempDir, Map.refMachinePanelVM.SelectedMachine.Name, CalcIntegration.CmdTypes.RAWPART, False) Then Return False
' 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
'Dim nRawId As Integer = GDB_ID.NULL
'If EgtGetInfo(nDuploId, GDB_SI_LIST, nRawId) AndAlso nRawId > 0 Then
' Return nRawId
'Else
' Return GDB_ID.NULL
'End If
End Function
#End Region ' METHODS
End Class