Imports System.Collections.ObjectModel Imports System.Windows Imports System.Windows.Input Imports System.Windows.Media Imports EgtUILib Imports EgtWPFLib5 Public Class BTLFeatureM ' Feature a cui appartiene il parametro Protected m_ParentPart As Object Public ReadOnly Property ParentPart As Object Get Return m_ParentPart End Get End Property ' Id geometrico della feature Protected m_nFeatureId As Integer Public ReadOnly Property nFeatureId As Integer Get Return m_nFeatureId End Get End Property Public Sub SetFeatureId(nFeatureId As Integer) m_nFeatureId = nFeatureId End Sub ' lista dei gruppi Protected m_GRPList As New ObservableCollection(Of Integer) Public Property GRPList As ObservableCollection(Of Integer) Get Return m_GRPList End Get Set(value As ObservableCollection(Of Integer)) m_GRPList = value End Set End Property Protected m_nSelGRP As Integer = -1 Public Overridable Property nSelGRP As Integer Get Return m_nSelGRP End Get Set(value As Integer) m_nSelGRP = value End Set End Property Public ReadOnly Property sDescGRP As String Get Dim sDescConstruction As String = String.Empty If CalcBeamPrivateProfileGRP(nSelGRP) = 0 Then sDescConstruction = "L" Else sDescConstruction = "T" End If sDescConstruction &= nPRC.ToString("000") Return sDescConstruction End Get End Property ' Processo Protected m_nPRC As Integer Public Property nPRC As Integer Get Return m_nPRC End Get Set(value As Integer) m_nPRC = value End Set End Property ' Lato Protected m_SIDEList As New ObservableCollection(Of Integer)({1, 2, 3, 4}) Public Property SIDEList As ObservableCollection(Of Integer) Get Return m_SIDEList End Get Set(value As ObservableCollection(Of Integer)) m_SIDEList = value End Set End Property Protected m_nSelSIDE As Integer = -1 Public Overridable Property nSelSIDE As Integer Get Return m_nSelSIDE End Get Set(value As Integer) m_nSelSIDE = value End Set End Property ' Nome Protected m_sName As String Public ReadOnly Property sName As String Get Return m_sName End Get End Property Public Sub SetName(sName As String) m_sName = sName End Sub Protected m_bDO As Boolean Public Overridable Property bDO As Boolean Get Return m_bDO End Get Set(value As Boolean) m_bDO = value End Set End Property Protected m_nPRID As Integer Public Property nPRID As Integer Get Return m_nPRID End Get Set(value As Integer) m_nPRID = value End Set End Property Protected m_sDES As String = String.Empty Public Property sDES As String Get Return m_sDES End Get Set(value As String) m_sDES = value End Set End Property Protected m_frFRAME As New Frame3d Public Property frFRAME As Frame3d Get Return m_frFRAME End Get Set(value As Frame3d) m_frFRAME = value End Set End Property Protected m_nState As CalcStates = -1 Public Property nState As CalcStates Get Return m_nState End Get Set(value As CalcStates) m_nState = value End Set End Property Protected m_nCALC_ERR As Integer = -1 Public Property nCALC_ERR As Integer Get Return m_nCALC_ERR End Get Set(value As Integer) m_nCALC_ERR = value End Set End Property Protected m_nCALC_ROT As Integer Public Property nCALC_ROT As Integer Get Return m_nCALC_ROT End Get Set(value As Integer) m_nCALC_ROT = value End Set End Property Protected m_sCALC_MSG As String Public Property sCALC_MSG As String Get Return m_sCALC_MSG End Get Set(value As String) m_sCALC_MSG = value End Set End Property ' lista dei parametri della feature Protected m_PBTLParamMList As List(Of BTLParamM) Public Property PBTLParamMList As List(Of BTLParamM) Get Return m_PBTLParamMList End Get Set(value As List(Of BTLParamM)) m_PBTLParamMList = value End Set End Property ' lista dei parametri della feature Protected m_QBTLParamMList As List(Of BTLParamM) Public Property QBTLParamMList As List(Of BTLParamM) Get Return m_QBTLParamMList End Get Set(value As List(Of BTLParamM)) m_QBTLParamMList = value End Set End Property #Region "MESSAGES" Public ReadOnly Property Name_Msg As String Get Return EgtMsg(61614) End Get End Property Public ReadOnly Property Value_Msg As String Get Return EgtMsg(61615) End Get End Property Public ReadOnly Property Min_Msg As String Get Return EgtMsg(61616) End Get End Property Public ReadOnly Property Max_Msg As String Get Return EgtMsg(61617) End Get End Property #End Region #Region "CONSTRUCTOR" Protected Sub New() End Sub Public Shared Function CreateNewBTLFeature() As BTLFeatureM Return New BTLFeatureM End Function Public Shared Function CreateBTLFeature(ParentPart As Object, nFeatureId As Integer, Optional bIsBTL As Boolean = True) As BTLFeatureM Dim NewBTLFeature As New BTLFeatureM NewBTLFeature.m_ParentPart = ParentPart NewBTLFeature.m_nFeatureId = nFeatureId ' leggo gruppo, numero feature e lato EgtGetInfo(nFeatureId, BTL_FTR_GRP, NewBTLFeature.m_nSelGRP) EgtGetInfo(nFeatureId, BTL_FTR_PRC, NewBTLFeature.m_nPRC) EgtGetInfo(nFeatureId, BTL_FTR_SIDE, NewBTLFeature.m_nSelSIDE) Dim nDO As Integer = 1 If EgtGetInfo(nFeatureId, BTL_FTR_DO, nDO) Then NewBTLFeature.m_bDO = (nDO <> 0) Else NewBTLFeature.m_bDO = True End If ' leggo des,prid e frame EgtGetInfo(nFeatureId, BTL_FTR_DES, NewBTLFeature.m_sDES) EgtGetInfo(nFeatureId, BTL_FTR_PRID, NewBTLFeature.m_nPRID) EgtGetInfo(nFeatureId, BTL_FTR_FRAME, NewBTLFeature.m_frFRAME) ' leggo parametri della feature GetBeamPrivateProfileGRPList(CalcBeamPrivateProfileGRP(NewBTLFeature.m_nSelGRP), NewBTLFeature.m_nPRC, NewBTLFeature.m_GRPList) GetBeamPrivateProfileName(NewBTLFeature.m_nSelGRP, NewBTLFeature.m_nPRC, NewBTLFeature) ' crea parametri per questa feature da file ini NewBTLFeature.CreateFeatureParams(NewBTLFeature) ' leggo parametri delle feature NewBTLFeature.ReadFeatureParams() ' leggo calc error Dim nErr As Integer = 0 Dim nRot As Integer = 0 Dim sMsg As String = "" Dim bCalc As Boolean = False If bIsBTL Then bCalc = EgtGetInfo(NewBTLFeature.nFeatureId, ITG_PROJ_ERR, nErr) EgtGetInfo(nFeatureId, ITG_PROJ_ROT, nRot) EgtGetInfo(nFeatureId, ITG_PROJ_MSG, sMsg) Else bCalc = EgtGetInfo(NewBTLFeature.nFeatureId, ITG_PROD_ERR, nErr) EgtGetInfo(nFeatureId, ITG_PROD_ROT, nRot) EgtGetInfo(nFeatureId, ITG_PROD_MSG, sMsg) End If If Not bCalc Then NewBTLFeature.m_nState = CalcStates.NOTCALCULATED NewBTLFeature.m_nCALC_ERR = 0 NewBTLFeature.m_nCALC_ROT = 0 NewBTLFeature.m_sCALC_MSG = "" Else NewBTLFeature.m_nCALC_ERR = nErr NewBTLFeature.m_nCALC_ROT = nRot NewBTLFeature.m_sCALC_MSG = sMsg Select Case nErr Case 0 NewBTLFeature.nState = CalcStates.OK Case 22 NewBTLFeature.nState = CalcStates.COLLISION Case 17, 19 NewBTLFeature.nState = CalcStates.WARNING Case < 0 NewBTLFeature.nState = CalcStates.INFO Case > 0 NewBTLFeature.nState = CalcStates.ERROR_ End Select End If Return NewBTLFeature End Function Public Shared Function CreateBTLFeature(nPRC As Integer, nGRP As Integer, nSIDE As Integer) As BTLFeatureM Dim NewBTLFeature As New BTLFeatureM NewBTLFeature.m_nPRC = nPRC NewBTLFeature.m_nSelGRP = nGRP NewBTLFeature.m_nSelSIDE = nSIDE NewBTLFeature.m_bDO = True ' crea parametri per questa feature da file ini NewBTLFeature.CreateFeatureParams(NewBTLFeature) Return NewBTLFeature End Function #End Region ' CONSTRUCTOR #Region "METHODS" Public Event PBTLParamAdded As EventHandler(Of BTLParamAddedEventArgs) Public Event QBTLParamAdded As EventHandler(Of BTLParamAddedEventArgs) Public Sub AddPBTLParam(BTLparamM As BTLParamM) If IsNothing(BTLparamM) Then Return If Not m_PBTLParamMList.Contains(BTLparamM) Then m_PBTLParamMList.Add(BTLparamM) RaiseEvent PBTLParamAdded(Me, New BTLParamAddedEventArgs(BTLparamM)) End If End Sub Public Sub AddQBTLParam(BTLparamM As BTLParamM) If IsNothing(BTLparamM) Then Return If Not m_QBTLParamMList.Contains(BTLparamM) Then m_QBTLParamMList.Add(BTLparamM) RaiseEvent QBTLParamAdded(Me, New BTLParamAddedEventArgs(BTLparamM)) End If End Sub Public Function GetPBTLParams() As List(Of BTLParamM) Return New List(Of BTLParamM)(m_PBTLParamMList) End Function Public Function GetQBTLParams() As List(Of BTLParamM) Return New List(Of BTLParamM)(m_QBTLParamMList) End Function ' funzione che crea l'elenco dei parametri Public Sub CreateFeatureParams(NewBTLFeature As BTLFeatureM) Dim ParamIndex As Integer = 1 Dim TempList As New List(Of BTLParamM) Dim NewBTLParam As BTLParamM = Nothing ' leggo tutti i P della feature While BTLIniFile.GetBeamPrivateProfileParam(m_nSelGRP, m_nPRC, True, ParamIndex, Me, NewBTLParam) TempList.Add(NewBTLParam) ParamIndex += 1 End While NewBTLFeature.PBTLParamMList = TempList ' leggo tutti i Q della feature ParamIndex = 1 TempList = New List(Of BTLParamM) While BTLIniFile.GetBeamPrivateProfileParam(m_nSelGRP, m_nPRC, False, ParamIndex, Me, NewBTLParam) TempList.Add(NewBTLParam) ParamIndex += 1 End While NewBTLFeature.QBTLParamMList = TempList End Sub ' funzione che legge il valore corrente del parametro Public Function ReadFeatureParams() As Boolean Return ReadFeatureParams(m_PBTLParamMList) And ReadFeatureParams(m_QBTLParamMList) End Function Private Function ReadFeatureParams(ParamList As List(Of BTLParamM)) As Boolean Dim bToRecalc As Boolean = False ' leggo valore parametro da struttura geometrica For Each Param As BTLParamM In ParamList If Param.nType = BTLParamType.DOUBLE_ Or Param.nType = BTLParamType.LENGTH Then Dim dParamValue As Double = 0 Dim sReadName As String = Param.sName If IsFreeContour() Then Select Case Param.sName Case "P05" sReadName = "DEPTH" Case "P07" sReadName = "PCKT" Case "P13" sReadName = "CNT_TYPE" Case "P14" sReadName = "CNT_DATA" Case "P15" sReadName = "CNT_PAR" End Select End If If Not EgtGetInfo(m_nFeatureId, sReadName, dParamValue) Then dParamValue = 0 End If ' se è un parametro P setto il valore letto nel DB If Param.bIsP Then Param.SetValue(dParamValue) Else ' se è un parametro Q verifico nel progetto se sia un valore custom Dim nCustom As Integer = 0 EgtGetInfo(nFeatureId, Param.sName & "A", nCustom) If nCustom = 1 Then Param.SetValue(dParamValue) Param.bCustom = True ' altrimenti lo setto al valore di default Else Param.SetValue(Param.dDefault) Dim dReadValue As Double = 0 EgtGetInfo(m_nFeatureId, Param.sName, dReadValue) If dReadValue <> Param.dDefault Then ' Disabilito segnalazione modificato Dim DisableMgr As New DisableModifiedMgr EgtSetInfo(m_nFeatureId, Param.sName, Param.dDefault) 'se pezzo parent di tipo BTL If TypeOf m_ParentPart Is BTLPartM AndAlso m_bDO Then Dim BTLPartM As BTLPartM = DirectCast(m_ParentPart, BTLPartM) EgtRemoveInfo(BTLPartM.m_nPartId, ITG_PROJ_ERR) EgtRemoveInfo(BTLPartM.m_nPartId, ITG_PROJ_MSG) EgtRemoveInfo(BTLPartM.m_nPartId, ITG_PROJ_FALL) EgtRemoveInfo(BTLPartM.m_nPartId, ITG_PROJ_ROT) 'EgtDuploSetModified(DirectCast(m_ParentPart, BTLPartM).m_nPartId) End If ' Ripristino stato segnalazione modifica DisableMgr.ReEnable() bToRecalc = True End If Param.bCustom = False End If End If ElseIf Param.nType = BTLParamType.STRING_ Then Dim sParamValue As String = String.Empty EgtGetInfo(m_nFeatureId, Param.sName, sParamValue) Param.SetValue(sParamValue) ElseIf Param.nType = BTLParamType.COMBO Then Dim nParamValue As Integer EgtGetInfo(m_nFeatureId, Param.sName, nParamValue) Param.nSelValue = nParamValue End If Next ' Se necessario ricalcolo, lo eseguo If Not IsFreeContour() And bToRecalc Then ' Disabilito segnalazione modificato Dim DisableMgr As New DisableModifiedMgr UpdateParams() ' Ripristino stato segnalazione modifica DisableMgr.ReEnable() End If Return True End Function ' funzione che rilegge i parametri Q Public Function ReadQValues() Return ReadFeatureParams(m_QBTLParamMList) End Function ' funzione che setta i valori di default a tutti i parametri Public Function SetDefaultValues() As Boolean Return SetDefaultValues(m_PBTLParamMList) And SetDefaultValues(m_QBTLParamMList) End Function Private Function SetDefaultValues(ParamList As List(Of Core.BTLParamM)) As Boolean ' leggo valore parametro da struttura geometrica For Each Param As BTLParamM In ParamList If Param.nType = BTLParamType.DOUBLE_ Or Param.nType = BTLParamType.LENGTH Then Param.SetValue(Param.dDefault) ElseIf Param.nType = BTLParamType.STRING_ Then Param.SetValue("") ElseIf Param.nType = BTLParamType.COMBO Then Param.nSelValue = Param.dDefault End If Next Return False End Function ' funzione che calcola array dei valori dei parametri Public Function CalcParamArray(ByRef vPar() As Double, ByRef sPar As String, ByRef vParQ() As String) As Boolean ' verifico che lista parametri non sia vuota If Not IsNothing(m_PBTLParamMList) AndAlso m_PBTLParamMList.Count > 0 Then ' calcolo lunghezza array Parametri Dim nLastParId As Integer = m_PBTLParamMList(m_PBTLParamMList.Count - 1).nId - 1 Dim vTempPar(nLastParId) As Double Dim sTempPar As String = String.Empty ' carico tutti i parametri su array For ParIndex = 0 To m_PBTLParamMList.Count - 1 Dim BTLPar As BTLParamM = DirectCast(m_PBTLParamMList(ParIndex), BTLParamM) Select Case BTLPar.nType Case BTLParamType.DOUBLE_, BTLParamType.LENGTH vTempPar(BTLPar.nId - 1) = BTLPar.dValue Case BTLParamType.STRING_ sTempPar = BTLPar.sValue 'Case BTLParamType.COMBO ' Dim cBTLPar As BTLParamCombo = DirectCast(ParentFeature.PParamList(ParIndex), BTLParamCombo) ' vPar(ParIndex) = cBTLPar. End Select Next vPar = vTempPar sPar = If(String.IsNullOrEmpty(sTempPar), " ", sTempPar) End If ' Determino parametri Q Dim vTempParQ(m_QBTLParamMList.Count) As String For ParQIndex = 0 To m_QBTLParamMList.Count - 1 Dim ParQ As BTLParamM = m_QBTLParamMList(ParQIndex) vTempParQ(ParQIndex) = ParQ.sName & ":" & If(ParQ.nType <> BTLParamType.STRING_, DoubleToString(ParQ.dValue, 3), ParQ.sValue) Next Dim sDO As String = "" If Not bDO Then sDO = 0 vTempParQ(m_QBTLParamMList.Count) = "DO:" & sDO vParQ = vTempParQ Return True End Function ' funzione che aggiorna parametri della feature Public Function UpdateParams(nNewGRP As Integer, nNewPRC As Integer, nNewSIDE As Integer, sNewDesc As String, nNewProcId As Integer, frNewRef As Frame3d, vNewParP() As Double, sNewPar As String, vNewParQ As String(), Optional bUpdate As Boolean = True) As Boolean ' Recupero parametri originali della feature Dim vPar() As Double = {} Dim sPar As String = String.Empty Dim vParQ() As String = {} CalcParamArray(vPar, sPar, vParQ) ' recupero eventuali percorsi originali della feature Dim nCrvId As Integer = GDB_ID.NULL Dim nCrv2Id As Integer = GDB_ID.NULL GetFreeContourPaths(nCrvId, nCrv2Id) ' modifica della feature con i nuovi parametri Dim nFeatureId As Integer = EgtBeamModifyProcess(Me.nFeatureId, nNewGRP, nNewPRC, nNewSIDE, sNewDesc, nNewProcId, frNewRef, vNewParP, sNewPar, vNewParQ, nCrvId, nCrv2Id, bUpdate) Dim bOk As Boolean = nFeatureId <> GDB_ID.NULL If bOk Then ' riporto parametri Q custom For Each QPar In QBTLParamMList If QPar.bCustom Then EgtSetInfo(nFeatureId, QPar.sName & "A", 1) Next SetFeatureId(nFeatureId) ' imposto modificato per copie EgtDuploSetModified(ParentPart.nPartId) bOk = True Else ' Impossibile creare una feature con questi valori - ERRORE MessageBox.Show(EgtMsg(61852), EgtMsg(30007)) nFeatureId = EgtBeamModifyProcess(Me.nFeatureId, Me.nSelGRP, Me.nPRC, Me.nSelSIDE, "", Me.nPRID, New Frame3d(), vPar, sPar, vParQ, nCrvId, nCrv2Id) SetFeatureId(nFeatureId) bOk = False End If Return bOk End Function Public Function UpdateParams(Optional bUpdate As Boolean = True) As Boolean ' aggiorno la feature con nuovo valore Dim vPar() As Double = {} Dim sPar As String = String.Empty Dim vParQ() As String = {} CalcParamArray(vPar, sPar, vParQ) Return UpdateParams(Me.nSelGRP, Me.nPRC, Me.nSelSIDE, Me.sDES, Me.nPRID, Me.frFRAME, vPar, sPar, vParQ, bUpdate) End Function ' funzione che restituisce se la feature è un contorno libero Public Function IsFreeContour() As Boolean Return m_nPRC = 250 OrElse m_nPRC = 251 OrElse m_nPRC = 252 End Function ' funzione che restituisce i percorsi associati ai contorni liberi Public Function GetFreeContourPaths(ByRef nCrvId As Integer, ByRef nCrv2Id As Integer) As Boolean ' imposto eventuali percorsi nCrvId = GDB_ID.NULL nCrv2Id = GDB_ID.NULL If IsFreeContour() Then Dim sAuxId As String = "" If EgtGetInfo(nFeatureId, "AUXID", sAuxId) Then Dim sAuxIdSplit() As String = sAuxId.Split(","c) Dim nAuxId As Integer If Integer.TryParse(sAuxIdSplit(0), nAuxId) Then nCrvId = nFeatureId + nAuxId Dim nAux2Id As Integer If sAuxIdSplit.Count > 1 Then If Integer.TryParse(sAuxIdSplit(1), nAux2Id) Then nCrv2Id = nFeatureId + nAux2Id End If End If End If End If End If Return True End Function #End Region ' METHODS End Class