Imports System.ComponentModel Imports System.IO Imports System.Windows.Forms.Integration Imports EgtUILib Imports System.Collections.ObjectModel Imports EgtWPFLib5 Public Class SceneManagerVM Implements INotifyPropertyChanged Friend bProtectKey As Boolean = True Friend EnableRefresh As Boolean = True Private m_ShowPanel As ShowPanelV Public ReadOnly Property ShowPanel As ShowPanelV Get If IsNothing(m_ShowPanel) Then m_ShowPanel = New ShowPanelV m_ShowPanel.DataContext = New ShowPanelVM() End If Return m_ShowPanel End Get End Property Private m_ViewPanel As ViewPanelV Public ReadOnly Property ViewPanel As ViewPanelV Get If IsNothing(m_ViewPanel) Then m_ViewPanel = New ViewPanelV m_ViewPanel.DataContext = New ViewPanelVM(Me) End If Return m_ViewPanel End Get End Property Private m_PopUpViewPanel As PopUpViewPanelV Public ReadOnly Property PopUpViewPanel As PopUpViewPanelV Get If IsNothing(m_PopUpViewPanel) Then m_PopUpViewPanel = New PopUpViewPanelV m_PopUpViewPanel.DataContext = New PopUpViewPanelVM() End If Return m_PopUpViewPanel End Get End Property Private m_InstrumentPanel As InstrumentPanelV Public ReadOnly Property InstrumentPanel As InstrumentPanelV Get If IsNothing(m_InstrumentPanel) Then m_InstrumentPanel = New InstrumentPanelV() m_InstrumentPanel.DataContext = New InstrumentPanelVM() End If Return m_InstrumentPanel End Get End Property Private m_RefreshPanel As RefreshPanelV Public ReadOnly Property RefreshPanel As RefreshPanelV Get If IsNothing(m_RefreshPanel) Then m_RefreshPanel = New RefreshPanelV m_RefreshPanel.DataContext = New RefreshPanelVM() End If Return m_RefreshPanel End Get End Property Private m_StatusBar As StatusBarV Public ReadOnly Property StatusBar As StatusBarV Get If IsNothing(m_StatusBar) Then m_StatusBar = New StatusBarV m_StatusBar.DataContext = New StatusBarVM() End If Return m_StatusBar End Get End Property Private m_GraphicError As String = String.Empty Friend ReadOnly Property GraphicError As String Get Return m_GraphicError End Get End Property Private m_GraphicErrorType As String = String.Empty Friend ReadOnly Property GraphicErrorType As String Get Return m_GraphicErrorType End Get End Property 'PROJECT PAGE'S SCENE FIELDS AND PROPERTIES ' Reference to the ProjectScene Private WithEvents m_ProjectScene As New Scene Public ReadOnly Property ProjectScene As Scene Get Return m_ProjectScene End Get End Property ' Property used to bind the scene to the WindowsFormsHost in XAML Private m_ProjectSceneHost As WindowsFormsHost Public ReadOnly Property ProjectSceneHost As WindowsFormsHost Get If IsNothing(m_ProjectSceneHost) Then m_ProjectSceneHost = New WindowsFormsHost() With {.Child = m_ProjectScene} ' Creazione scena PreInitializeScene() ' Se tutto bene If m_ProjectScene.Init() And ((IniFile.m_nKeyOptions And KEY_OPT.DOORCREATOR) <> 0 OrElse (Not (IniFile.m_nKeyOptions And KEY_OPT.DOORCREATOR) <> 0 AndAlso (IniFile.m_nKeyOptions And KEY_OPT.READ_ONLY) <> 0)) Then EgtSetCurrentContext(m_ProjectScene.GetCtx) PostInitializeScene() m_ProjectScene.SetStatusNull() Return m_ProjectSceneHost End If ' Problemi bProtectKey = False m_ProjectSceneHost.Child = Nothing ' Se manca la chiave If IniFile.m_nKeyLevel = -1 Or IniFile.m_nKeyLevel = -2 Then If Not EgtGetNetHwKey() Then EgtOutLog("Missing Dongle") ' Box di avviso chiave mancante : "Chiave non presente. \n Inserirla e riavviare il programma." "Errore" Dim sText As String = EgtMsg(MSG_MISSINGKEYWD + 2) & vbCrLf & EgtMsg(MSG_MISSINGKEYWD + 3) Dim sTitle As String = EgtMsg(MSG_MISSINGKEYWD + 1) MessageBox.Show(sText, sTitle, MessageBoxButton.OK, MessageBoxImage.Error) Else EgtOutLog("NetDongle is full") ' Box di avviso slot chiave di rete occupato : "Chiave di Rete completamente occupata. \n Uscire dal programma su un altro PC." "Errore" Dim sText As String = EgtMsg(10110) & vbCrLf & EgtMsg(10111) Dim sTitle As String = EgtMsg(10101) MessageBox.Show(sText, sTitle, MessageBoxButton.OK, MessageBoxImage.Error) End If ElseIf IniFile.m_nKeyLevel = -9 Then EgtOutLog("Missing Link with Net Dongle") ' Box di avviso chiave mancante : "Collegamento con la Chiave di rete non riuscito. \n Verificare la connessione." "Errore" Dim sText As String = EgtMsg(10108) & vbCrLf & EgtMsg(10109) Dim sTitle As String = EgtMsg(10101) MessageBox.Show(sText, sTitle, MessageBoxButton.OK, MessageBoxImage.Error) ' Altrimenti manca la licenza Else EgtOutLog("Problems with Licence") ' Box di avviso licenza con problemi : "Programma senza licenza. \n Caricala e riavvia il programma." "Errore" Dim sText As String = EgtMsg(MSG_MISSINGKEYWD + 5) & vbCrLf & EgtMsg(MSG_MISSINGKEYWD + 6) Dim sTitle As String = EgtMsg(MSG_MISSINGKEYWD + 1) If MessageBox.Show(sText, sTitle, MessageBoxButton.OKCancel, MessageBoxImage.Error) = MessageBoxResult.OK Then ' Apro dialogo per richiesta file licenza Dim LicDlg As New Microsoft.Win32.OpenFileDialog() With { .DefaultExt = ".lic", .Filter = "Licences (.lic)|*.lic", .CheckFileExists = True, .ValidateNames = True } If LicDlg.ShowDialog() = True Then ' Recupero il direttorio del file Dim sDir As String = Path.GetDirectoryName(LicDlg.FileName) ' Se il file non è già nel direttorio di configurazione lo copio If Not String.Equals(Path.GetFullPath(sDir), Path.GetFullPath(IniFile.m_sConfigDir), StringComparison.OrdinalIgnoreCase) Then Try File.Copy(LicDlg.FileName, Path.Combine(IniFile.m_sConfigDir, LicDlg.SafeFileName), True) Catch ex As Exception End Try End If ' Imposto il nome del nuovo file di licenza nell'Ini WriteMainPrivateProfileString(S_GENERAL, K_LICENCE, LicDlg.SafeFileName) End If End If End If ' Chiudo il programma End End If Return m_ProjectSceneHost End Get End Property ' Scene controller Private WithEvents m_Controller As New Controller Friend Function GetController() As Controller Return m_Controller End Function ' definizione comando Private m_CmdRefreshBtn As ICommand 'Private m_CmdAssemblyBtn As ICommand Sub New() Map.SetRefSceneManagerVM(Me) AddHandler Application.Current.MainWindow.KeyDown, AddressOf Scene_KeyDown End Sub Private Sub PreInitializeScene() ' imposto colore di default Dim DefColor As New Color3d(0, 0, 0) GetMainPrivateProfileColor(S_GEOMDB, K_DEFAULTCOLOR, DefColor) m_ProjectScene.SetDefaultMaterial(DefColor) ' imposto colori sfondo Dim BackTopColor As New Color3d(192, 192, 192) GetMainPrivateProfileColor(S_SCENE, K_BACKTOP, BackTopColor) Dim BackBotColor As New Color3d(BackTopColor) GetMainPrivateProfileColor(S_SCENE, K_BACKBOTTOM, BackBotColor) m_ProjectScene.SetViewBackground(BackTopColor, BackBotColor) ' imposto colore di evidenziazione Dim MarkColor As New Color3d(255, 255, 0) GetMainPrivateProfileColor(S_SCENE, K_MARK, MarkColor) m_ProjectScene.SetMarkMaterial(MarkColor) ' imposto colore per superfici selezionate Dim SelSurfColor As New Color3d(255, 255, 192) GetMainPrivateProfileColor(S_SCENE, K_SELSURF, SelSurfColor) m_ProjectScene.SetSelSurfMaterial(SelSurfColor) ' imposto tipo e colore del rettangolo di zoom Dim bOutline As Boolean = True Dim ZwColor As New Color3d(0, 0, 0) GetMainPrivateProfileZoomWin(S_SCENE, K_ZOOMWIN, bOutline, ZwColor) m_ProjectScene.SetZoomWinAttribs(bOutline, ZwColor) ' imposto colore della linea di distanza Dim DstLnColor As New Color3d(255, 0, 0) GetMainPrivateProfileColor(S_SCENE, K_DISTLINE, DstLnColor) m_ProjectScene.SetDistLineMaterial(DstLnColor) ' Imposto i parametri del disegno quote OptionModule.m_ExtLineLen = GetMainPrivateProfileDouble(S_DIMENSIONSTYLE, K_EXTLINELEN, 5) OptionModule.m_ArrowLen = GetMainPrivateProfileDouble(S_DIMENSIONSTYLE, K_ARROWLEN, 5) OptionModule.m_TextDist = GetMainPrivateProfileDouble(S_DIMENSIONSTYLE, K_TEXTDIST, 2) OptionModule.m_LenIsMM = GetMainPrivateProfileInt(S_DIMENSIONSTYLE, K_LENISMM, 2) OptionModule.m_DecDigit = GetMainPrivateProfileInt(S_DIMENSIONSTYLE, K_DECDIGIT, -2) OptionModule.m_Font = "" : GetMainPrivateProfileString(S_DIMENSIONSTYLE, K_DIMFONT, "ModernPropS.Nfe", OptionModule.m_Font) OptionModule.m_TextHeight = GetMainPrivateProfileDouble(S_DIMENSIONSTYLE, K_TEXTHEIGHT, 2) EgtSetCurrDimensionStyle(OptionModule.m_ExtLineLen, OptionModule.m_ArrowLen, OptionModule.m_TextDist, OptionModule.m_LenIsMM, OptionModule.m_DecDigit, OptionModule.m_Font, OptionModule.m_TextHeight) ' imposto parametri OpenGL Dim nDriver As Integer = GetMainPrivateProfileInt(S_OPENGL, K_DRIVER, 3) Dim b2Buff As Boolean = (GetMainPrivateProfileInt(S_OPENGL, K_DOUBLEBUFFER, 1) <> 0) Dim nColorBits As Integer = GetMainPrivateProfileInt(S_OPENGL, K_COLORBITS, 32) Dim nDepthBits As Integer = GetMainPrivateProfileInt(S_OPENGL, K_DEPTHBITS, 32) m_ProjectScene.SetViewAttributes(nDriver, b2Buff, nColorBits, nDepthBits) End Sub Private Sub PostInitializeScene() ' Impostazioni Controller m_Controller.SetScene(m_ProjectScene) ' imposto stile quotature Dim dExtLineLen As Double = GetMainPrivateProfileDouble(S_DIMENSIONSTYLE, K_EXTLINELEN, 5) Dim dArrowLen As Double = GetMainPrivateProfileDouble(S_DIMENSIONSTYLE, K_ARROWLEN, 5) Dim dTextDist As Double = GetMainPrivateProfileDouble(S_DIMENSIONSTYLE, K_TEXTDIST, 2) Dim nLenIsMM As Integer = GetMainPrivateProfileInt(S_DIMENSIONSTYLE, K_LENISMM, 2) Dim nDecDigit As Integer = GetMainPrivateProfileInt(S_DIMENSIONSTYLE, K_DECDIGIT, -2) Dim sFont As String = "" : GetMainPrivateProfileString(S_DIMENSIONSTYLE, K_DIMFONT, "ModernPropS.Nfe", sFont) Dim dTextHeight As Double = GetMainPrivateProfileDouble(S_DIMENSIONSTYLE, K_TEXTHEIGHT, 2) EgtSetCurrDimensionStyle(dExtLineLen, dArrowLen, dTextDist, nLenIsMM, nDecDigit, sFont, dTextHeight) ' Impostazioni Controller m_Controller.SetScene(m_ProjectScene) Dim nShowMode As Integer = GetMainPrivateProfileInt(S_SCENE, K_SHOWMODE, SM.SHADING) Dim nShowCurveDir As Integer = GetMainPrivateProfileInt(S_SCENE, K_CURVEDIR, 0) AddHandler Map.refInstrumentPanelVM.EnableCurrentPage, AddressOf Map.refPartPageVM.SetStatusPage If OptionModule.m_ConfigurationSoftware = ConfigType.Assembly Then AddHandler Map.refInstrumentPanelVM.EnableCurrentPage, AddressOf Map.refAssemblyPageVM.SetStatusPage End If End Sub 'questo metodo restituisce l'errore letto nel file CurrDoor.txt Friend Sub ShowGraphicError() Dim FileContent() As String ' controllo se esite il file CurrDoor.txt If Not File.Exists(IniFile.m_sTempDir & "\" & TEMP_PART_TXT) Then Return FileContent = File.ReadAllLines(IniFile.m_sTempDir & "\" & TEMP_PART_TXT) ' se il file esiste ma è vuoto If FileContent.Count = 0 Then MessageBox.Show(EgtMsg(50107), EgtMsg(50101), MessageBoxButton.OK, MessageBoxImage.Error) End If Dim IndexLine As Integer = 0 Dim nMsgErr As Integer = 0 ' leggo il valore numerico (se il valore non è numerico è passato di default il valore 0) nMsgErr = RegexFunction.ErrDraw(FileContent(IndexLine)) ' passo alla riga succesiva IndexLine += 1 ' se il valore è maggiore di zero allora è un errore If nMsgErr > 0 Then ' salto tutte le righe vuote While String.IsNullOrEmpty(FileContent(IndexLine)) AndAlso IndexLine < FileContent.Count IndexLine += 1 End While m_GraphicError = FileContent(IndexLine) IndexLine += 1 While IndexLine < FileContent.Count m_GraphicError &= vbNewLine & FileContent(IndexLine) IndexLine += 1 End While ' se compare un errore disattivo il righello DirectCast(Me.InstrumentPanel.DataContext, InstrumentPanelVM).GetDistIsChecked = False ' rendo visibile il bottone dell'errore DirectCast(Me.RefreshPanel.DataContext, RefreshPanelVM).ErrorVisibility = Visibility.Visible m_GraphicErrorType = EgtMsg(50101) & nMsgErr ' altrimenti un avvertimento ElseIf nMsgErr < 0 Then While String.IsNullOrEmpty(FileContent(IndexLine)) AndAlso IndexLine < FileContent.Count IndexLine += 1 End While m_GraphicError = FileContent(IndexLine) IndexLine += 1 While IndexLine < FileContent.Count m_GraphicError &= vbNewLine & FileContent(IndexLine) IndexLine += 1 End While DirectCast(Me.RefreshPanel.DataContext, RefreshPanelVM).ErrorVisibility = Visibility.Visible m_GraphicErrorType = EgtMsg(50144) & nMsgErr Else DirectCast(Me.RefreshPanel.DataContext, RefreshPanelVM).ErrorVisibility = Visibility.Collapsed End If End Sub #Region "COMMAND" #Region "RefreshBtnCommand" Public ReadOnly Property RefreshBtnCommand As ICommand Get If m_CmdRefreshBtn Is Nothing Then m_CmdRefreshBtn = New Command(AddressOf RefreshBtn) End If Return m_CmdRefreshBtn End Get End Property Friend Shared nComposeAssembly As Integer = 1 Public Sub RefreshBtn() ' definisco e rimuovo file temporaneo di assemblato Dim sTempFile As String = IniFile.m_sTempDir & "\" & TEMP_FILE Try File.Delete(sTempFile) Catch ex As Exception End Try ' eseguo If Map.refMainWindowVM.SelectedPage = MainWindowVM.ListPageEnum.nDDFPage Then ' Verifico esista elemento selezionato If IsNothing(Map.refAssemblyManagerVM.CurrProject.SelAssemblyName) OrElse IsNothing(Map.refPartPageVM.CurrPart) Then Return DdfFile.WriteDDFPart(Map.refPartPageVM.CurrPart, sTempFile, True, False) ExecDoors(m_ProjectScene, sTempFile, False) ' mantengo i layer accesi For Each Compo In Map.refDimensioningPanelVM.HardwareDimensionList PrintWndVM.TurnDimensioningLayer(Compo.NameLayer, Compo.SelectedLayer) Next EgtDraw() ShowGraphicError() ElseIf Map.refMainWindowVM.SelectedPage = MainWindowVM.ListPageEnum.nAssemblyPage Then If Not EnableRefresh Then Return ' Verifico esista elemento selezionato If IsNothing(Map.refAssemblyManagerVM.CurrProject.SelAssemblyName) OrElse IsNothing(Map.refAssemblyPageVM.CurrAssembly) Then Return DdfFile.WriteDDFAssembly(Map.refAssemblyPageVM.CurrAssembly, sTempFile, True) ExecDoors(m_ProjectScene, sTempFile, False) ' mantengo i layer accesi For Each Compo In Map.refDimensioningPanelVM.HardwareDimensionList PrintWndVM.TurnDimensioningLayer(Compo.NameLayer, Compo.SelectedLayer) Next EgtDraw() ShowGraphicError() ElseIf Map.refMainWindowVM.SelectedPage = MainWindowVM.ListPageEnum.nHardwarePage Then If Not Hardware.DoRefresh OrElse Not Compo.DoRefreshCompo Then Return If Not IsNothing(Map.refHardwarePageVM.CurrHardware) Then Map.refHardwarePageVM.CurrHardware.RefreshTempHardware() End If DdfFile.WriteDDFPartForTestHardware(Map.refHardwarePageVM.GenericPart, sTempFile, True, False) Dim sNameModel As String = String.Empty If Not IsNothing(Map.refHardwarePageVM.CurrHardware) Then Dim nFirstPart As Integer = EgtGetFirstPart() For IndexChapter As Integer = 0 To Map.refHardwarePageVM.CurrHardware.GroupChapters.Count - 1 Dim ParamList As ObservableCollection(Of CompoParam) = Map.refHardwarePageVM.CurrHardware.GroupChapters(IndexChapter).CompoParamList For IndexParamInChapter As Integer = 0 To ParamList.Count - 1 If ParamList(IndexParamInChapter).DDFName.Contains(".Nome") Then If TypeOf ParamList(IndexParamInChapter) Is TextBoxParam Then 'ExecDoors(m_ProjectScene, sTempFile, False) Dim sNome As String = DirectCast(ParamList(IndexParamInChapter), TextBoxParam).Value Dim nCurrObject As Integer = EgtGetFirstNameInGroup(nFirstPart, sNome) Dim sSide As String = String.Empty IniFile.GetPrivateProfileJambSide(S_POSITIONSIDE, K_SIDE, sSide, Map.refHardwarePageVM.CurrHardware.HardwareGeneral.Path & "\" & CONFIGINI_FILE_NAME) If String.IsNullOrEmpty(sSide) Then ' controllo nell'elenco dei parametri se esiste un parametro di tipo Side For IndexParam As Integer = 0 To ParamList.Count - 1 If ParamList(IndexParam).DDFName.ToLower = K_SIDE.ToLower Then Side = DirectCast(ParamList(IndexParam), ComboBoxParam).SelItem Exit For End If Next End If If Hardware.FirstSelection Then Select Case sSide.ToLower Case SIDE_HINGE EgtSetView(VT.ISO_SE, False) Case SIDE_LOCK EgtSetView(VT.ISO_SW, False) Case SIDE_TOP EgtSetView(VT.ISO_NW, False) Case SIDE_BOTTOM EgtSetView(VT.ISO_SW, False) End Select EgtZoomObject(nCurrObject, False) Hardware.FirstSelection = False End If ExecDoors(m_ProjectScene, sTempFile, True) ShowGraphicError() Return End If End If Next Next End If ExecDoors(m_ProjectScene, sTempFile, False) EgtZoom(ZM.ALL, True) ShowGraphicError() Else EgtNewFile() EgtZoom(ZM.ALL) End If End Sub #End Region ' RefreshBtnCommand #Region "AssemblyBtnCommand" Public Sub AssemblyBtn() nComposeAssembly = 1 RefreshBtn() End Sub Public Sub ExlpodedBtn() nComposeAssembly = 2 RefreshBtn() End Sub Public Sub DisposedBtn() nComposeAssembly = 0 RefreshBtn() End Sub #End Region ' AssemblyBtn #End Region ' Command #Region "EVENT Scene" Private Sub MouseMoveOverScene(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles m_ProjectScene.OnMouseMoveScene ' Se non abilitata l'evidenziazione dei compo allora esco If GetMainPrivateProfileInt(S_GENERAL, "MarkCompo", 0) = 0 Then Return ' se non esiste una porta corrente allora esco If IsNothing(Map.refPartPageVM) OrElse IsNothing(Map.refPartPageVM.CurrPart) Then Return End If Dim LocalCompoList As ObservableCollection(Of Compo) = Map.refPartPageVM.CurrPart.CompoList ' Ripulisco la scena da i Mark Map.refPartPageVM.CurrPart.ResetAllMark() ' Se la lista dei componenti è vuota allora esco If Map.refPartPageVM.CurrPart.CompoList.Count < 1 Then Return ' Ricavo il punto corrente in coordinate mondo Dim ptCurr As Point3d EgtUnProjectPoint(e.Location, ptCurr) ' Verifico se selezionato curva EgtSetObjFilterForSelWin(False, True, False, False, False) Dim nSel As Integer EgtSelect(e.Location, Scene.DIM_SEL, Scene.DIM_SEL, nSel) Dim nId As Integer = EgtGetFirstObjInSelWin() While nId <> GDB_ID.NULL If EgtGetType(nId) = GDB_TY.CRV_COMPO Or EgtGetType(nId) = GDB_TY.CRV_ARC Or EgtGetType(nId) = GDB_TY.CRV_LINE Then Dim nIdParent As Integer = EgtGetParent(nId) Dim sNameLayer As String = String.Empty EgtGetName(nIdParent, sNameLayer) If Not sNameLayer.StartsWith("AUX") Or Not sNameLayer.StartsWith("SOLID") Or Not sNameLayer.StartsWith("DIM") Then ' scorro l'elenco dei componenti fino a trovare un riscontro tra i nomi e i parametri For Each ItemCompo As Compo In LocalCompoList If MatchCompoFromScena(nIdParent, ItemCompo, LocalCompoList) Then Exit While Next End If End If ' Passo al successivo nId = EgtGetNextObjInSelWin() End While End Sub Private Function MatchCompoFromScena(nIdLay As Integer, CurrCompo As Compo, CompoList As ObservableCollection(Of Compo)) As Boolean If IsNothing(CurrCompo) Then Return True ' recupero la lista dei compo dello stesso tipo Dim TempList As ObservableCollection(Of Compo) = DdfFile.GetCurrentListSameCompoType(CompoList, CurrCompo.CompoType.DDFName) ' recupero la lista dei compo con lo stesso nome TempList = DdfFile.GetCurrentListSameCompoDDFName(TempList, CurrCompo.SelFile, CurrCompo.SelBrandPart) ' riordino la lista appena trovata secondo le regole di stampa DDF DdfFile.GetOrderedListSameCompo(TempList) ' ottengo la posizione prevista nella grafica Dim IndexInList As Integer = DdfFile.GetIndexInList(TempList, CurrCompo) ' recupero la lista ordinata Dim sCompoName As String = CurrCompo.TemplateSelItem ' oridnamento del layer Dim IndexLay As Integer = -1 ' recupero il nome della comaponente selezionata con MouseOver Dim sInfoPath As String = String.Empty If Not EgtGetInfo(nIdLay, "Path", sInfoPath) Then Return True ' Dim sNamePath As String = Path.GetFileNameWithoutExtension(sInfoPath) Dim sNamePath As String = sInfoPath 'If sNamePath = sCompoName Then If sNamePath.Contains(sCompoName) Then Dim nCurrLayId As Integer = nIdLay Dim nCounter As Integer = 1 While nCurrLayId <> GDB_ID.NULL nCurrLayId = EgtGetNext(nCurrLayId) Dim LocalsPath As String = String.Empty If EgtGetInfo(nCurrLayId, "Path", LocalsPath) Then If sNamePath.Trim = LocalsPath.Trim Then nCounter += 1 End If End If End While IndexLay = TempList.Count - nCounter End If ' la compo passata non ha lo stesso nome, quindi mi aspetto un'altra compo If IndexLay = -1 Then Return False While IndexInList < TempList.Count And nIdLay <> GDB_ID.NULL ' recupero l'ordinamento del layer If sNamePath.Contains(sCompoName) And IndexLay = IndexInList Then EgtSetMark(nIdLay) ' evidenzio la compo corrente TempList(IndexInList).SetMark() EgtDraw() ' ricerca terminata correttamente Return True Exit While ElseIf sNamePath.Contains(sCompoName) And IndexInList < IndexLay Then IndexInList += 1 Else Return False End If End While ' prova con un'altra compo Return False End Function #End Region ' Event scene Public Sub ComposeAssembly(nAssembl As Integer) If Not File.Exists(IniFile.m_sDoorsDirPath & "\" & "Main_Assemb.lua") Then EgtOutLog("SetUp error: SetUp configuration file (" & IniFile.m_sDoorsDirPath & "\" & "Main_Assemb.lua)" & " doesn't exist ") MessageBox.Show("File (" & IniFile.m_sDoorsDirPath & "\" & "Main_Assemb.lua)" & " doesn't exist ", EgtMsg(50144), MessageBoxButton.OK, MessageBoxImage.Warning) Else EgtLuaExecFile(IniFile.m_sDoorsDirPath & "\" & "Main_Assemb.lua") EgtLuaSetGlobIntVar("STU.Assembl", nAssembl) EgtLuaCallFunction("STU.Assembled") EgtLuaResetGlobVar("STU") End If End Sub #Region "EVENTS" Sub m_ProjectScene_OnChangedSnapPointType(sender As Object, nSpType As EgtUILib.EgtInterface.SP, bForced As Boolean) Handles m_ProjectScene.OnChangedSnapPointType Dim rfStatusBarVM As StatusBarVM = DirectCast(m_StatusBar.DataContext, StatusBarVM) For SnapIndex = 0 To rfStatusBarVM.SnapPointTypeList.Count - 1 Dim TempSnapPoint As SPItem = rfStatusBarVM.SnapPointTypeList(SnapIndex) If TempSnapPoint.SPValue = nSpType Then rfStatusBarVM.SnapPointSelect = TempSnapPoint End If Next End Sub Sub m_ProjectScene_OnShowDistance(sender As Object, sDistance As String) Handles m_ProjectScene.OnShowDistance ' se deseleziono il righello Dim rfStatusBarVM As StatusBarVM = DirectCast(m_StatusBar.DataContext, StatusBarVM) Dim rfInstrumentPanel As InstrumentPanelVM = DirectCast(m_InstrumentPanel.DataContext, InstrumentPanelVM) ' restituisco una stringa vuota alla textblock che contiene la distanza rfStatusBarVM.StatusOutput = sDistance End Sub Private Sub OnMouseSelectedPoint(ByVal sender As Object, ByVal PtP As Point3d, ByVal nSep As SEP, ByVal nId As Integer) Handles m_ProjectScene.OnMouseSelectedPoint EgtSetCurrentContext(Map.refSceneManagerVM.ProjectScene.GetCtx()) Dim bDone As Boolean = (Keyboard.Modifiers And ModifierKeys.Control) <> ModifierKeys.Control m_Controller.MouseSelectedPoint(PtP, nSep, nId, bDone) End Sub Private Sub OnMouseMoveSelPoint(ByVal sender As Object, ByVal PtP As Point3d) Handles m_ProjectScene.OnMouseMoveSelPoint m_Controller.MouseMoveInSelectionPoint(PtP) End Sub Private Sub OnMouseSelectingObj(ByVal sender As Object, ByVal nId As Integer, ByRef bOk As Boolean) Handles m_ProjectScene.OnMouseSelectingObj bOk = (EgtGetType(nId) = GDB_TY.EXT_DIMENSION) End Sub Private Sub OnMouseSelectedObj(ByVal sender As Object, ByVal nId As Integer, ByVal bLast As Boolean) Handles m_ProjectScene.OnMouseSelectedObj m_Controller.MouseSelectedObj(nId, bLast) End Sub Private Sub OnSetInputBoxText(ByVal sText As String) Handles m_Controller.SetInputBoxText If sText = "<>" Then Map.refInstrumentPanelVM.TextDimensionVisibility = Visibility.Visible End If End Sub Private Sub Scene_KeyDown(ByVal sender As System.Object, ByVal e As KeyEventArgs) ' Con ESC esco dall'azione corrente If e.Key = Key.Escape Then ' reset Azione corrente m_Controller.ResetStatus() ' nacondo il campo di inserimento del testo Map.refInstrumentPanelVM.TextDimensionVisibility = Visibility.Collapsed ' reset Distanza Map.refInstrumentPanelVM.GetDistIsChecked = False If Map.refInstrumentPanelVM.DimensionVisibility = Visibility.Collapsed Then Map.refSceneManagerVM.ProjectScene.SetStatusNull() End If Map.refInstrumentPanelVM.SetEnablePage(True) End If End Sub Private Sub OnSceneKeyDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles m_ProjectScene.KeyDown ' Con DEL eseguo cancellazione delle entità selezionate If e.KeyData = System.Windows.Forms.Keys.Delete Then m_Controller.SetLastInteger(GDB_ID.SEL) m_Controller.ExecuteCommand(Controller.CMD.DELETE) End If End Sub #End Region Public Event PropertyChanged As PropertyChangedEventHandler Implements INotifyPropertyChanged.PropertyChanged Public Sub NotifyPropertyChanged(propName As String) RaiseEvent PropertyChanged(Me, New PropertyChangedEventArgs(propName)) End Sub End Class