Imports System.Windows.Threading Imports System.Threading Imports EgtUILib Public Class WorkInProgressPageUC ' Riferimento alla MainWindow Private m_MainWindow As MainWindow = Application.Current.MainWindow ' Properties Private m_bFirst As Boolean = True Private m_bContinue As Boolean = True Private m_bExecuting As Boolean = False ' Dichiarazione Scene Friend WithEvents WorkInProgressScene As New Scene Private WorkInProgressSceneHost As New System.Windows.Forms.Integration.WindowsFormsHost ' Start timer Private m_StartTimer As New DispatcherTimer Private Sub WorkInProgressPage_Initialized(sender As Object, e As EventArgs) ' Assegnazione scena all'host e posizionamento nella PlacePageGrid WorkInProgressSceneHost.Child = WorkInProgressScene WorkInProgressSceneHost.SetValue(Grid.ColumnProperty, 0) WorkInProgressSceneHost.SetValue(Grid.RowProperty, 1) Me.WorkInProgressPageGrid.Children.Add(WorkInProgressSceneHost) ' Timer per avvio ritardato AddHandler m_StartTimer.Tick, AddressOf StartTimer_tick ' Imposto i messaggi letti dal file dei messaggi End Sub Private Sub WorkInProgressPage_Loaded(sender As Object, e As RoutedEventArgs) ' Se primo caricamento If m_bFirst Then ' imposto colore di default Dim DefColor As New Color3d(0, 0, 0) GetPrivateProfileColor(S_GEOMDB, K_DEFAULTCOLOR, DefColor, m_MainWindow.GetIniFile()) WorkInProgressScene.SetDefaultMaterial(DefColor) ' imposto colori sfondo Dim BackTopColor As New Color3d(192, 192, 192) GetPrivateProfileColor(S_SCENE, K_BACKTOP, BackTopColor, m_MainWindow.GetIniFile()) Dim BackBotColor As New Color3d(BackTopColor) GetPrivateProfileColor(S_SCENE, K_BACKBOTTOM, BackBotColor, m_MainWindow.GetIniFile()) WorkInProgressScene.SetViewBackground(BackTopColor, BackBotColor) ' imposto colore di evidenziazione Dim MarkColor As New Color3d(255, 255, 0) GetPrivateProfileColor(S_SCENE, K_MARK, MarkColor, m_MainWindow.GetIniFile()) WorkInProgressScene.SetMarkMaterial(MarkColor) ' imposto colore per superfici selezionate Dim SelSurfColor As New Color3d(255, 255, 192) GetPrivateProfileColor(S_SCENE, K_SELSURF, SelSurfColor, m_MainWindow.GetIniFile()) WorkInProgressScene.SetSelSurfMaterial(SelSurfColor) ' imposto tipo e colore del rettangolo di zoom Dim bOutline As Boolean = True Dim ZwColor As New Color3d(0, 0, 0) GetPrivateProfileZoomWin(S_SCENE, K_ZOOMWIN, bOutline, ZwColor, m_MainWindow.GetIniFile()) WorkInProgressScene.SetZoomWinAttribs(bOutline, ZwColor) ' imposto colore della linea di distanza Dim DstLnColor As New Color3d(255, 0, 0) GetPrivateProfileColor(S_SCENE, K_DISTLINE, DstLnColor, m_MainWindow.GetIniFile()) WorkInProgressScene.SetDistLineMaterial(DstLnColor) ' imposto parametri OpenGL Dim nDriver As Integer = GetPrivateProfileInt(S_OPENGL, K_DRIVER, 3, m_MainWindow.GetIniFile()) Dim b2Buff As Boolean = (GetPrivateProfileInt(S_OPENGL, K_DOUBLEBUFFER, 1, m_MainWindow.GetIniFile()) <> 0) Dim nColorBits As Integer = GetPrivateProfileInt(S_OPENGL, K_COLORBITS, 32, m_MainWindow.GetIniFile()) Dim nDepthBits As Integer = GetPrivateProfileInt(S_OPENGL, K_DEPTHBITS, 32, m_MainWindow.GetIniFile()) WorkInProgressScene.SetViewAttributes(nDriver, b2Buff, nColorBits, nDepthBits) ' inizializzo la scena (DB geometrico + visualizzazione) e verifico presenza chiave If Not WorkInProgressScene.Init() Then Dim m_MissingKeyWindow As New MissingKeyWD m_MissingKeyWindow.Top = m_MainWindow.Top + (m_MainWindow.Height / 2 - m_MissingKeyWindow.Height / 2) m_MissingKeyWindow.Left = m_MainWindow.Left + (m_MainWindow.Width / 2 - m_MissingKeyWindow.Width / 2) m_MainWindow.Close() m_MissingKeyWindow.Show() End If ' Inizializzo gestore lavorazioni EgtInitMachMgr(m_MainWindow.GetMachinesRootDir()) ' Carico macchina If Not NewProject() Then EgtOutLog("WorkInProgress : error loading machine") End If ' Imposto visualizzazione EgtSetView(VT.ISO_SW, False) EgtZoom(ZM.ALL) ' Dichiaro eseguito primo caricamento m_bFirst = False Else EgtSetCurrentContext(WorkInProgressScene.GetCtx()) End If ' inibisco selezione diretta da Scene WorkInProgressScene.SetStatusNull() ' Carico eventuale progetto corrente If Not WorkProject() Then EgtOutLog("WorkInProgress : Error loading WorkProject") End If ' Imposto la lama corrente Dim sSaw As String = String.Empty GetPrivateProfileString(S_MACH, K_CURRSAW, "", sSaw, m_MainWindow.GetIniFile()) If Not EgtSetCalcTool(sSaw, "H1", 1) Then Return End If ' Imposto attivazione m_bContinue = True m_StartTimer.Interval = TimeSpan.FromMilliseconds(10) m_StartTimer.Start() End Sub Private Sub WorkInProgressPage_Unloaded(sender As Object, e As RoutedEventArgs) m_bContinue = False End Sub Private Function NewProject() As Boolean ' Imposto il nuovo progetto EgtNewFile() ' Creo un gruppo di lavoro e carico la macchina corrente If EgtAddMachGroup(MACH_GROUP, m_MainWindow.GetCurrMachine()) = GDB_ID.NULL Then Return False End If ' Imposto la tavola corrente If Not EgtSetTable(MAIN_TAB) Then Return False End If ' Aggiungo eventuale sovratavola AddAdditionalTable() Return True End Function Private Function WorkProject() As Boolean ' Se non esiste progetto in lavorazione, tavola libera Dim sPath As String = m_MainWindow.GetTempDir() & "\" & "WorkProj.nge" If Not My.Computer.FileSystem.FileExists(sPath) Then Return NewProject() End If ' Carico il progetto EgtOpenFile(sPath) ' Rendo corrente il gruppo di lavoro EgtSetCurrMachGroup(EgtGetFirstMachGroup()) Return True End Function Private Function AddAdditionalTable() As Boolean 'Recupero altezza eventuale tavola aggiuntiva Dim dAddTable As Double = GetPrivateProfileDouble(S_TABLE, K_ADDITIONALTABLE, 0, m_MainWindow.GetMachIniFile()) ' Se non esiste sovratavola, esco subito If dAddTable < 10 * EPS_SMALL Then Return True End If ' Recupero box tavola Dim ptMin, ptMax As Point3d EgtGetTableArea(1, ptMin, ptMax) ' Aggiungo sovratavola nel gruppo dei bloccaggi Const MACH_FIXT_GROUP As String = "Fixt" ptMax.z -= DELTAZ_ADDTAB ptMin.z = ptMax.z ptMax.z += dAddTable Dim nMchId As Integer = EgtGetFirstMachGroup() Dim nFixtId As Integer = EgtGetFirstNameInGroup(nMchId, MACH_FIXT_GROUP) Dim nAddTabId As Integer = EgtCreateSurfTmBBox(nFixtId, ptMin, ptMax, GDB_RT.GLOB) If nAddTabId = GDB_ID.NULL Then Return False End If EgtSetName(nAddTabId, "AddTab") EgtSetColor(nAddTabId, New Color3d(150, 75, 0, 100), True) Return True End Function Private Function Exec() As Boolean If m_bExecuting Then Return False End If ' Ciclo While m_bContinue m_bExecuting = True ' Recupero la posizione degli assi macchina Dim dL1, dL2, dL3, dR1, dR2 As Double m_MainWindow.m_CNCommunication.GetAxesPositions(dL1, dL2, dL3, dR1, dR2) ' Recupero il nome degli assi macchina Dim sL1 As String = String.Empty Dim sL2 As String = String.Empty Dim sL3 As String = String.Empty Dim sR1 As String = String.Empty Dim sR2 As String = String.Empty m_MainWindow.m_CNCommunication.GetAxesNames(sL1, sL2, sL3, sR1, sR2) ' Muovo la macchina EgtSetAxisPos(sL1, dL1) EgtSetAxisPos(sL2, dL2) EgtSetAxisPos(sL3, dL3) EgtSetAxisPos(sR1, dR1) EgtSetAxisPos(sR2, dR2) EgtDraw() ' Costringo ad aggiornare UI Dim nDummy As Integer Application.Current.Dispatcher.Invoke(Windows.Threading.DispatcherPriority.Background, _ New Action(Function() nDummy = 0)) End While m_bExecuting = False Return True End Function Private Sub StartTimer_tick() m_StartTimer.Stop() ' Ciclo Exec() End Sub End Class