Files
OmagCUT/WorkInProgressPageUC.xaml.vb
T
Dario Sassi 1809648cac OmagCUT 1.9f2 :
- aggiunta gestione spostamento finale pezzi su tavola ausiliaria con manipolatore
- migliorata gestione lettura contemporanea variabili per linea e per altro.
2018-06-12 06:56:28 +00:00

420 lines
17 KiB
VB.net

Imports System.Windows.Threading
Imports System.Threading
Imports EgtUILib
Imports EgtWPFLib
Public Class WorkInProgressPageUC
' Riferimento alla MainWindow
Private m_MainWindow As MainWindow = DirectCast(Application.Current.MainWindow, MainWindow)
Private m_CurrMachine As CurrentMachine
Private m_CurrNcComm As CNCommunication
' Properties
Private m_bPrepared As Boolean = False
Private m_bFirstShow As Boolean = True
Private m_bContinue As Boolean = True
Private m_bExecuting As Boolean = False
' Dichiarazione delle Page UserControl
Friend m_SceneButtons As SceneButtonsUC
Friend m_MachineButtons As MachineButtonsUC
' 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
' Stato di visualizzazione della macchina
Private m_nMachLook As Integer = MCH_LOOK.ALL
' Origine della tavola
Private m_ptTabOri As Point3d
Private Sub WorkInProgressPage_Initialized(sender As Object, e As EventArgs)
' Creazione delle Page UserControl
m_SceneButtons = New SceneButtonsUC
m_MachineButtons = New MachineButtonsUC
' Posizionemento nella griglia dei bottoni di vista
m_SceneButtons.SetValue(Grid.ColumnProperty, 2)
m_MachineButtons.SetValue(Grid.ColumnProperty, 1)
' Assegno SceneButtons e MachineButtons alla pagina
Me.UpperButtonsGrid.Children.Add(m_SceneButtons)
Me.LowerButtonsGrid.Children.Add(m_MachineButtons)
' Disabilito misura
m_SceneButtons.MeasureBtn.IsEnabled = False
' 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)
m_CurrMachine = m_MainWindow.m_CurrentMachine
m_CurrNcComm = m_MainWindow.m_CNCommunication
' Se già inizializzata
If Not Prepare() Then
' Imposto il giusto contesto
EgtSetCurrentContext(WorkInProgressScene.GetCtx())
End If
' Se prima visualizzazione
If m_bFirstShow Then
' Imposto visualizzazione
EgtSetView(VT.ISO_SW, False)
EgtZoom(ZM.ALL)
m_bFirstShow = False
Else
' Aggiorno subito la visualizzazione
EgtDraw()
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 utensili correnti
If Not UpdateTools() Then Return
' Aggiorno stato di visualizzazione macchina
m_nMachLook = MCH_LOOK.ALL
EgtSetMachineLook(m_nMachLook)
' 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 WipNewProject() 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"
' Per linea verifico quale progetto caricare
If m_CurrMachine.bProdLine And m_MainWindow.m_bNCLink Then
' Leggo variabile relativa al programma 1 (standard E80021)
m_CurrNcComm.m_CN.n_DReadELS_handle = 0
m_CurrNcComm.m_CN.ReadEls_Add_Parameter(m_CurrMachine.sVarProg1, 1)
Dim nVarProg1 As Integer = 99
For I = 0 To 20
System.Threading.Thread.Sleep(100)
If m_CurrNcComm.m_CN.n_DReadELS_handle = 1 Then
nVarProg1 = CInt(m_CurrNcComm.m_CN.d_DReadELS_value)
Exit For
End If
Next
If nVarProg1 = 2 Then
sPath = m_MainWindow.GetTempDir() & "\" & "WorkProj1.nge"
Else
' Leggo variabile relativa al programma 2 (standard E80022)
m_CurrNcComm.m_CN.n_DReadELS_handle = 0
m_CurrNcComm.m_CN.ReadEls_Add_Parameter(m_CurrMachine.sVarProg2, 1)
Dim nVarProg2 As Integer = 99
For I = 0 To 20
System.Threading.Thread.Sleep(100)
If m_CurrNcComm.m_CN.n_DReadELS_handle = 1 Then
nVarProg2 = CInt(m_CurrNcComm.m_CN.d_DReadELS_value)
Exit For
End If
Next
If nVarProg2 = 2 Then
sPath = m_MainWindow.GetTempDir() & "\" & "WorkProj2.nge"
End If
End If
End If
If Not My.Computer.FileSystem.FileExists(sPath) Then
Return WipNewProject()
End If
' Carico il progetto
EgtOpenFile(sPath)
' Rendo corrente il gruppo di lavoro
EgtSetCurrMachGroup(EgtGetFirstMachGroup())
Return True
End Function
Private Function AddAdditionalTable() As Boolean
' Altezza eventuale tavola aggiuntiva
Dim dAddTable As Double = m_MainWindow.m_CurrentMachine.dAdditionalTable
' 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
m_bExecuting = True
' Valori precedenti degli assi macchina
Dim dL1p, dL2p, dL3p, dR1p, dR2p As Double
Dim bFirst As Boolean = True
' Gestione fase di lavoro
Dim sPhaseVar As String = String.Empty
GetPrivateProfileString(S_MACH_INPROGRESS, K_PHASEVAR, "E80020", sPhaseVar, m_MainWindow.GetMachIniFile())
m_MainWindow.m_CNCommunication.m_CN.n_DReadELS_handle = 0
m_MainWindow.m_CNCommunication.m_CN.ReadEls_Add_Parameter(sPhaseVar, 3)
System.Threading.Thread.Sleep(100)
Dim nCurrPhase = 1
If m_MainWindow.m_CNCommunication.m_CN.n_DReadELS_handle = 3 Then
nCurrPhase = CInt(m_MainWindow.m_CNCommunication.m_CN.d_DReadELS_value)
End If
EgtSetCurrPhase(nCurrPhase, True)
EgtDraw()
' Ciclo
While m_bContinue
' Rileggo la variabile di fase
m_MainWindow.m_CNCommunication.m_CN.ReadEls_Add_Parameter(sPhaseVar, 3)
' Recupero la posizione degli assi macchina
Dim dL1, dL2, dL3, dR1, dR2 As Double
m_MainWindow.m_CNCommunication.GetAxesPositions(dL1, dL2, dL3, dR1, dR2)
If bFirst OrElse
Math.Abs(dL1 - dL1p) > EPS_SMALL OrElse Math.Abs(dL2 - dL2p) > EPS_SMALL OrElse Math.Abs(dL3 - dL3p) > EPS_SMALL OrElse
Math.Abs(dR1 - dR1p) > EPS_ANG_SMALL OrElse Math.Abs(dR2 - dR2p) > EPS_ANG_SMALL Then
bFirst = False
dL1p = dL1
dL2p = dL2
dL3p = dL3
dR1p = dR1
dR2p = 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()
Else
' Per evitare di ciclare rapidissimamente e consumare inutilmente CPU
System.Threading.Thread.Sleep(2)
End If
' Leggo la fase
If m_MainWindow.m_CNCommunication.m_CN.n_DReadELS_handle = 3 Then
Dim nNextPhase As Integer = CInt(m_MainWindow.m_CNCommunication.m_CN.d_DReadELS_value)
If nNextPhase > nCurrPhase Then
nCurrPhase = nNextPhase
EgtSetCurrPhase(nCurrPhase)
EgtDraw()
End If
End If
' Costringo ad aggiornare UI
UpdateUI()
End While
m_bExecuting = False
Return True
End Function
Private Sub StartTimer_tick()
m_StartTimer.Stop()
' Ciclo
Exec()
End Sub
Private Sub MachViewModeBtn_Click(sender As Object, e As RoutedEventArgs) Handles MachViewModeBtn.Click
' aggiorno lo stato
Select Case m_nMachLook
Case MCH_LOOK.ALL
m_nMachLook = MCH_LOOK.TAB_HEAD
Case MCH_LOOK.TAB_HEAD
m_nMachLook = MCH_LOOK.TAB_TOOL
Case Else
m_nMachLook = MCH_LOOK.ALL
End Select
' aggiorno lo stato della macchina e la sua visualizzazione
EgtSetMachineLook(m_nMachLook)
EgtDraw()
End Sub
Friend Function Prepare() As Boolean
' Se già caricato
If m_bPrepared Then Return False
' Primo caricamento
' 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
' Rimuovo l'host della scena perchè altrimenti rimarrebbe il buco!!
Me.WorkInProgressPageGrid.Children.Remove(WorkInProgressSceneHost)
Dim MissingKeyWnd As EgtMsgBox
#If TRIAL Then
MissingKeyWnd = New EgtMsgBox(m_MainWindow, EgtMsg(MSG_MISSINGKEYWD + 1), EgtMsg(MSG_MISSINGKEYWD + 5) & " " & EgtMsg(MSG_MISSINGKEYWD + 7), EgtMsgBox.Buttons.OK, EgtMsgBox.Icons.NULL, 0, 1)
#Else
MissingKeyWnd = New EgtMsgBox(m_MainWindow, EgtMsg(MSG_MISSINGKEYWD + 1), EgtMsg(MSG_MISSINGKEYWD + 2) & " " & EgtMsg(MSG_MISSINGKEYWD + 3), EgtMsgBox.Buttons.OK, EgtMsgBox.Icons.NULL)
#End If
m_MainWindow.Close()
End If
' dimensione lineare max in pixel delle textures
Dim nTxrMaxLinPix As Integer = GetPrivateProfileInt(S_SCENE, K_TEXMAXLINPIX, 4096, m_MainWindow.GetIniFile())
EgtSetTextureMaxLinPixels(nTxrMaxLinPix)
' Inizializzo gestore lavorazioni
EgtInitMachMgr(m_MainWindow.GetMachinesRootDir())
' Carico macchina
If Not WipNewProject() Then
EgtOutLog("WorkInProgress : error loading machine")
End If
' Recupero origine tavola
If Not EgtGetTableRef(1, m_ptTabOri) Then
EgtOutLog("WorkInProgress : error on TableRef1")
End If
' Dichiaro eseguito primo caricamento
m_bPrepared = True
Return True
End Function
Friend Function UpdateTools() As Boolean
' Verifico sia stata inizializzata
If Not m_bPrepared Then Return False
' Salvo il contesto corrente
Dim nOldCtx As Integer = EgtGetCurrentContext()
' Imposto il giusto contesto
Dim bOk As Boolean = EgtSetCurrentContext(WorkInProgressScene.GetCtx())
' Svuoto la testa
EgtResetHeadSet("H1")
' Imposto la lama corrente
Dim sSaw As String = GetFirstTool()
If bOk Then
If Not EgtSetCalcTool(sSaw, "H1", 1) Then bOk = False
End If
' Imposto eventuale secondo utensile montato
If bOk Then
Dim sTool As String = GetSecondTool()
If Not String.IsNullOrEmpty(sTool) AndAlso Not EgtLoadTool("H1", 2, sTool) Then
bOk = False
End If
End If
' Ripristino il contesto originale
EgtSetCurrentContext(nOldCtx)
Return bOk
End Function
Private Function GetFirstTool() As String
Return m_MainWindow.m_CurrentMachine.sCurrSaw
End Function
Private Function GetSecondTool() As String
' Se non previsto secondo utensile, non c'è
If m_MainWindow.m_CurrentMachine.MountedToolConfig <> CurrentMachine.MountedToolConfigs.SAWANDAUXTOOL Then
Return String.Empty
End If
' Cerco se foretto o fresa
Dim sTool As String = m_MainWindow.m_CurrentMachine.sCurrDrill
If String.IsNullOrEmpty(sTool) Then sTool = m_MainWindow.m_CurrentMachine.sCurrMill
Return sTool
End Function
Friend Function GetTipFromPositions(dL1 As Double, dL2 As Double, dL3 As Double, dR1 As Double, dR2 As Double,
ByRef ptTip As Point3d) As Boolean
' Verifico sia stata inizializzata
If Not m_bPrepared Then Return False
' Salvo il contesto corrente
Dim nOldCtx As Integer = EgtGetCurrentContext()
' Imposto il giusto contesto
Dim bOk As Boolean = EgtSetCurrentContext(WorkInProgressScene.GetCtx())
' Trasformo in posizione punta utensile in basso
If bOk Then
' Calcolo standard con utensile principale (lama)
If Not EgtGetCalcTipFromPositions(dL1, dL2, dL3, dR1, dR2, True, ptTip) Then bOk = False
' Se testa verticale e presente altro utensile, rifaccio calcolo con questo
Dim vtTool As Vector3d
If EgtGetCalcToolDirFromAngles(dR1, dR2, vtTool) AndAlso (vtTool - Vector3d.Z_AX()).IsSmall() Then
Dim sTool As String = GetSecondTool()
If Not String.IsNullOrEmpty(sTool) AndAlso EgtSetCalcTool(sTool, "H1", 2) Then
' Calcolo secondo tip
Dim ptTip2 As Point3d
If EgtGetCalcTipFromPositions(dL1, dL2, dL3, dR1, dR2, True, ptTip2) Then
ptTip = ptTip2
End If
' Ripristino configurazione standard
UpdateTools()
End If
End If
End If
' Trasformo rispetto a Zero Tavola
If bOk Then
ptTip.ToLoc(New Frame3d(m_ptTabOri + New Vector3d(0, 0, m_MainWindow.m_CurrentMachine.dAdditionalTable)))
End If
' Ripristino il contesto originale
EgtSetCurrentContext(nOldCtx)
Return bOk
End Function
End Class