Files
OmagCUT/WorkInProgress/WorkInProgressPageUC.xaml.vb
T
Demetrio Cassarino 5145accc39 -aggiornato messggi
2025-07-14 08:41:49 +02:00

506 lines
22 KiB
VB.net

Imports System.Windows.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 As Integer = 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 As Integer = 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
Dim nCurrPhase = 1
Dim bCurrPhaseExists As Boolean = False
If GetPrivateProfileString(S_MACH_INPROGRESS, K_PHASEVAR, "E80020", sPhaseVar, m_MainWindow.GetMachIniFile()) <> 0 Then
bCurrPhaseExists = True
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)
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()
Else
EgtOutLog("Variabile 'PhaseVar' mancante! In CurrentMachine non sarà aggiornata la fase del grezzo")
End If
' Tempo di ritardo nel ciclo
Dim nTimeStep As Integer = 50
nTimeStep = GetPrivateProfileInt(S_MACH_INPROGRESS, K_WP_STEPTIME, nTimeStep, m_MainWindow.GetMachIniFile())
EgtOutLog("Tempo di attesa tra una lettura degli assi e la successiva: " & nTimeStep.ToString & " (ms)")
' Ciclo
While m_bContinue
' Rileggo la variabile di fase
If bCurrPhaseExists Then 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()
End If
' Per evitare di ciclare rapidissimamente e consumare inutilmente CPU
System.Threading.Thread.Sleep(nTimeStep)
' Leggo la fase
If bCurrPhaseExists AndAlso m_MainWindow.m_CNCommunication.m_CN.n_DReadELS_handle = 3 Then
m_MainWindow.m_CNCommunication.m_CN.n_DReadELS_handle = 0
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
WorkInProgressScene.SetViewBackground(GetBackTopColor(), GetBackBottomColor())
' 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
Dim bProd As Boolean = m_MainWindow.GetKeyOption(MainWindow.KEY_OPT.CUT_BASE) Or m_MainWindow.GetKeyOption(MainWindow.KEY_OPT.CUT_LIGHT)
If Not WorkInProgressScene.Init() Or Not bProd Then
' Rimuovo l'host della scena perchè altrimenti rimarrebbe il buco!!
Me.WorkInProgressPageGrid.Children.Remove(WorkInProgressSceneHost)
' Flag per riavvio programma
Dim bRestart As Boolean = False
#If TRIAL Then
Dim MissingKeyWnd As New EgtMsgBox(m_MainWindow, EgtMsg(10101), EgtMsg(10105) & " " & EgtMsg(10107), EgtMsgBox.Buttons.OK, EgtMsgBox.Icons.NULL, 0, 1)
#Else
' Se manca la chiave
If m_MainWindow.GetKeyLevel() = -1 Or m_MainWindow.GetKeyLevel() = -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(10102) & vbCrLf & EgtMsg(10103)
Dim sTitle As String = EgtMsg(10101)
Dim MissingKeyWnd As New EgtMsgBox(m_MainWindow, sTitle, sText, EgtMsgBox.Buttons.OK, EgtMsgBox.Icons.NULL)
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)
Dim MissingKeyWnd As New EgtMsgBox(m_MainWindow, sTitle, sText, EgtMsgBox.Buttons.OK, EgtMsgBox.Icons.NULL)
End If
ElseIf m_MainWindow.GetKeyLevel() = -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)
Dim MissingKeyWnd As New EgtMsgBox(m_MainWindow, sTitle, sText, EgtMsgBox.Buttons.OK, EgtMsgBox.Icons.NULL)
' 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 sKeyInfo As String = "" : EgtGetKeyInfo(sKeyInfo)
Dim sText As String = sKeyInfo & vbCrLf & EgtMsg(10105) & vbCrLf & EgtMsg(10106)
Dim sTitle As String = EgtMsg(10101)
Dim MissingKeyWnd As New EgtMsgBox(m_MainWindow, sTitle, sText, EgtMsgBox.Buttons.OK, EgtMsgBox.Icons.NULL, 0, 2)
If MissingKeyWnd.DialogResult = True 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 = System.IO.Path.GetDirectoryName(LicDlg.FileName)
' Se il file non è già nel direttorio di configurazione lo copio
If Not String.Equals(System.IO.Path.GetFullPath(sDir), System.IO.Path.GetFullPath(m_MainWindow.GetConfigDir()), StringComparison.OrdinalIgnoreCase) Then
Try
System.IO.File.Copy(LicDlg.FileName, System.IO.Path.Combine(m_MainWindow.GetConfigDir(), LicDlg.SafeFileName), True)
Catch ex As Exception
End Try
End If
' Imposto il nuovo file di licenza nell'Ini
WritePrivateProfileString(S_GENERAL, K_LICENCE, LicDlg.SafeFileName, m_MainWindow.GetIniFile())
' Imposto riavvio
bRestart = True
End If
End If
End If
#End If
m_MainWindow.Close()
If bRestart Then Process.Start(Application.ResourceAssembly.Location)
Return True
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(), m_MainWindow.GetToolMakersDir())
' 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 le teste
EgtResetHeadSet("H1")
EgtResetHeadSet("H2")
' 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 sHead As String = ""
Dim nExit As Integer = 0
Dim sTool As String = GetSecondTool(sHead, nExit)
If Not String.IsNullOrEmpty(sTool) AndAlso Not EgtLoadTool(sHead, nExit, 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(ByRef sHead As String, ByRef nExit As Integer) As String
' Se non previsto secondo utensile, non c'è
If m_MainWindow.m_CurrentMachine.MountedToolConfig <> CurrentMachine.MountedToolConfigs.SAWANDAUXTOOL Then
Return ""
End If
' Se foretto
Dim sTool As String = m_MainWindow.m_CurrentMachine.sCurrDrill
If Not String.IsNullOrEmpty(sTool) Then
sHead = "H1"
nExit = 2
Return sTool
End If
' se fresa
sTool = m_MainWindow.m_CurrentMachine.sCurrMill
If Not String.IsNullOrEmpty(sTool) Then
sHead = "H1"
nExit = 2
Return sTool
End If
' se waterjet
sTool = m_MainWindow.m_CurrentMachine.sCurrMill
If Not String.IsNullOrEmpty(sTool) Then
sHead = "H2"
nExit = 1
Return sTool
End If
Return ""
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 sHead As String = ""
Dim nExit As Integer = 0
Dim sTool As String = GetSecondTool(sHead, nExit)
If Not String.IsNullOrEmpty(sTool) AndAlso EgtSetCalcTool(sTool, sHead, nExit) 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