Imports System.Collections.ObjectModel Imports System.Windows Imports EgtUILib 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 Protected m_nPriority As Integer = 0 Public Overridable Property nPriority As Integer Get Return m_nPriority End Get Set(value As Integer) m_nPriority = 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_VARIANTList As New ObservableCollection(Of Integer)() Public Property VARIANTList As ObservableCollection(Of Integer) Get Return m_VARIANTList End Get Set(value As ObservableCollection(Of Integer)) m_VARIANTList = 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 Public Overridable Property nSelVARIANT As Integer Get Dim nDes As Integer = 0 Return If(Integer.TryParse(m_sDES, nDes), nDes, 0) End Get Set(value As Integer) m_sDES = value.ToString() 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 MessageFromLuaMsg(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 #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() CreateVariantList() 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, lato e priorità EgtGetInfo(nFeatureId, BTL_FTR_GRP, NewBTLFeature.m_nSelGRP) EgtGetInfo(nFeatureId, BTL_FTR_PRC, NewBTLFeature.m_nPRC) EgtGetInfo(nFeatureId, BTL_FTR_SIDE, NewBTLFeature.m_nSelSIDE) EgtGetInfo(nFeatureId, BTL_FTR_PRIORITY, NewBTLFeature.m_nPriority) 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 With { .m_nPRC = nPRC, .m_nSelGRP = nGRP, .m_nSelSIDE = nSIDE, .m_nPriority = 0, .m_bDO = True, .nSelVARIANT = 0 } ' crea parametri per questa feature da file ini NewBTLFeature.CreateFeatureParams(NewBTLFeature) Return NewBTLFeature End Function Private Sub CreateVariantList() Dim sMaxIndex As String = "" Dim nMaxIndex As Integer = 0 EgtUILib.GetPrivateProfileString([VARIANT], K_MAXINDEX, "", sMaxIndex, m_sBTLIniFile) Integer.TryParse(sMaxIndex, nMaxIndex) For Index As Integer = 0 To nMaxIndex m_VARIANTList.Add(Index) Next End Sub #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 Function GetPBTLParams() As List(Of BTLParamM) Return New List(Of BTLParamM)(m_PBTLParamMList) 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, nSelVARIANT, True, ParamIndex, Me, NewBTLParam) TempList.Add(NewBTLParam) ParamIndex += 1 End While If TempList.Count <= 0 Then While BTLIniFile.GetBeamPrivateProfileParam(m_nSelGRP, m_nPRC, 0, True, ParamIndex, Me, NewBTLParam) TempList.Add(NewBTLParam) ParamIndex += 1 End While End If NewBTLFeature.PBTLParamMList = TempList ' leggo tutti i Q della feature ParamIndex = 1 TempList = New List(Of BTLParamM) While BTLIniFile.GetBeamPrivateProfileParam(m_nSelGRP, m_nPRC, nSelVARIANT, False, ParamIndex, Me, NewBTLParam) TempList.Add(NewBTLParam) ParamIndex += 1 End While End Sub ' funzione che legge il valore corrente del parametro Public Function ReadFeatureParams() As Boolean Return ReadFeatureParams(m_PBTLParamMList) 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 ' recupero info Custom Dim nCustom As Integer = 0 EgtGetInfo(nFeatureId, Param.sName & "A", nCustom) 'se pezzo parent di tipo Part If TypeOf m_ParentPart Is PartM Then Param.SetValue(dParamValue) ' se è un parametro Q verifico nel progetto se sia un valore custom ElseIf 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) 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 setta i valori di default a tutti i parametri Public Function SetDefaultValues() As Boolean Return SetDefaultValues(m_PBTLParamMList) 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(Param.sDefault) 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 End Select Next vPar = vTempPar sPar = If(String.IsNullOrEmpty(sTempPar), " ", sTempPar) End If 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 EgtSetInfo(nFeatureId, BTL_FTR_PRIORITY, nPriority) SetFeatureId(nFeatureId) ' imposto modificato per copie MyMachGroupPanelM.SetDuploModified(ParentPart.nPartId) bOk = True Else ' Impossibile creare una feature con questi valori - ERRORE EgtMessageBoxV.Show(Application.Current.MainWindow, EgtMsg(61852), EgtMsg(30007)) nFeatureId = EgtBeamModifyProcess(Me.nFeatureId, Me.nSelGRP, Me.nPRC, Me.nSelSIDE, "", Me.nPRID, Me.frFRAME, 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 ' funzione che restituisce se la feature è un Variant Public Function IsVariant() As Boolean Return m_nPRC = 900 End Function #End Region ' METHODS End Class