Egalware/OmagCUT
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

OmagCUT 1.6k9 :

Browse Source 
- CamAutomatico usa lavorazione corrente e in caso di errore emette messaggio
- verifica corrispondenza tra macchina nel file e macchina corrente e gestione differenze
- nesting solo se esiste grezzo.
This commit is contained in:
Dario Sassi
2015-11-24 22:17:18 +00:00
parent c973a78476
commit 374fc7ff75
7 changed files with 409 additions and 337 deletions
Download Patch File Download Diff File Expand all files Collapse all files
CadCutPageUC.xaml.vb
+14
View File
@@ -177,7 +177,18 @@ Public Class CadCutPageUC
' Disabilito impostazione modificato
EgtDisableModified()
' Inserisco le lavorazioni
Dim sSawMch As String = String.Empty
GetPrivateProfileString(S_MACH, K_CURRMACHINING, "", sSawMch, m_MainWindow.GetIniFile())
EgtLuaCreateGlobTable("CAM")
EgtLuaSetGlobStringVar("CAM.SAWMCH", sSawMch)
bOk = EgtLuaExecFile(m_MainWindow.GetCamAutoDir() & "\CamAuto.lua")
Dim nErr As Integer = 999
EgtLuaGetGlobIntVar("CAM.ERR", nErr)
EgtLuaResetGlobVar("CAM")
If nErr <> 0 Then
bOk = False
EgtOutLog("Error in CamAuto : " & nErr.ToString())
End If
' Salvo il progetto con le lavorazioni
Dim sMchPath As String = m_MainWindow.GetTempDir() & "\" & "MachProj.nge"
m_MainWindow.m_CurrentProjectPageUC.SaveFile(sMchPath)
@@ -192,6 +203,7 @@ Public Class CadCutPageUC
OutMessageLbl.Text = EgtMsg(90314) 'Errore nella generazione del programma CN
OutMessageLbl.Background = Brushes.Tomato
OutMessageLbl.Visibility = Windows.Visibility.Visible
EgtOutLog(OutMessageLbl.Text)
Return
End If
' Download programma
@@ -212,11 +224,13 @@ Public Class CadCutPageUC
OutMessageLbl.Text = EgtMsg(90315) 'Errore nella trasmissione del programma CN
OutMessageLbl.Background = Brushes.Tomato
OutMessageLbl.Visibility = Windows.Visibility.Visible
EgtOutLog(OutMessageLbl.Text)
End If
Else
OutMessageLbl.Text = EgtMsg(90316) 'Non connesso alla macchina
OutMessageLbl.Background = Brushes.Gold
OutMessageLbl.Visibility = Windows.Visibility.Visible
EgtOutLog(OutMessageLbl.Text)
End If
End Sub
ConstIni.vb
+2 -1
View File
@@ -108,6 +108,8 @@ Module ConstIni
Public Const K_MACHINESDIR As String = "MachinesDir"
Public Const K_TOOLMAKERSDIR As String = "ToolMakersDir"
Public Const K_CURRMACH As String = "CurrMach"
Public Const K_CURRSAW As String = "CurrSaw"
Public Const K_CURRMACHINING As String = "CurrMachining"
Public Const S_SIMUL As String = "Simul"
Public Const K_SLIDERX As String = "SliderX"
@@ -116,7 +118,6 @@ Module ConstIni
Public Const S_MATERIALS As String = "Materials"
Public Const K_CURRMATERIAL As String = "CurrMaterial"
Public Const K_MATERIAL As String = "Material"
Public Const K_CURRSAW As String = "CurrSaw"
Public Const S_MRUFILES As String = "MruFiles"
Public Const S_MRUSCRIPTS As String = "MruScripts"
CurrentProjectPageUC.xaml.vb
+281 -245
View File
@@ -21,14 +21,15 @@ Public Class CurrentProjectPageUC
Friend WithEvents CurrentProjectScene As New Scene
Private CurrentProjectSceneHost As New System.Windows.Forms.Integration.WindowsFormsHost
' Macchina corrente
Private m_sCurrMachine As String = String.Empty
' Identificativo progetto corrente
Private m_nCurrProj As Integer = 0
' Dichiarazione altezza grezzo
Friend m_dRawHeight As Double
' Identificativo del grezzo
' Dati del grezzo
Friend m_nRawId As Integer = GDB_ID.NULL
Friend m_dRawHeight As Double
' Costanti
Friend Const MACH_GROUP As String = "Mach01"
@@ -36,246 +37,281 @@ Public Class CurrentProjectPageUC
Friend Const PHOTO_GRP As String = "Photos"
Friend Const PHOTO_NAME As String = "Raw"
Private Sub CurrentProjectPage_Initialized(sender As Object, e As EventArgs)
Private Sub CurrentProjectPage_Initialized(sender As Object, e As EventArgs)
'Creazione delle Page UserControl
m_SceneButtons = New SceneButtonsUC
'Creazione delle Page UserControl
m_SceneButtons = New SceneButtonsUC
'Posizionemento nella griglia delle Page UserControl
m_SceneButtons.SetValue(Grid.ColumnProperty, 5)
m_MainWindow.m_DirectCutPageUC.SetValue(Grid.RowSpanProperty, 3)
m_MainWindow.m_DirectCutPageUC.SetValue(Grid.ColumnSpanProperty, 2)
m_MainWindow.m_CadCutPageUC.SetValue(Grid.RowSpanProperty, 3)
m_MainWindow.m_CadCutPageUC.SetValue(Grid.ColumnSpanProperty, 2)
m_MainWindow.m_FrameCutPageUC.SetValue(Grid.RowSpanProperty, 3)
m_MainWindow.m_FrameCutPageUC.SetValue(Grid.ColumnSpanProperty, 2)
'Posizionemento nella griglia delle Page UserControl
m_SceneButtons.SetValue(Grid.ColumnProperty, 5)
m_MainWindow.m_DirectCutPageUC.SetValue(Grid.RowSpanProperty, 3)
m_MainWindow.m_DirectCutPageUC.SetValue(Grid.ColumnSpanProperty, 2)
m_MainWindow.m_CadCutPageUC.SetValue(Grid.RowSpanProperty, 3)
m_MainWindow.m_CadCutPageUC.SetValue(Grid.ColumnSpanProperty, 2)
m_MainWindow.m_FrameCutPageUC.SetValue(Grid.RowSpanProperty, 3)
m_MainWindow.m_FrameCutPageUC.SetValue(Grid.ColumnSpanProperty, 2)
'Assegno SceneButtons alla pagina
UpperButtonGrid.Children.Add(m_SceneButtons)
'Assegno SceneButtons alla pagina
UpperButtonGrid.Children.Add(m_SceneButtons)
'Assegnazione scena all'host e posizionamento nella PlacePageGrid
CurrentProjectSceneHost.Child = CurrentProjectScene
CurrentProjectSceneHost.SetValue(Grid.ColumnProperty, 1)
CurrentProjectSceneHost.SetValue(Grid.RowProperty, 1)
Me.CurrentProjectPageGrid.Children.Add(CurrentProjectSceneHost)
'Assegnazione scena all'host e posizionamento nella PlacePageGrid
CurrentProjectSceneHost.Child = CurrentProjectScene
CurrentProjectSceneHost.SetValue(Grid.ColumnProperty, 1)
CurrentProjectSceneHost.SetValue(Grid.RowProperty, 1)
Me.CurrentProjectPageGrid.Children.Add(CurrentProjectSceneHost)
'Imposto i messaggi letti dal file dei messaggi
MaterialLbl.Content = EgtMsg(MSG_ROWPARTPAGEUC + 9) 'Material - Materiale
HeightLbl.Content = EgtMsg(MSG_ROWPARTPAGEUC + 5) 'Height - Spessore
ToolLbl.Content = EgtMsg(MSG_CADCUTPAGEUC + 11) 'Tool - Utensile
MachiningLbl.Content = EgtMsg(MSG_CADCUTPAGEUC + 12) 'Machining - Lavorazione
'Imposto i messaggi letti dal file dei messaggi
MaterialLbl.Content = EgtMsg(MSG_ROWPARTPAGEUC + 9) 'Material - Materiale
HeightLbl.Content = EgtMsg(MSG_ROWPARTPAGEUC + 5) 'Height - Spessore
ToolLbl.Content = EgtMsg(MSG_CADCUTPAGEUC + 11) 'Tool - Utensile
MachiningLbl.Content = EgtMsg(MSG_CADCUTPAGEUC + 12) 'Machining - Lavorazione
End Sub
End Sub
Private Sub CurrentProjectPage_Loaded(sender As Object, e As RoutedEventArgs)
Private Sub CurrentProjectPage_Loaded(sender As Object, e As RoutedEventArgs)
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())
CurrentProjectScene.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())
CurrentProjectScene.SetViewBackground(BackTopColor, BackBotColor)
' imposto colore di evidenziazione
Dim MarkColor As New Color3d(255, 255, 0)
GetPrivateProfileColor(S_SCENE, K_MARK, MarkColor, m_MainWindow.GetIniFile())
CurrentProjectScene.SetMarkMaterial(MarkColor)
' imposto colore per superfici selezionate
Dim SelSurfColor As New Color3d(255, 255, 192)
GetPrivateProfileColor(S_SCENE, K_SELSURF, SelSurfColor, m_MainWindow.GetIniFile())
CurrentProjectScene.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())
CurrentProjectScene.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())
CurrentProjectScene.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())
CurrentProjectScene.SetViewAttributes(nDriver, b2Buff, nColorBits, nDepthBits)
' inizializzo la scena (DB geometrico + visualizzazione) e verifico presenza chiave
If Not CurrentProjectScene.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())
m_bFirst = False
' Se richiesto, carico ultimo progetto
Dim bAutoLoadLast As Boolean = GetPrivateProfileInt(S_GENERAL, K_AUTOLOADLASTPROJ, 0, m_MainWindow.GetIniFile()) <> 0
If bAutoLoadLast Then
m_nCurrProj = GetPrivateProfileInt(S_GENERAL, K_LASTPROJ, 0, m_MainWindow.GetIniFile())
Dim sPath As String = m_MainWindow.GetSaveDir() & "\" & m_nCurrProj.ToString("D4") & ".nge"
If Not LoadProject(sPath, False) Then
NewProject()
End If
EgtResetModified()
' Altrimenti ne imposto uno nuovo
Else
m_nCurrProj = GetPrivateProfileInt(S_GENERAL, K_LASTPROJ, 0, m_MainWindow.GetIniFile())
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())
CurrentProjectScene.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())
CurrentProjectScene.SetViewBackground(BackTopColor, BackBotColor)
' imposto colore di evidenziazione
Dim MarkColor As New Color3d(255, 255, 0)
GetPrivateProfileColor(S_SCENE, K_MARK, MarkColor, m_MainWindow.GetIniFile())
CurrentProjectScene.SetMarkMaterial(MarkColor)
' imposto colore per superfici selezionate
Dim SelSurfColor As New Color3d(255, 255, 192)
GetPrivateProfileColor(S_SCENE, K_SELSURF, SelSurfColor, m_MainWindow.GetIniFile())
CurrentProjectScene.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())
CurrentProjectScene.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())
CurrentProjectScene.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())
CurrentProjectScene.SetViewAttributes(nDriver, b2Buff, nColorBits, nDepthBits)
' inizializzo la scena (DB geometrico + visualizzazione) e verifico presenza chiave
If Not CurrentProjectScene.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())
m_bFirst = False
' Recupero nome macchina corrente
GetPrivateProfileString(S_MACH, K_CURRMACH, "", m_sCurrMachine, m_MainWindow.GetIniFile())
' Se richiesto, carico ultimo progetto
Dim bAutoLoadLast As Boolean = GetPrivateProfileInt(S_GENERAL, K_AUTOLOADLASTPROJ, 0, m_MainWindow.GetIniFile()) <> 0
If bAutoLoadLast Then
m_nCurrProj = GetPrivateProfileInt(S_GENERAL, K_LASTPROJ, 0, m_MainWindow.GetIniFile())
Dim sPath As String = m_MainWindow.GetSaveDir() & "\" & m_nCurrProj.ToString("D4") & ".nge"
If Not LoadProject(sPath, False) Then
NewProject()
End If
Else
EgtSetCurrentContext(CurrentProjectScene.GetCtx())
End If
' inibisco selezione diretta da Scene
CurrentProjectScene.SetStatusNull()
' Imposto dati progetto
If m_MainWindow.m_nCurrentMaterial >= 0 And
m_MainWindow.m_nCurrentMaterial < m_MainWindow.m_MaterialsList.Count() Then
MaterialTxBx.Text = m_MainWindow.m_MaterialsList(m_MainWindow.m_nCurrentMaterial).Name
Else
MaterialTxBx.Text = ""
End If
EgtResetModified()
' Altrimenti ne imposto uno nuovo
Else
m_nCurrProj = GetPrivateProfileInt(S_GENERAL, K_LASTPROJ, 0, m_MainWindow.GetIniFile())
NewProject()
End If
Else
EgtSetCurrentContext(CurrentProjectScene.GetCtx())
End If
' inibisco selezione diretta da Scene
CurrentProjectScene.SetStatusNull()
' Imposto dati progetto
If m_MainWindow.m_nCurrentMaterial >= 0 And
m_MainWindow.m_nCurrentMaterial < m_MainWindow.m_MaterialsList.Count() Then
MaterialTxBx.Text = m_MainWindow.m_MaterialsList(m_MainWindow.m_nCurrentMaterial).Name
Else
MaterialTxBx.Text = ""
End If
' Imposto utensile e lavorazione correnti
Dim sCurrSaw As String = String.Empty
GetPrivateProfileString(S_MACH, K_CURRSAW, "", sCurrSaw, m_MainWindow.GetIniFile())
ToolTxBx.Text = sCurrSaw
Dim sCurrMach As String = String.Empty
GetPrivateProfileString(S_MACH, K_CURRMACHINING, "", sCurrMach, m_MainWindow.GetIniFile())
MachiningTxBx.Text = sCurrMach
End Sub
End Sub
Private Sub OnMyMouseDownScene(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles CurrentProjectScene.OnMouseDownScene
RaiseEvent OnMouseDownScene(sender, e)
End Sub
Private Sub OnMyMouseDownScene(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles CurrentProjectScene.OnMouseDownScene
RaiseEvent OnMouseDownScene(sender, e)
End Sub
Private Sub OnMyMouseMoveScene(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles CurrentProjectScene.OnMouseMoveScene
RaiseEvent OnMouseMoveScene(sender, e)
End Sub
Private Sub OnMyMouseMoveScene(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles CurrentProjectScene.OnMouseMoveScene
RaiseEvent OnMouseMoveScene(sender, e)
End Sub
Private Sub OnMyMouseUpScene(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles CurrentProjectScene.OnMouseUpScene
RaiseEvent OnMouseUpScene(sender, e)
End Sub
Private Sub OnMyMouseUpScene(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles CurrentProjectScene.OnMouseUpScene
RaiseEvent OnMouseUpScene(sender, e)
End Sub
Private Sub SetNextProjectIndex()
' se indice negativo, non devo calcolarne uno nuovo
If m_nCurrProj < 0 Then
Return
End If
' Recupero massimo indice ammesso
Dim nMaxProj As Integer = GetPrivateProfileInt(S_GENERAL, K_MAXPROJ, 100, m_MainWindow.GetIniFile())
' Imposto nuovo indice di progetto
m_nCurrProj = -(Math.Abs(m_nCurrProj) + 1)
If m_nCurrProj < -nMaxProj Then
m_nCurrProj = -1
End If
End Sub
Private Sub SetNextProjectIndex()
' se indice negativo, non devo calcolarne uno nuovo
If m_nCurrProj < 0 Then
Return
End If
' Recupero massimo indice ammesso
Dim nMaxProj As Integer = GetPrivateProfileInt(S_GENERAL, K_MAXPROJ, 100, m_MainWindow.GetIniFile())
' Imposto nuovo indice di progetto
m_nCurrProj = -(Math.Abs(m_nCurrProj) + 1)
If m_nCurrProj < -nMaxProj Then
m_nCurrProj = -1
End If
End Sub
Friend Function NewProject() As Boolean
' Imposto nuovo indice di progetto
SetNextProjectIndex()
' Imposto il nuovo progetto
EgtOutLog("NewProject (" & m_nCurrProj.ToString() & ")")
EgtNewFile()
' Creo un gruppo di lavoro e carico la macchina corrente
If EgtAddMachGroup(MACH_GROUP, m_sCurrMachine) = GDB_ID.NULL Then
Return False
End If
' Imposto la tavola corrente
If Not EgtSetTable(MAIN_TAB) Then
Return False
End If
EgtShowOnlyTable(True)
' Reset spessore grezzo
m_dRawHeight = 0
HeightTxBx.Text = DoubleToString(m_dRawHeight, 2)
' Dichiaro progetto non modificato
EgtResetModified()
Return True
End Function
Friend Function NewProject() As Boolean
' Imposto nuovo indice di progetto
SetNextProjectIndex()
' Eseguo
EgtNewFile()
' Carico la macchina corrente
Dim sCurrMach As String = String.Empty
GetPrivateProfileString(S_MACH, K_CURRMACH, "", sCurrMach, m_MainWindow.GetIniFile())
If EgtAddMachGroup(MACH_GROUP, sCurrMach) = GDB_ID.NULL Then
Return False
End If
' Imposto la tavola corrente
If Not EgtSetTable(MAIN_TAB) Then
Return False
End If
EgtShowOnlyTable(True)
' Reset spessore grezzo
m_dRawHeight = 0
HeightTxBx.Text = DoubleToString(m_dRawHeight, 2)
' Dichiaro progetto non modificato
EgtResetModified()
Return True
End Function
Friend Function LoadProject(ByVal sPath As String, Optional ByVal bUpdateIndex As Boolean = True) As Boolean
' Se richiesto, imposto nuovo indice di progetto
If bUpdateIndex Then
SetNextProjectIndex()
End If
' Carico il file del progetto
EgtOutLog("LoadProject : " & sPath & " (" & m_nCurrProj.ToString() & ")")
If Not LoadFile(sPath) Then
Return False
End If
' aggiorno eventuale identificativo grezzo
m_nRawId = EgtGetFirstRawPart()
' aggiorno spessore grezzo
m_dRawHeight = m_MainWindow.m_RawPartPage.GetRawHeight()
HeightTxBx.Text = DoubleToString(m_dRawHeight, 2)
' Dichiaro progetto non modificato
EgtResetModified()
Return True
End Function
Friend Function LoadProject(ByVal sPath As String, Optional ByVal bUpdateIndex As Boolean = True) As Boolean
' Se richiesto, imposto nuovo indice di progetto
If bUpdateIndex Then
SetNextProjectIndex()
End If
' Eseguo
If Not LoadFile(sPath) Then
Private Function LoadFile(ByVal sPath As String) As Boolean
' Carico il file
If Not EgtOpenFile(sPath) Then
Return False
End If
' Recupero il gruppo di lavoro del file
Dim nMachGrpId As Integer = EgtGetFirstMachGroup()
If nMachGrpId = GDB_ID.NULL Then
Return False
End If
' Carico il gruppo e verifico che la sua macchina sia quella corrente
Dim sFileMachine As String = String.Empty
If Not EgtSetCurrMachGroup(nMachGrpId) Then
EgtGetInfo(nMachGrpId, "Machine", sFileMachine)
Else
EgtGetCurrMachineName(sFileMachine)
End If
' Verifico che la macchina del file sia quella impostata
If String.Compare(sFileMachine, m_sCurrMachine, True) <> 0 Then
' Emetto messaggio
Dim sOut As String = EgtMsg(90320) & " (" & sFileMachine & ")" ' Macchina diversa
m_MainWindow.m_CadCutPageUC.OutMessageLbl.Text = sOut
m_MainWindow.m_CadCutPageUC.OutMessageLbl.Background = Brushes.Tomato
m_MainWindow.m_CadCutPageUC.OutMessageLbl.Visibility = Windows.Visibility.Visible
EgtOutLog(sOut)
' Cancello il gruppo di lavoro
EgtRemoveMachGroup(nMachGrpId)
' Ne creo uno nuovo con la macchina corrente
If EgtAddMachGroup(MACH_GROUP, m_sCurrMachine) = GDB_ID.NULL Then
Return False
End If
' aggiorno eventuale identificativo grezzo
m_nRawId = EgtGetFirstRawPart()
' aggiorno spessore grezzo
m_dRawHeight = m_MainWindow.m_RawPartPage.GetRawHeight()
HeightTxBx.Text = DoubleToString(m_dRawHeight, 2)
' Dichiaro progetto non modificato
EgtResetModified()
Return True
End Function
Friend Function LoadFile(ByVal sPath As String) As Boolean
' Eseguo
If Not EgtOpenFile(sPath) Then
End If
' Imposto la tavola corrente
If Not EgtSetTable(MAIN_TAB) Then
Return False
End If
' attivo il gruppo di lavoro corrente
Dim nMachGrpId As Integer = EgtGetFirstMachGroup()
If Not EgtSetCurrMachGroup(nMachGrpId) Then
Return False
End If
EgtShowOnlyTable(True)
' Ripristino visualizzazione di eventuali pezzi in parcheggio
ShowParkedParts()
Return True
End Function
End If
End If
' Visualizzo solo la tavola della macchina
EgtShowOnlyTable(True)
' Ripristino visualizzazione di eventuali pezzi in parcheggio
ShowParkedParts()
Return True
End Function
Friend Function SaveProject() As Boolean
' Determino nome del progetto
m_nCurrProj = Math.Abs(m_nCurrProj)
Dim sPath As String = m_MainWindow.GetSaveDir() & "\" & m_nCurrProj.ToString("D4") & ".nge"
' Aggiorno file Ini
WritePrivateProfileString(S_GENERAL, K_LASTPROJ, m_nCurrProj.ToString(), m_MainWindow.GetIniFile())
' Rinomino eventuale fotografia
Dim nPhotoId As Integer = GetPhoto()
If nPhotoId <> GDB_ID.NULL Then
' Path originale
Dim sPhoto As String = String.Empty
EgtGetPhotoPath(nPhotoId, sPhoto)
' Nuova path
Dim sNewPhoto As String = Path.ChangeExtension(sPath, Path.GetExtension(sPhoto))
' Se diverse, eseguo copia
If Not String.Equals(sPhoto, sNewPhoto, StringComparison.InvariantCultureIgnoreCase) Then
Try
File.Copy(sPhoto, sNewPhoto, True)
Catch ex As Exception
Return False
End Try
End If
' Notifico a foto il cambio di path
EgtChangePhotoPath(nPhotoId, sNewPhoto)
End If
' Se assente, inserisco contrassegno di progetto OmagCut valido
Dim nMarkId As Integer = EgtGetFirstNameInGroup(GDB_ID.ROOT, NAME_PROJMARK)
If nMarkId = GDB_ID.NULL Then
nMarkId = EgtCreateGroup(GDB_ID.ROOT)
EgtSetName(nMarkId, NAME_PROJMARK)
EgtSetLevel(nMarkId, GDB_LV.SYSTEM)
End If
' Eseguo
If Not SaveFile(sPath) Then
Return False
End If
' Dichiaro progetto non modificato
EgtResetModified()
Return True
End Function
Friend Function SaveProject() As Boolean
' Determino nome del progetto
m_nCurrProj = Math.Abs(m_nCurrProj)
Dim sPath As String = m_MainWindow.GetSaveDir() & "\" & m_nCurrProj.ToString("D4") & ".nge"
' Aggiorno file Ini
WritePrivateProfileString(S_GENERAL, K_LASTPROJ, m_nCurrProj.ToString(), m_MainWindow.GetIniFile())
' Rinomino eventuale fotografia
Dim nPhotoId As Integer = GetPhoto()
If nPhotoId <> GDB_ID.NULL Then
' Path originale
Dim sPhoto As String = String.Empty
EgtGetPhotoPath(nPhotoId, sPhoto)
' Nuova path
Dim sNewPhoto As String = Path.ChangeExtension(sPath, Path.GetExtension(sPhoto))
' Se diverse, eseguo copia
If Not String.Equals(sPhoto, sNewPhoto, StringComparison.InvariantCultureIgnoreCase) Then
Try
File.Copy(sPhoto, sNewPhoto, True)
Catch ex As Exception
Return False
End Try
End If
' Notifico a foto il cambio di path
EgtChangePhotoPath(nPhotoId, sNewPhoto)
End If
' Se assente, inserisco contrassegno di progetto OmagCut valido
Dim nMarkId As Integer = EgtGetFirstNameInGroup(GDB_ID.ROOT, NAME_PROJMARK)
If nMarkId = GDB_ID.NULL Then
nMarkId = EgtCreateGroup(GDB_ID.ROOT)
EgtSetName(nMarkId, NAME_PROJMARK)
EgtSetLevel(nMarkId, GDB_LV.SYSTEM)
End If
' Eseguo
If Not SaveFile(sPath) Then
Return False
End If
' Dichiaro progetto non modificato
EgtResetModified()
Return True
End Function
Friend Function SaveFile(ByVal sPath As String) As Boolean
' Eseguo salvataggio
Dim bOk As Boolean = EgtSaveFile(sPath, NGE.CMPTEXT)
' Ripristino visualizzazione di eventuali pezzi in parcheggio (save li nasconde)
ShowParkedParts()
Return bOk
End Function
Friend Function SaveFile(ByVal sPath As String) As Boolean
' Eseguo salvataggio
Dim bOk As Boolean = EgtSaveFile(sPath, NGE.CMPTEXT)
' Ripristino visualizzazione di eventuali pezzi in parcheggio (save li nasconde)
ShowParkedParts()
Return bOk
End Function
Friend Function LoadPhoto(ByVal sPath As String) As Boolean
' Verifico esistenza file immagine
@@ -357,29 +393,29 @@ Public Class CurrentProjectPageUC
Return EgtAddPhoto(PHOTO_NAME, sPath, ptOri, ptCen, dMMxPixel, nPhGrpId, ptMin, ptMax) <> GDB_ID.NULL
End Function
Friend Function ShowPhoto(ByVal bShow As Boolean) As Boolean
' Recupero la foto
Dim nId As Integer = GetPhoto()
If nId = GDB_ID.NULL Then
Return False
End If
' Ne cambio lo stato
Return EgtSetStatus(nId, If(bShow, GDB_ST.ON_, GDB_ST.OFF))
End Function
Friend Function ShowPhoto(ByVal bShow As Boolean) As Boolean
' Recupero la foto
Dim nId As Integer = GetPhoto()
If nId = GDB_ID.NULL Then
Return False
End If
' Ne cambio lo stato
Return EgtSetStatus(nId, If(bShow, GDB_ST.ON_, GDB_ST.OFF))
End Function
Friend Function GetPhoto() As Integer
Dim nPhGrpId As Integer = EgtGetFirstNameInGroup(GDB_ID.ROOT, PHOTO_GRP)
Return EgtGetFirstNameInGroup(nPhGrpId, PHOTO_NAME)
End Function
Friend Function GetPhoto() As Integer
Dim nPhGrpId As Integer = EgtGetFirstNameInGroup(GDB_ID.ROOT, PHOTO_GRP)
Return EgtGetFirstNameInGroup(nPhGrpId, PHOTO_NAME)
End Function
Friend Function GetPhotoTextureRef(ByRef refTxr As Frame3d) As Boolean
' Recupero la foto
Dim nId As Integer = GetPhoto()
If nId = GDB_ID.NULL Then
Return False
End If
' Recupero il riferimento in globale
Return EgtGetTextureFrame(nId, GDB_ID.ROOT, refTxr)
End Function
Friend Function GetPhotoTextureRef(ByRef refTxr As Frame3d) As Boolean
' Recupero la foto
Dim nId As Integer = GetPhoto()
If nId = GDB_ID.NULL Then
Return False
End If
' Recupero il riferimento in globale
Return EgtGetTextureFrame(nId, GDB_ID.ROOT, refTxr)
End Function
End Class
My Project/AssemblyInfo.vb
+2 -2
View File
@@ -55,5 +55,5 @@ Imports System.Windows
' by using the '*' as shown below:
' <Assembly: AssemblyVersion("1.0.*")>
<Assembly: AssemblyVersion("1.6.11.8")>
<Assembly: AssemblyFileVersion("1.6.11.8")>
<Assembly: AssemblyVersion("1.6.11.9")>
<Assembly: AssemblyFileVersion("1.6.11.9")>
NestPageUC.xaml.vb
+32 -31
View File
@@ -272,25 +272,25 @@ Public Class NestPageUC
End Function
Private Sub InsertPartBtn_Click(sender As Object, e As RoutedEventArgs) Handles InsertPartBtn.Click
' Ciclo di inserimento in tavola dei pezzi selezionati
Dim nId As Integer = EgtGetFirstSelectedObj()
While nId <> GDB_ID.NULL
' Recupero successivo selezionato
Dim nNextId = EgtGetNextSelectedObj()
' Lo metto in tavola, se possibile
InsertOnePart(nId)
' Passo al successivo selezionato
nId = nNextId
End While
' Aggiorno flag selezionati
m_nPartPos = IIf(EgtGetSelectedObjCount() > 0, PART_POS.IN_TABLE, PART_POS.NONE_TABLE)
' Aggiorno vista
EgtZoom(ZM.ALL)
' Ciclo di inserimento in tavola dei pezzi selezionati
Dim nId As Integer = EgtGetFirstSelectedObj()
While nId <> GDB_ID.NULL
' Recupero successivo selezionato
Dim nNextId = EgtGetNextSelectedObj()
' Lo metto in tavola, se possibile
InsertOnePart(nId)
' Passo al successivo selezionato
nId = nNextId
End While
' Aggiorno flag selezionati
m_nPartPos = IIf(EgtGetSelectedObjCount() > 0, PART_POS.IN_TABLE, PART_POS.NONE_TABLE)
' Aggiorno vista
EgtZoom(ZM.ALL)
End Sub
Public Function InsertOnePart(ByVal nId As Integer) As Boolean
' Se pezzo in parcheggio, metto nella tavola
If EgtIsPart(nId) Then
' Se esiste grezzo e pezzo in parcheggio, lo metto nella tavola
If m_CurrProjPage.m_nRawId <> GDB_ID.NULL AndAlso EgtIsPart(nId) Then
Dim ptPmin, ptPmax As Point3d
EgtGetBBoxGlob(nId, BBFLAG, ptPmin, ptPmax)
ptPmin.z = m_ptRawMax.z
@@ -307,25 +307,26 @@ Public Class NestPageUC
End Function
Private Sub StorePartBtn_Click(sender As Object, e As RoutedEventArgs) Handles StorePartBtn.Click
' Ciclo di parcheggio dei pezzi selezionati
Dim nId As Integer = EgtGetFirstSelectedObj()
While nId <> GDB_ID.NULL
' Recupero indice del successivo
Dim nNextId = EgtGetNextSelectedObj()
' Metto in parcheggio, se in grezzo
StoreOnePart(nId)
' Passo al successivo selezionato
nId = nNextId
End While
' Imposto flag posizione pezzi su parcheggio
m_nPartPos = PART_POS.OUT_TABLE
' Aggiorno vista
EgtZoom(ZM.ALL)
' Ciclo di parcheggio dei pezzi selezionati
Dim nId As Integer = EgtGetFirstSelectedObj()
While nId <> GDB_ID.NULL
' Recupero indice del successivo
Dim nNextId = EgtGetNextSelectedObj()
' Metto in parcheggio, se in grezzo
StoreOnePart(nId)
' Passo al successivo selezionato
nId = nNextId
End While
' Imposto flag posizione pezzi su parcheggio
m_nPartPos = PART_POS.OUT_TABLE
' Aggiorno vista
EgtZoom(ZM.ALL)
End Sub
Public Function StoreOnePart(ByVal nId As Integer, Optional ByVal bForced As Boolean = False) As Boolean
' Se pezzo in grezzo, metto in parcheggio (sempre possibile)
If bForced OrElse EgtGetParent(nId) = m_CurrProjPage.m_nRawId Then
If bForced OrElse
(m_CurrProjPage.m_nRawId <> GDB_ID.NULL AndAlso EgtGetParent(nId) = m_CurrProjPage.m_nRawId) Then
EgtRemovePartFromRawPart(nId)
EgtSetStatus(nId, GDB_ST.ON_)
EgtPackPart(nId, -5000, -INFINITO, 1000, -3000, 20, False)
OpenPageUC.xaml.vb
+55 -57
View File
@@ -205,66 +205,64 @@ Public Class OpenPageUC
Return True
End Function
Private Function LoadCurrFile() As Boolean
' Pulisco il DB geometrico locale
Dim bOk As Boolean = EgtNewFile()
' Costruisco path completa del file
Dim sPath = IO.Path.Combine(m_sCurrDir, m_sCurrFile)
' Riconoscimento tipo
Dim nFileType As Integer = EgtGetFileType(sPath)
If nFileType = FT.NGE Then
' Carico Nge
bOk = bOk AndAlso EgtOpenFile(sPath)
' attivo il gruppo di lavoro corrente
Dim nMachGrpId As Integer = EgtGetFirstMachGroup()
If Not EgtSetCurrMachGroup(nMachGrpId) Then
Return False
End If
EgtShowOnlyTable(True)
Else
' Formato sconosciuto
bOk = False
End If
' Cerco contrassegno di progetto OmagCut
Dim nMarkId As Integer = EgtGetFirstNameInGroup(GDB_ID.ROOT, NAME_PROJMARK)
m_bFileOk = bOk And (nMarkId <> GDB_ID.NULL)
If m_bFileOk Then
MessageTxBx.Text = ""
MessageBrd.Background = Brushes.White
OkBtn.IsEnabled = True
Else
MessageTxBx.Text = EgtMsg(MSG_OPENPAGEUC + 1) 'Progetto non valido
MessageBrd.Background = Brushes.Tomato
OkBtn.IsEnabled = False
End If
' Eseguo zoom
OpenScene.ZoomAll()
Return bOk
End Function
Private Function LoadCurrFile() As Boolean
' Pulisco il DB geometrico locale
Dim bOk As Boolean = EgtNewFile()
' Costruisco path completa del file
Dim sPath = IO.Path.Combine(m_sCurrDir, m_sCurrFile)
' Riconoscimento tipo
Dim nFileType As Integer = EgtGetFileType(sPath)
If nFileType = FT.NGE Then
' Carico Nge
bOk = bOk AndAlso EgtOpenFile(sPath)
' attivo il gruppo di lavoro corrente
Dim nMachGrpId As Integer = EgtGetFirstMachGroup()
EgtSetCurrMachGroup(nMachGrpId)
EgtShowOnlyTable(True)
Else
' Formato sconosciuto
bOk = False
End If
' Cerco contrassegno di progetto OmagCut
Dim nMarkId As Integer = EgtGetFirstNameInGroup(GDB_ID.ROOT, NAME_PROJMARK)
m_bFileOk = bOk And (nMarkId <> GDB_ID.NULL)
If m_bFileOk Then
MessageTxBx.Text = ""
MessageBrd.Background = Brushes.White
OkBtn.IsEnabled = True
Else
MessageTxBx.Text = EgtMsg(MSG_OPENPAGEUC + 1) 'Progetto non valido
MessageBrd.Background = Brushes.Tomato
OkBtn.IsEnabled = False
End If
' Eseguo zoom
OpenScene.ZoomAll()
Return bOk
End Function
Private Sub OnMouseDownScene(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles OpenScene.OnMouseDownScene
End Sub
Private Sub OnMouseDownScene(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles OpenScene.OnMouseDownScene
End Sub
Private Sub ConfirmBtn_Click(sender As Object, e As RoutedEventArgs) Handles OkBtn.Click
' Istruzioni per chiudere OpenPageUC e aprire currentproject e cadcut page
m_MainWindow.MainWindowGrid.Children.Remove(m_MainWindow.m_OpenPage)
m_MainWindow.MainWindowGrid.Children.Add(m_MainWindow.m_CurrentProjectPageUC)
m_MainWindow.m_ActivePage = MainWindow.Pages.CadCut
' Lancio caricamento nuovo progetto corrente
If m_bFileOk Then
m_MainWindow.m_CadCutPageUC.PostLoad(m_sCurrDir & "\" & m_sCurrFile)
End If
End Sub
Private Sub ConfirmBtn_Click(sender As Object, e As RoutedEventArgs) Handles OkBtn.Click
' Lancio caricamento nuovo progetto corrente
If m_bFileOk Then
m_MainWindow.m_CadCutPageUC.PostLoad(m_sCurrDir & "\" & m_sCurrFile)
End If
' Istruzioni per chiudere OpenPageUC e aprire currentproject e cadcut page
m_MainWindow.MainWindowGrid.Children.Remove(m_MainWindow.m_OpenPage)
m_MainWindow.MainWindowGrid.Children.Add(m_MainWindow.m_CurrentProjectPageUC)
m_MainWindow.m_ActivePage = MainWindow.Pages.CadCut
End Sub
Private Sub ExitBtn_Click(sender As Object, e As RoutedEventArgs) Handles ExitBtn.Click
' Istruzioni per chiudere OpenPageUC e aprire currentproject e cadcut page
m_MainWindow.MainWindowGrid.Children.Remove(m_MainWindow.m_OpenPage)
m_MainWindow.MainWindowGrid.Children.Add(m_MainWindow.m_CurrentProjectPageUC)
m_MainWindow.m_ActivePage = MainWindow.Pages.CadCut
' Non modifico progetto corrente
End Sub
Private Sub ExitBtn_Click(sender As Object, e As RoutedEventArgs) Handles ExitBtn.Click
' Istruzioni per chiudere OpenPageUC e aprire currentproject e cadcut page
m_MainWindow.MainWindowGrid.Children.Remove(m_MainWindow.m_OpenPage)
m_MainWindow.MainWindowGrid.Children.Add(m_MainWindow.m_CurrentProjectPageUC)
m_MainWindow.m_ActivePage = MainWindow.Pages.CadCut
' Non modifico progetto corrente
End Sub
Private Sub OpenPage_Unloaded(sender As Object, e As RoutedEventArgs)
End Sub
Private Sub OpenPage_Unloaded(sender As Object, e As RoutedEventArgs)
End Sub
End Class
SimulationPageUC.xaml.vb
+23 -1
View File
@@ -34,7 +34,26 @@ Public Class SimulationPageUC
' Visualizzo tutta la macchina
EgtShowOnlyTable(False)
' Calcolo le lavorazioni
EgtLuaExecFile(m_MainWindow.GetCamAutoDir() & "\CamAuto.lua")
Dim sSawMch As String = String.Empty
GetPrivateProfileString(S_MACH, K_CURRMACHINING, "", sSawMch, m_MainWindow.GetIniFile())
EgtLuaCreateGlobTable("CAM")
EgtLuaSetGlobStringVar("CAM.SAWMCH", sSawMch)
Dim bOk As Boolean = EgtLuaExecFile(m_MainWindow.GetCamAutoDir() & "\CamAuto.lua")
Dim nErr As Integer = 999
EgtLuaGetGlobIntVar("CAM.ERR", nErr)
EgtLuaResetGlobVar("CAM")
If nErr <> 0 Then
bOk = False
EgtOutLog("Error in CamAuto : " & nErr.ToString())
End If
' Messaggio di errore
' Se errore in generazione, segnalo l'errore ed esco
If Not bOk Then
OutMessageLbl.Text = EgtMsg(90314) 'Errore nella generazione del programma CN
OutMessageLbl.Background = Brushes.Tomato
OutMessageLbl.Visibility = Windows.Visibility.Visible
EgtOutLog(OutMessageLbl.Text)
End If
' Salvo il progetto con le lavorazioni
Dim sMchPath As String = m_MainWindow.GetTempDir() & "\" & "MachProj.nge"
m_CurrProjPage.SaveFile(sMchPath)
@@ -117,14 +136,17 @@ Public Class SimulationPageUC
OutMessageLbl.Text = EgtMsg(90317) 'Extracorsa
OutMessageLbl.Background = Brushes.Tomato
OutMessageLbl.Visibility = Windows.Visibility.Visible
EgtOutLog(OutMessageLbl.Text)
Case MCH_SIM.DIR_ERR
OutMessageLbl.Text = EgtMsg(90318) 'Direzione utensile irraggiungibile
OutMessageLbl.Background = Brushes.Tomato
OutMessageLbl.Visibility = Windows.Visibility.Visible
EgtOutLog(OutMessageLbl.Text)
Case Else
OutMessageLbl.Text = EgtMsg(90319) 'Errore
OutMessageLbl.Background = Brushes.Tomato
OutMessageLbl.Visibility = Windows.Visibility.Visible
EgtOutLog(OutMessageLbl.Text)
End Select
End If
' Aggiorno visualizzazione