Dario Sassi
45948e7004
- aggiunta modalità trasmissione del programma CN a step per debug con Siemens One (in Ini di OmagCUT [General] StepByStepSend=1).
1505 lines
68 KiB
VB.net
1505 lines
68 KiB
VB.net
Imports System.IO
|
|
Imports System.Windows.Interop
|
|
Imports EgtUILib
|
|
Imports EgtWPFLib
|
|
Imports EgtWPFLib5
|
|
|
|
Public Class CurrentProjectPageUC
|
|
' Dichiarazione eventi
|
|
Friend Event OnMouseDownScene(sender As Object, e As System.Windows.Forms.MouseEventArgs)
|
|
Friend Event OnMouseDownScene_DoubleClick(sender As Object, e As System.Windows.Forms.MouseEventArgs)
|
|
Friend Event OnMouseMoveScene(sender As Object, e As System.Windows.Forms.MouseEventArgs)
|
|
Friend Event OnMouseUpScene(sender As Object, e As System.Windows.Forms.MouseEventArgs)
|
|
Friend Event OnKeyCancelDownScene(sender As Object, e As System.Windows.Forms.KeyEventArgs)
|
|
' Riferimento alla MainWindow
|
|
Private m_MainWindow As MainWindow = DirectCast(Application.Current.MainWindow, MainWindow)
|
|
' Dichiarazione delle Page UserControl
|
|
Friend m_SceneButtons As SceneButtonsUC
|
|
' Properties
|
|
Private m_bFirst As Boolean = True
|
|
' Dichiarazione Scene
|
|
Friend WithEvents CurrentProjectScene As New Scene
|
|
' Nella pagina Nest gestisco la dimensione della scena per visualizzare la lista dei parcheggi
|
|
Public CurrentProjectSceneHost As New System.Windows.Forms.Integration.WindowsFormsHost
|
|
' Identificativo progetto corrente
|
|
Private m_nCurrProj As Integer = 0
|
|
' Dati del grezzo
|
|
Friend m_nRawId As Integer = GDB_ID.NULL
|
|
Friend m_dRawHeight As Double
|
|
'' Flag per impostata per selezionare di una curva
|
|
'Friend m_bSelectCurv As Boolean = False
|
|
' Costanti tipo progetto
|
|
Friend Enum PRJ_TYPE As Integer
|
|
EMPTY = 0
|
|
FLATS = 1
|
|
FRAMES = 2
|
|
End Enum
|
|
' elenco dei file di recente apertura
|
|
Friend m_MruFiles As New MruList
|
|
|
|
Private Sub CurrentProjectPage_Initialized(sender As Object, e As EventArgs)
|
|
|
|
'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)
|
|
|
|
'Assegno SceneButtons alla pagina
|
|
UpperButtonGrid.Children.Add(m_SceneButtons)
|
|
|
|
'Assegnazione scena all'host e posizionamento nella PlacePageGrid
|
|
CurrentProjectSceneHost.Child = CurrentProjectScene
|
|
CurrentProjectSceneHost.SetValue(Grid.ColumnProperty, 0)
|
|
CurrentProjectSceneHost.SetValue(Grid.ColumnSpanProperty, 2)
|
|
' CurrentProjectSceneHost.SetValue(Grid.RowProperty, 1)
|
|
'Me.CurrentProjectPageGrid.Children.Add(CurrentProjectSceneHost)
|
|
Me.SceneHostGrid.Children.Add(CurrentProjectSceneHost)
|
|
|
|
'Imposto i messaggi letti dal file dei messaggi
|
|
MaterialTxBl.ToolTip = EgtMsg(90509) ' Material - Materiale
|
|
HeightTxBl.ToolTip = EgtMsg(90505) ' Height - Spessore
|
|
ToolTxBl.ToolTip = EgtMsg(90311) ' Tool - Utensile
|
|
MachiningTxBl.ToolTip = EgtMsg(90312) ' Machining - Lavorazione
|
|
|
|
End Sub
|
|
|
|
Private Sub CurrentProjectPage_Loaded(sender As Object, e As RoutedEventArgs)
|
|
' Impostazioni MruLists: carico la lista degli ultimi file caricati/aperti
|
|
m_MruFiles.Init(S_MRUFILES, 8)
|
|
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
|
|
CurrentProjectScene.SetViewBackground(GetBackTopColor(), GetBackBottomColor())
|
|
' 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 il colore di sfondo del progetto
|
|
'Dim BAckTopColor As New Color3d(192, 192, 192)
|
|
'GetPrivateProfileColor(S_SCENE, "BackTop", BAckTopColor, m_MainWindow.GetIniFile())
|
|
'Dim BackBottom As New Color3d(192, 192, 192)
|
|
'GetPrivateProfileColor(S_SCENE, "BackBottom", BackBottom, m_MainWindow.GetIniFile())
|
|
'CurrentProjectScene.SetViewBackground(BAckTopColor, BackBottom)
|
|
|
|
' 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
|
|
Dim bProd As Boolean = m_MainWindow.GetKeyOption(MainWindow.KEY_OPT.CUT_BASE) Or m_MainWindow.GetKeyOption(MainWindow.KEY_OPT.CUT_LIGHT)
|
|
If Not CurrentProjectScene.Init() Or Not bProd Then
|
|
' Rimuovo l'host della scena perchè altrimenti rimarrebbe il buco!!
|
|
Me.CurrentProjectPageGrid.Children.Remove(CurrentProjectSceneHost)
|
|
' Flag per riavvio programma
|
|
Dim bRestart As Boolean = False
|
|
' Errore! Programma senza licenza Esegui GetMachineId e invia i risultati al fornitore.
|
|
#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
|
|
End If
|
|
' visualizzazione avanzata dei triangoli costituenti le superfici
|
|
Dim bShowTriaAdv As Boolean = (GetPrivateProfileInt(S_SCENE, K_SHOWTRIAADV, 1, m_MainWindow.GetIniFile()) <> 0)
|
|
EgtSetShowTriaAdv(bShowTriaAdv)
|
|
' tipo visualizzazione per Zmap
|
|
Dim nShowZmap As Integer = GetPrivateProfileInt(S_SCENE, K_SHOWZMAP, 1, m_MainWindow.GetIniFile())
|
|
EgtSetShowZmap(nShowZmap, False)
|
|
' dimensione lineare max in pixel delle textures
|
|
Dim nTxrMaxLinPix As Integer = GetPrivateProfileInt(S_SCENE, K_TEXMAXLINPIX, 4096, m_MainWindow.GetIniFile())
|
|
EgtSetTextureMaxLinPixels(nTxrMaxLinPix)
|
|
' Recupero e imposto handle finestra principale
|
|
Dim hMainWnd As IntPtr = New WindowInteropHelper(Application.Current.MainWindow).Handle
|
|
EgtSetMainWindowHandle(hMainWnd)
|
|
' Inizializzo gestore lavorazioni
|
|
EgtInitMachMgr(m_MainWindow.GetMachinesRootDir(), m_MainWindow.GetToolMakersDir())
|
|
m_bFirst = False
|
|
Dim bOrtoGraphic As Boolean = (GetPrivateProfileInt(S_SCENE, K_ORTOGRAPHIC, 1, m_MainWindow.GetIniFile()) <> 0)
|
|
EgtSetCameraType(bOrtoGraphic, True)
|
|
' creo nuovo progetto
|
|
m_nCurrProj = GetPrivateProfileInt(S_GENERAL, K_LASTPROJ, 0, m_MainWindow.GetIniFile())
|
|
'NewProject()
|
|
|
|
' Nascondo progress e testo per fotografia
|
|
PhotoProgressStackPanel.Visibility = Windows.Visibility.Hidden
|
|
|
|
Else
|
|
EgtSetCurrentContext(CurrentProjectScene.GetCtx())
|
|
End If
|
|
|
|
' inibisco selezione diretta da Scene
|
|
CurrentProjectScene.SetStatusNull()
|
|
' Imposto dati progetto
|
|
If Not IsNothing(m_MainWindow.m_CurrentMachine.CurrMat) Then
|
|
MaterialTxBx.Text = m_MainWindow.m_CurrentMachine.CurrMat.sName
|
|
Else
|
|
MaterialTxBx.Text = "-----"
|
|
End If
|
|
|
|
' se macchina waterjet e senza una lama corrente impostata allora visualizzo info WJ
|
|
If m_MainWindow.m_CurrentMachine.bWaterJet And String.IsNullOrEmpty(m_MainWindow.m_CurrentMachine.sCurrSaw) Then
|
|
ToolTxBx.Text = m_MainWindow.m_CurrentMachine.sCurrWaterJet
|
|
MachiningTxBx.Text = m_MainWindow.m_CurrentMachine.sCurrWaterJetting
|
|
'& "-" & m_MainWindow.m_CurrentMachine.sCurrWaterJettingQuality
|
|
Else
|
|
ToolTxBx.Text = m_MainWindow.m_CurrentMachine.sCurrSaw
|
|
MachiningTxBx.Text = m_MainWindow.m_CurrentMachine.sCurrSawing
|
|
End If
|
|
|
|
End Sub
|
|
|
|
Public Sub StartProgram()
|
|
' leggo il tipo di avvio del programma: 0-New, 1-Last, 2-Open, 3-Window
|
|
Dim nStart As Integer = GetPrivateProfileInt(S_GENERAL, K_AUTOLOADLASTPROJ, 0, m_MainWindow.GetIniFile())
|
|
|
|
Dim MyStartLancherWD As New StartLauncherWD(m_MainWindow)
|
|
' mostro la finestra di avvio solo se configirato (= 3)
|
|
If nStart = MODE_LAUNCHER.ShowWindow Then
|
|
MyStartLancherWD.ShowDialog()
|
|
Else
|
|
MyStartLancherWD.CurrSelection = nStart
|
|
End If
|
|
|
|
If MyStartLancherWD.CurrSelection = MODE_LAUNCHER.LastProject Then
|
|
' Stampo il numero di progetto con 4 decimali: 12 -> "0012"
|
|
Dim sPath As String = m_MainWindow.GetSaveDir() & "\" & m_nCurrProj.ToString("D4") & ".nge"
|
|
' provo ad aprire l'ultimo progetto modificato
|
|
If Not LoadProject(sPath, False) Then
|
|
' altrimenti apro un nuovo progetto
|
|
NewProject()
|
|
Else
|
|
' salvo il nome del file caricato
|
|
m_MruFiles.Add(sPath)
|
|
End If
|
|
EgtResetModified()
|
|
|
|
ElseIf MyStartLancherWD.CurrSelection = MODE_LAUNCHER.NewProject Then
|
|
NewProject()
|
|
|
|
ElseIf MyStartLancherWD.CurrSelection = MODE_LAUNCHER.OpenFolder Then
|
|
NewProject()
|
|
EgtSetCurrentContext(CurrentProjectScene.GetCtx())
|
|
m_SceneButtons.MeasureBtn.IsChecked = False
|
|
' Cancello eventuali messaggi
|
|
ClearMessage()
|
|
' Imposto la pagina attualmente attiva come Previous
|
|
m_MainWindow.m_PrevActivePage = m_MainWindow.m_ActivePage
|
|
' Passo alla pagina di apertura con preview
|
|
m_MainWindow.MainWindowGrid.Children.Remove(m_MainWindow.m_CurrentProjectPageUC)
|
|
m_MainWindow.MainWindowGrid.Children.Add(m_MainWindow.m_OpenPage)
|
|
m_MainWindow.m_ActivePage = MainWindow.Pages.Open
|
|
' inizializzo gli oggetti della pagina (non passo dalla funzione Load!)
|
|
m_MainWindow.m_CadCutPageUC.m_ProjectMgr.SetReference()
|
|
|
|
' seleziono il file dalla lista della finestra (= 4)
|
|
ElseIf MyStartLancherWD.CurrSelection = MODE_LAUNCHER.SelectedProject Then
|
|
NewProject()
|
|
Dim sCurrDir As String = Path.GetDirectoryName(MyStartLancherWD.SelPath)
|
|
Dim sCurrFile As String = Path.GetFileName(MyStartLancherWD.SelPath)
|
|
|
|
If Not LoadProject(sCurrDir & "\" & sCurrFile) Then
|
|
NewProject()
|
|
m_MruFiles.Remove(sCurrDir & "\" & sCurrFile)
|
|
Else
|
|
' Verifico se file salvato con nome guardando il nome della cartella in cui si trova
|
|
Dim sSaveNameDir As String = String.Empty
|
|
GetPrivateProfileString(S_GENERAL, K_SAVENAMEDIR, "", sSaveNameDir, m_MainWindow.GetIniFile())
|
|
If sCurrDir = sSaveNameDir Then
|
|
WritePrivateProfileString(S_GENERAL, K_LASTNAMEPROJ, sCurrFile.Substring(0, sCurrFile.Length - 4), m_MainWindow.GetIniFile())
|
|
' Salvo equivalente con indice
|
|
SetNextProjectIndex()
|
|
SaveProject()
|
|
Else
|
|
WritePrivateProfileString(S_GENERAL, K_LASTNAMEPROJ, String.Empty, m_MainWindow.GetIniFile())
|
|
End If
|
|
' Salvo path di carico del progetto
|
|
If sCurrDir <> m_MainWindow.GetSaveDir() And sCurrDir <> sSaveNameDir Then
|
|
SetLoadPath(sCurrDir & "\" & sCurrFile)
|
|
End If
|
|
m_MruFiles.Add(sCurrDir & "\" & sCurrFile)
|
|
End If
|
|
End If
|
|
|
|
' se apro la finestra "OpenFolder" l'assegnazione dei Children è fatta direttamente nella classe ProjectMgrUC
|
|
If MyStartLancherWD.CurrSelection <> MODE_LAUNCHER.OpenFolder Then
|
|
' Carico sottopagina opportuna
|
|
If GetProjectType() <> PRJ_TYPE.FRAMES And Not m_MainWindow.m_OnlyFrame Then
|
|
CurrentProjectPageGrid.Children.Add(m_MainWindow.m_CadCutPageUC)
|
|
m_MainWindow.m_ActivePage = MainWindow.Pages.CadCut
|
|
m_MainWindow.CadCutBtn.IsChecked = True
|
|
Else
|
|
CurrentProjectPageGrid.Children.Add(m_MainWindow.m_FrameCutPageUC)
|
|
m_MainWindow.m_ActivePage = MainWindow.Pages.FrameCut
|
|
m_MainWindow.FrameCutBtn.IsChecked = True
|
|
End If
|
|
End If
|
|
|
|
|
|
End Sub
|
|
|
|
' questo metodo è direttamente richiamato in caso di selezione della regione sinistra della pagina
|
|
Private Sub ChooseMachining() Handles CurrProjGrid.MouseDown
|
|
' Apro pagina di selezione della lavorazione prima di chiudere il grezzo
|
|
Dim m_ChooseMachiningPage = New ChooseMachining(m_MainWindow)
|
|
' apro la finestra per la selezione delle lavorazioni
|
|
m_ChooseMachiningPage.ShowDialog()
|
|
' se seleziono "Ok" allora resetto tutte le lavorazioni del progetto
|
|
If m_ChooseMachiningPage.DialogResult Then
|
|
EgtSetCurrentContext(CurrentProjectScene.GetCtx())
|
|
' Cancello eventuali messaggi
|
|
ClearMessage()
|
|
' Se è stata modificata l'uso della lama inclinata allora aggiorno anche questa lavorazione
|
|
If m_MainWindow.m_CurrentMachine.MountedToolConfig <> CurrentMachine.MountedToolConfigs.TOOLCHANGERWITHSAW Then
|
|
' assegno la lavorazione corrente per i tagli di lama inclinati (solo se specificato nella ComboBox della ChooseMachinig)
|
|
RestoreDef_Machinig(True)
|
|
End If
|
|
' Ricalcolo tutte le lavorazioni
|
|
Dim nWarn As Integer = 0
|
|
ResetAllMachinings(nWarn)
|
|
If nWarn = 1 Then SetWarningMessage(EgtMsg(90351)) ' Lama troppo grande per utilizzo ventosa
|
|
' Aggiorno visualizzazione
|
|
EgtDraw()
|
|
End If
|
|
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_DoubleClick(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles CurrentProjectScene.MouseDoubleClick
|
|
RaiseEvent OnMouseDownScene_DoubleClick(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 OnShowDistanceVector(sender As Object, vtDist As Vector3d) Handles CurrentProjectScene.OnShowDistanceVector
|
|
SetInfoMessage(DistToString(vtDist))
|
|
End Sub
|
|
|
|
Private Sub OnMyKeyCancelDownScene(sender As Object, e As System.Windows.Forms.KeyEventArgs) Handles CurrentProjectScene.KeyDown
|
|
RaiseEvent OnKeyCancelDownScene(sender, e)
|
|
End Sub
|
|
|
|
' Gestione progetto
|
|
|
|
Friend 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
|
|
|
|
' apri nuovo progetto
|
|
Friend Function NewProject(Optional nTabInd As Integer = 1,
|
|
Optional bRetainParkedParts As Boolean = False) As Boolean
|
|
' Salvo l'area totale dei pezzi
|
|
Dim dTotArea As Double = 0
|
|
' Se richiesto, conservo eventuali pezzi parcheggiati del progetto corrente
|
|
Dim sTmpFile As String = String.Empty
|
|
If bRetainParkedParts Then
|
|
' Salvo l'Area totale dei pezzi
|
|
dTotArea = GetTotalArea()
|
|
' Cancello i pezzi lavorati (nella lastra)
|
|
Dim nMGrpId As Integer = EgtGetFirstRawPart()
|
|
Dim nPartId As Integer = EgtGetFirstPartInRawPart(nMGrpId)
|
|
While nPartId <> GDB_ID.NULL
|
|
EgtRemovePartFromRawPart(nPartId)
|
|
EgtErase(nPartId)
|
|
nPartId = EgtGetFirstPartInRawPart(nMGrpId)
|
|
End While
|
|
' Cancello il gruppo di lavoro
|
|
EgtRemoveMachGroup(EgtGetCurrMachGroup())
|
|
' Cancello l'eventuale gruppo delle foto
|
|
EgtErase(EgtGetFirstNameInGroup(GDB_ID.ROOT, PHOTO_GRP))
|
|
' Cancello il gruppo contrassegno di progetto OmagCut
|
|
EgtErase(EgtGetFirstNameInGroup(GDB_ID.ROOT, NAME_PROJMARK))
|
|
' Esporto i pezzi in un file temporaneo
|
|
sTmpFile = m_MainWindow.GetTempDir() & "\FlatParts.Nge"
|
|
If Not EgtSaveFile(sTmpFile, NGE.BIN) Then sTmpFile = String.Empty
|
|
End If
|
|
' Imposto nuovo indice di progetto
|
|
SetNextProjectIndex()
|
|
' Imposto il nuovo progetto
|
|
EgtOutLog("NewProject (" & m_nCurrProj.ToString() & ")")
|
|
EgtNewFile()
|
|
' Recupero i pezzi parcheggiati precedentemente salvati
|
|
If Not String.IsNullOrWhiteSpace(sTmpFile) Then
|
|
' Carico i pezzi
|
|
EgtOpenFile(sTmpFile)
|
|
' Cancello il file
|
|
My.Computer.FileSystem.DeleteFile(sTmpFile)
|
|
End If
|
|
' Inserisco contrassegno di progetto OmagCut valido
|
|
AddProjectMark()
|
|
' Creo un gruppo di lavoro e carico la macchina corrente
|
|
If EgtAddMachGroup(MACH_GROUP, m_MainWindow.GetCurrMachine()) = GDB_ID.NULL Then Return False
|
|
' Imposto la tavola corrente
|
|
If Not EgtSetTable(GetTableName(nTabInd)) Then Return False
|
|
EgtShowOnlyTable(True)
|
|
' Aggiungo eventuale sovratavola
|
|
AddAdditionalTable()
|
|
' Reset grezzo
|
|
m_nRawId = GDB_ID.NULL
|
|
m_MainWindow.m_CadCutPageUC.m_NestPage.CalcRawPart()
|
|
m_dRawHeight = 0
|
|
UpdateHeightTxBx()
|
|
' prima di parcheggiare svuoto dei pezzi in parcheggio sia vuota
|
|
m_MainWindow.m_CadCutPageUC.m_NestPage.ResetListOfGroupInPark()
|
|
' Parcheggio correttamente i pezzi precedentemente salvati
|
|
Dim nIdList As New List(Of Integer)
|
|
Dim nStatList As New List(Of Integer)
|
|
Dim nId2 As Integer = EgtGetFirstPart()
|
|
While nId2 <> GDB_ID.NULL
|
|
' Forzo lo stato per avere il giusto calcolo delle posizioni per evitare sovrapposizioni
|
|
EgtSetStatus(nId2, GDB_ST.ON_)
|
|
' Inserisco correttamente in parcheggio
|
|
m_MainWindow.m_CadCutPageUC.m_NestPage.StoreOnePart(nId2, True)
|
|
' Aggiorno lo stato di visualizzazione
|
|
Dim nInfoStatus As Integer = 1
|
|
' Salvo lo stato (per gestire la navigazione)
|
|
EgtGetInfo(nId2, INFO_PARKSTATUS, nInfoStatus)
|
|
' Salvo l'Id e lo stato da impostare successivamente al posizionamento
|
|
nIdList.Add(nId2)
|
|
nStatList.Add(nInfoStatus)
|
|
' Notifica a WeinMatching per modifica Id
|
|
VeinMatching.UpdatePart(nId2)
|
|
' Passo al pezzo successivo
|
|
nId2 = EgtGetNextPart(nId2)
|
|
End While
|
|
For IndIndex As Integer = 0 To nIdList.Count - 1
|
|
EgtSetStatus(nIdList(IndIndex), nStatList(IndIndex))
|
|
Next
|
|
' Aggiorno Aree totale e da lavorare dei pezzi
|
|
SetTotalArea(dTotArea)
|
|
UpdateToProduceArea()
|
|
ShowAreas()
|
|
' Salvo info di C home
|
|
Dim dCHome As Double
|
|
EgtGetAxisHomePos("C", dCHome)
|
|
EgtSetInfo(EgtGetFirstNameInGroup(GDB_ID.ROOT, NAME_PROJMARK), INFO_CAXESHOME, DoubleToString(dCHome, 0))
|
|
EgtZoom(ZM.ALL)
|
|
' Dichiaro progetto non modificato
|
|
EgtResetModified()
|
|
Return True
|
|
End Function
|
|
|
|
Friend Function AdjustAdditionalTable(Optional bForced As Boolean = False) As Boolean
|
|
' Recupero altezza sottotavola corrente
|
|
Dim nFixtId As Integer = EgtGetFirstNameInGroup(EgtGetFirstMachGroup(), MACH_FIXT_GROUP)
|
|
Dim nAddTabId As Integer = EgtGetFirstNameInGroup(nFixtId, MACH_ADD_TABLE)
|
|
Dim dCurrAddTab As Double = 0
|
|
If nAddTabId <> GDB_ID.NULL And Not EgtGetInfo(nAddTabId, KEY_ADD_TABLE, dCurrAddTab) Then
|
|
Dim b3AddTab As New BBox3d
|
|
EgtGetBBoxGlob(nAddTabId, GDB_BB.STANDARD, b3AddTab)
|
|
dCurrAddTab = b3AddTab.DimZ()
|
|
End If
|
|
' Se valore cambiato, aggiorno...
|
|
Dim dDeltaZ As Double = m_MainWindow.m_CurrentMachine.dAdditionalTable - dCurrAddTab
|
|
Dim bChanged As Boolean = (Math.Abs(dDeltaZ) > EPS_SMALL)
|
|
If bChanged Or bForced Then
|
|
Dim bOldEnMod As Boolean = EgtGetEnableModified()
|
|
If Not bChanged AndAlso bOldEnMod Then EgtDisableModified()
|
|
AddAdditionalTable()
|
|
UpdateAllRawsZ(dDeltaZ)
|
|
If GetPhoto() <> GDB_ID.NULL Then
|
|
UpdatePhoto()
|
|
UpdateContour()
|
|
If EgtGetRawPartCount() > 0 Then
|
|
ShowPhoto(False)
|
|
Dim nRawGrpId As Integer = EgtGetFirstRawPart()
|
|
While nRawGrpId <> GDB_ID.NULL
|
|
Dim nRawSolidId As Integer = EgtGetFirstNameInGroup(nRawGrpId, NAME_RAW_SOLID)
|
|
If nRawSolidId <> GDB_ID.NULL Then EgtSetTextureName(nRawSolidId, PHOTO_NAME)
|
|
nRawGrpId = EgtGetNextRawPart(nRawGrpId)
|
|
End While
|
|
End If
|
|
End If
|
|
If Not bChanged AndAlso bOldEnMod Then EgtEnableModified()
|
|
End If
|
|
Return True
|
|
End Function
|
|
|
|
Friend Function AddAdditionalTable() As Boolean
|
|
' Gruppo dei sottopezzi
|
|
Dim nFixtId As Integer = EgtGetFirstNameInGroup(EgtGetFirstMachGroup(), MACH_FIXT_GROUP)
|
|
' Elimino eventuale vecchia tavola dal gruppo dei bloccaggi
|
|
EgtErase(EgtGetFirstNameInGroup(nFixtId, MACH_ADD_TABLE))
|
|
' Altezza eventuale tavola aggiuntiva
|
|
Dim dAddTable As Double = m_MainWindow.m_CurrentMachine.dAdditionalTable
|
|
' Se non richiesta sovratavola, non c'è altro da fare ed esco
|
|
If dAddTable < 10 * EPS_SMALL Then Return True
|
|
' Recupero box tavola
|
|
Dim ptMin, ptMax As Point3d
|
|
EgtGetTableArea(1, ptMin, ptMax)
|
|
' Nuova geometria
|
|
Dim nAddTabId As Integer = GDB_ID.NULL
|
|
' Se esiste geometria di riferimento
|
|
Dim sNameTable As String = MAIN_TAB
|
|
EgtGetTableName(sNameTable)
|
|
Dim nRefAddTabId = EgtGetFirstNameInGroup(EgtGetFirstNameInGroup(EgtGetTableId(sNameTable), "SOLID"), MACH_ADD_TABLE)
|
|
If nRefAddTabId <> GDB_ID.NULL Then
|
|
nAddTabId = EgtCopyGlob(nRefAddTabId, nFixtId)
|
|
EgtSetStatus(nAddTabId, GDB_ST.ON_)
|
|
EgtScale(nAddTabId, New Frame3d(ptMin), 1, 1, dAddTable / 10)
|
|
' altrimenti la creo
|
|
Else
|
|
' Aggiungo sovratavola nel gruppo dei bloccaggi
|
|
ptMax.z -= DELTAZ_ADDTAB
|
|
ptMin.z = ptMax.z
|
|
ptMax.z += dAddTable
|
|
nAddTabId = EgtCreateSurfTmBBox(nFixtId, ptMin, ptMax, GDB_RT.GLOB)
|
|
End If
|
|
' Sistemazioni finali
|
|
If nAddTabId = GDB_ID.NULL Then Return False
|
|
EgtSetName(nAddTabId, MACH_ADD_TABLE)
|
|
If nRefAddTabId = GDB_ID.NULL Then EgtSetColor(nAddTabId, New Color3d(150, 75, 0, 100), True)
|
|
EgtSetInfo(nAddTabId, KEY_ADD_TABLE, dAddTable)
|
|
Return True
|
|
End Function
|
|
|
|
' carica ultimo progetto
|
|
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()
|
|
' Carico il file del progetto
|
|
EgtOutLog("LoadProject : " & sPath & " (" & m_nCurrProj.ToString() & ")")
|
|
If Not LoadFile(sPath) Then
|
|
Return False
|
|
End If
|
|
' aggiorno grezzo (è il primo con fase 1)
|
|
m_nRawId = EgtGetFirstRawPart()
|
|
While m_nRawId <> GDB_ID.NULL And Not EgtVerifyRawPartPhase(m_nRawId, 1)
|
|
m_nRawId = EgtGetNextRawPart(m_nRawId)
|
|
End While
|
|
m_MainWindow.m_CadCutPageUC.m_NestPage.CalcRawPart()
|
|
' aggiorno spessore grezzo
|
|
m_dRawHeight = GetRawHeight()
|
|
UpdateHeightTxBx()
|
|
' aggiorno materiale
|
|
m_MainWindow.m_CurrentMachine.SetCurrMatByName(GetProjectMaterial())
|
|
' recupero Id del gruppo "OmagCUT"
|
|
Dim nProjMarkId As Integer = EgtGetFirstNameInGroup(GDB_ID.ROOT, NAME_PROJMARK)
|
|
' aggiorno altezza sovaratavola
|
|
If GetPrivateProfileInt(S_GENERAL, K_ADD_TAB_BY_PROJ, 0, m_sIniFile) = 1 Then
|
|
' leggo il valore OrigAdditionalTable
|
|
Dim dValue As Double = m_MainWindow.m_CurrentMachine.dAdditionalTable
|
|
Dim sKey As String = K_ADDITIONALTABLE
|
|
Select Case GetCurrentTable()
|
|
Case 4
|
|
sKey = K_TAB4_ADDITIONALTABLE
|
|
Case 3
|
|
sKey = K_TAB3_ADDITIONALTABLE
|
|
Case 2
|
|
sKey = K_TAB2_ADDITIONALTABLE
|
|
End Select
|
|
EgtGetInfo(nProjMarkId, sKey, dValue)
|
|
m_MainWindow.m_CurrentMachine.dAdditionalTable = dValue
|
|
End If
|
|
' Forzo visualizzazione eventuali dati su aree
|
|
SetAreasStatus(True)
|
|
' Recupero info C_Home corrente
|
|
Dim dCHomeCurrMach As Double
|
|
EgtGetAxisHomePos("C", dCHomeCurrMach)
|
|
' Verifico C_Home del progetto
|
|
Dim dCHomeCurrproj As Double
|
|
If EgtGetInfo(nProjMarkId, INFO_CAXESHOME, dCHomeCurrproj) Then
|
|
' Recupero tipo di ventose usate
|
|
Dim nVacType As Integer = 0
|
|
EgtGetInfo(EgtGetHeadId("H4"), KEY_VAC_TYPE, nVacType)
|
|
' Se ventose di lato alla testa e C_Home diverso, registro un problema
|
|
If nVacType = 2 And Math.Abs(dCHomeCurrproj - dCHomeCurrMach) > EPS_ANG_SMALL Then
|
|
EgtOutLog(" WARNING -> C axes home project is different from current machine, delta ang C home:" & DoubleToString(dCHomeCurrproj - dCHomeCurrMach, 2))
|
|
End If
|
|
Else
|
|
EgtSetInfo(nProjMarkId, INFO_CAXESHOME, DoubleToString(dCHomeCurrMach, 0))
|
|
End If
|
|
' Dichiaro progetto non modificato
|
|
EgtResetModified()
|
|
Return True
|
|
End Function
|
|
|
|
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
|
|
' Se la macchina del file è quella impostata
|
|
If String.Compare(sFileMachine, m_MainWindow.GetCurrMachine(), True) = 0 Then
|
|
AdjustAdditionalTable(True)
|
|
' altrimenti avverto, porto i pezzi in parcheggio e cancello il grezzo
|
|
Else
|
|
' Emetto messaggio
|
|
Dim sOut As String = EgtMsg(90320) & " (" & sFileMachine & ")" ' Macchina diversa
|
|
SetErrorMessage(sOut)
|
|
' Cancello il gruppo di lavoro
|
|
EgtRemoveMachGroup(nMachGrpId)
|
|
' Cancello eventuale foto
|
|
EgtErase(GetPhoto())
|
|
' Cancello eventuali preview rimaste nei pezzi
|
|
' (cancellare tramite cancellazione lavorazioni può non essere sufficiente)
|
|
RemovePreviewFromParts()
|
|
' Altre sistemazioni
|
|
Dim nPartId As Integer = EgtGetFirstPart()
|
|
While nPartId <> GDB_ID.NULL
|
|
' Elimino eventuali modifiche per lati esterni inclinati e/o offsettati
|
|
EgtCalcFlatPartUpRegion(nPartId, False)
|
|
EgtCalcFlatPartDownRegion(nPartId, 0)
|
|
' Eventuale cancellazione solido per taglio da sotto
|
|
EraseSolidForDrip(nPartId)
|
|
nPartId = EgtGetNextPart(nPartId)
|
|
End While
|
|
' Sistemo posizione di parcheggio dei pezzi
|
|
nPartId = EgtGetFirstPart()
|
|
While nPartId <> GDB_ID.NULL
|
|
m_MainWindow.m_CadCutPageUC.m_NestPage.PackPartInStore(nPartId)
|
|
nPartId = EgtGetNextPart(nPartId)
|
|
End While
|
|
' Creo un nuovo gruppo di lavoro con la macchina corrente
|
|
If EgtAddMachGroup(MACH_GROUP, m_MainWindow.GetCurrMachine()) = GDB_ID.NULL Then Return False
|
|
' Imposto la tavola corrente
|
|
If Not EgtSetTable(MAIN_TAB) Then Return False
|
|
' Aggiungo eventuale sovratavola
|
|
AddAdditionalTable()
|
|
' Reset vari
|
|
m_MainWindow.m_CurrentProjectPageUC.ResetOrderMachiningFlag()
|
|
m_MainWindow.m_CurrentProjectPageUC.ResetProjectNcRestart()
|
|
End If
|
|
' Visualizzo solo la tavola della macchina
|
|
EgtShowOnlyTable(True)
|
|
' Nascondo tutte le lavorazioni
|
|
HideAllMachinings()
|
|
' Ripristino visualizzazione di eventuali pezzi in parcheggio
|
|
ShowParkedParts()
|
|
Return True
|
|
End Function
|
|
|
|
' salva progetto
|
|
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 FileNotFoundException
|
|
' non è un problema
|
|
Catch ex As DirectoryNotFoundException
|
|
' non è un problema
|
|
Catch ex As Exception
|
|
Return False
|
|
End Try
|
|
End If
|
|
' Notifico a foto il cambio di path
|
|
EgtChangePhotoPath(nPhotoId, sNewPhoto)
|
|
' Altrimenti cancello eventuali file di foto associabili al progetto
|
|
Else
|
|
Dim sPhoto1 As String = Path.ChangeExtension(sPath, "jpg")
|
|
Dim sPhoto2 As String = Path.ChangeExtension(sPath, "png")
|
|
Dim sPhoto3 As String = Path.ChangeExtension(sPath, "bmp")
|
|
Try
|
|
If My.Computer.FileSystem.FileExists(sPhoto1) Then
|
|
My.Computer.FileSystem.DeleteFile(sPhoto1)
|
|
End If
|
|
If My.Computer.FileSystem.FileExists(sPhoto2) Then
|
|
My.Computer.FileSystem.DeleteFile(sPhoto2)
|
|
End If
|
|
If My.Computer.FileSystem.FileExists(sPhoto3) Then
|
|
My.Computer.FileSystem.DeleteFile(sPhoto3)
|
|
End If
|
|
Catch ex As Exception
|
|
End Try
|
|
End If
|
|
' Se assente, inserisco contrassegno di progetto OmagCut valido
|
|
Dim nMarkId As Integer = AddProjectMark()
|
|
' Assegno nome, indice di progetto e materiale
|
|
SetProjectName( nMarkId)
|
|
SetProjectIndex( nMarkId)
|
|
SetProjectMaterial( nMarkId)
|
|
' Eseguo
|
|
If Not SaveFile(sPath) Then Return False
|
|
' aggiungo il file all'elenco dei file recenti
|
|
m_MruFiles.Add(sPath)
|
|
' Dichiaro progetto non modificato
|
|
EgtResetModified()
|
|
' Salvo eventuale VeinMatching
|
|
VeinMatching.Save(m_MainWindow.GetVeinMatchingDir() & "\Inlay.vme")
|
|
Return True
|
|
End Function
|
|
|
|
Friend Function SaveFile(ByVal sPath As String, Optional bShowParkedParts As Boolean = True) As Boolean
|
|
' Eseguo salvataggio
|
|
Dim bOk As Boolean = EgtSaveFile(sPath, NGE.CMPTEXT)
|
|
' Nascondo le lavorazioni
|
|
HideAllMachinings()
|
|
' Se richiesto, ripristino visualizzazione di eventuali pezzi in parcheggio (save li nasconde)
|
|
If bShowParkedParts Then
|
|
ShowParkedParts()
|
|
End If
|
|
Return bOk
|
|
End Function
|
|
|
|
Friend Function SaveNamedProject() As Boolean
|
|
' Determino nome del progetto
|
|
Dim CurrProjName As String = String.Empty
|
|
GetPrivateProfileString(S_GENERAL, K_LASTNAMEPROJ, "", CurrProjName, m_MainWindow.GetIniFile())
|
|
' Se nome vuoto, non salvo
|
|
If String.IsNullOrEmpty(CurrProjName) Then Return False
|
|
Dim sPath As String = m_MainWindow.GetNamedSaveDir() & "\" & CurrProjName & ".nge"
|
|
' 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
|
|
|
|
'--------------------------------------------------------------------------------
|
|
If m_MainWindow.EnabledDxfPark() Then
|
|
' Gestione visualizzazione lista pezzi in parcheggio
|
|
Dim sNewFileName As String = SelParkIndWD.GetPathCurrProj()
|
|
SelParkIndWD.CopyImgSvg(sPath)
|
|
SelParkIndWD.sActualProj = String.Empty
|
|
SelParkIndWD.CopyImgSvg(sNewFileName)
|
|
End If
|
|
'--------------------------------------------------------------------------------
|
|
|
|
' Se assente, inserisco contrassegno di progetto OmagCut valido
|
|
Dim nMarkId As Integer = AddProjectMark()
|
|
' Assegno nome, indice di progetto e materiale
|
|
SetProjectName( nMarkId)
|
|
SetProjectIndex( nMarkId)
|
|
SetProjectMaterial( nMarkId)
|
|
' Eseguo
|
|
If Not SaveFile(sPath) Then Return False
|
|
' aggiungo il file all'elenco dei file recenti
|
|
m_MruFiles.Add(sPath)
|
|
' Dichiaro progetto non modificato
|
|
EgtResetModified()
|
|
Return True
|
|
End Function
|
|
|
|
Friend Function ExportProject(sPath As String) As Boolean
|
|
' Copio 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
|
|
AddProjectMark()
|
|
' Eseguo copia
|
|
Return SaveFile(sPath)
|
|
End Function
|
|
|
|
Friend Function GetCurrentProject() As Integer
|
|
Return m_nCurrProj
|
|
End Function
|
|
|
|
Friend Function GetCurrentProjectTitle() As String
|
|
Dim CurrProjName As String = ""
|
|
GetPrivateProfileString(S_GENERAL, K_LASTNAMEPROJ, "", CurrProjName, m_MainWindow.GetIniFile())
|
|
If String.IsNullOrWhiteSpace(CurrProjName) Then
|
|
CurrProjName = Math.Abs(m_nCurrProj).ToString("D4")
|
|
End If
|
|
Return CurrProjName
|
|
End Function
|
|
|
|
Friend Function GetCurrentProjectName() As String
|
|
Dim CurrProjName As String = String.Empty
|
|
GetPrivateProfileString(S_GENERAL, K_LASTNAMEPROJ, "", CurrProjName, m_MainWindow.GetIniFile())
|
|
If Not String.IsNullOrEmpty(CurrProjName) Then
|
|
CurrProjName &= ".nge (" & Math.Abs(m_nCurrProj).ToString("D4") & ")"
|
|
Else
|
|
CurrProjName = Math.Abs(m_nCurrProj).ToString("D4") & ".nge"
|
|
End If
|
|
Return CurrProjName
|
|
End Function
|
|
|
|
Private Function GetProjectType() As Integer
|
|
' Se non c'è grezzo, è vuoto
|
|
Dim nRawId As Integer = EgtGetFirstRawPart()
|
|
If nRawId = GDB_ID.NULL Then Return PRJ_TYPE.EMPTY
|
|
' Cerco un pezzo parcheggiato o nel grezzo
|
|
Dim nPartId As Integer = EgtGetFirstPart()
|
|
While nPartId <> GDB_ID.NULL
|
|
Dim sTemp As String = String.Empty
|
|
If Not EgtGetName(nPartId, sTemp) OrElse String.Compare(sTemp, NAME_COPYTEMPLATE, True) <> 0 Then Exit While
|
|
nPartId = EgtGetNextPart(nPartId)
|
|
End While
|
|
If nPartId = GDB_ID.NULL Then nPartId = EgtGetFirstPartInRawPart(nRawId)
|
|
' Se non ci sono pezzi, è vuoto
|
|
If nPartId = GDB_ID.NULL Then Return PRJ_TYPE.EMPTY
|
|
' Verifico il tipo di pezzo
|
|
Dim sName As String = String.Empty
|
|
If EgtGetName(nPartId, sName) AndAlso sName = NAME_FRAME Then
|
|
Return PRJ_TYPE.FRAMES
|
|
Else
|
|
Return PRJ_TYPE.FLATS
|
|
End If
|
|
End Function
|
|
|
|
Friend Function GetCurrentProjectType() As Integer
|
|
' Imposto contesto del progetto corrente
|
|
Dim nOldCtx As Integer = EgtGetCurrentContext()
|
|
Dim nNewCtx As Integer = CurrentProjectScene.GetCtx()
|
|
If nOldCtx <> nNewCtx Then EgtSetCurrentContext(nNewCtx)
|
|
' Recupero il tipo di progetto
|
|
Dim nPrjType As Integer = GetProjectType()
|
|
' Reimposto contesto originale
|
|
If nOldCtx <> nNewCtx Then EgtSetCurrentContext(nOldCtx)
|
|
' Restituisco il risultato
|
|
Return nPrjType
|
|
End Function
|
|
|
|
Friend Function RemovePreviewFromParts() As Boolean
|
|
' Processo i sottogruppi, se di livello System li rimuovo
|
|
Dim nGrpId As Integer = EgtGetFirstGroupInGroup(GDB_ID.ROOT)
|
|
While nGrpId <> GDB_ID.NULL
|
|
' Ciclo sui sottogruppi
|
|
Dim nSubId As Integer = EgtGetFirstGroupInGroup(nGrpId)
|
|
While nSubId <> GDB_ID.NULL
|
|
' Recupero il prossimo sottogruppo
|
|
Dim nNextSubId = EgtGetNextGroup(nSubId)
|
|
' Verifico il livello, eventuale cancellazione
|
|
Dim nLevel As Integer = GDB_LV.USER
|
|
EgtGetLevel(nSubId, nLevel)
|
|
If nLevel = GDB_LV.SYSTEM Then
|
|
EgtErase(nSubId)
|
|
End If
|
|
nSubId = nNextSubId
|
|
End While
|
|
' Passo al prossimo gruppo
|
|
nGrpId = EgtGetNextGroup(nGrpId)
|
|
End While
|
|
Return True
|
|
End Function
|
|
|
|
Friend Function AddProjectMark() As Integer
|
|
' Se assente, inserisco contrassegno di progetto OmagCut valido e imposto flag dei tagli ridotti
|
|
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
|
|
' Recupero flag di tagli ridotti e lo imposo o aggiorno nel progetto
|
|
Dim nReducedCut As Integer = GetPrivateProfileInt(S_MACH_NEST, K_MACH_REDUCEDCUT, 1, m_MainWindow.GetMachIniFile())
|
|
EgtSetInfo(nMarkId, INFO_REDUCEDCUT, nReducedCut, True)
|
|
Return nMarkId
|
|
End Function
|
|
|
|
Friend Function SetWashingFlag(bWash As Boolean) As Boolean
|
|
Dim nMarkId As Integer = AddProjectMark()
|
|
Return EgtSetInfo(nMarkId, INFO_WASHING, bWash)
|
|
End Function
|
|
|
|
Friend Function GetWashingFlag() As Boolean
|
|
Dim nMarkId As Integer = EgtGetFirstNameInGroup(GDB_ID.ROOT, NAME_PROJMARK)
|
|
Dim nFlag As Integer = 1
|
|
EgtGetInfo(nMarkId, INFO_WASHING, nFlag)
|
|
Return (nFlag <> 0)
|
|
End Function
|
|
|
|
Friend Function UpdateWashingFlag() As Boolean
|
|
Dim bCurrWash As Boolean =
|
|
(GetPrivateProfileInt(S_MACH_NEST, K_MACH_WASHING, 1, m_MainWindow.GetMachIniFile()) <> 0)
|
|
Dim bProjWash As Boolean = GetWashingFlag()
|
|
If bCurrWash <> bProjWash Then Return SetWashingFlag(bCurrWash)
|
|
Return True
|
|
End Function
|
|
|
|
Friend Function SetSideAngCutProbeFlag(bSacProbe As Boolean) As Boolean
|
|
Dim nMarkId As Integer = AddProjectMark()
|
|
If bSacProbe Then
|
|
Return EgtSetInfo(nMarkId, INFO_SACPROBE, True)
|
|
Else
|
|
Return EgtRemoveInfo(nMarkId, INFO_SACPROBE)
|
|
End If
|
|
End Function
|
|
|
|
Friend Function GetSideAngCutProbeFlag() As Boolean
|
|
Dim nMarkId As Integer = EgtGetFirstNameInGroup(GDB_ID.ROOT, NAME_PROJMARK)
|
|
Dim nFlag As Integer = 0
|
|
EgtGetInfo(nMarkId, INFO_SACPROBE, nFlag)
|
|
Return (nFlag <> 0)
|
|
End Function
|
|
|
|
Friend Function UpdateSideAngCutProbeFlag() As Boolean
|
|
Dim bCurrSacProbe As Boolean =
|
|
(GetPrivateProfileInt(S_MACH_NEST, K_MACH_SACPROBE, 0, m_MainWindow.GetMachIniFile()) <> 0) AndAlso m_MainWindow.m_CurrentMachine.IsRawProbingPossible()
|
|
Dim bProjSacProbe As Boolean = GetSideAngCutProbeFlag()
|
|
If bCurrSacProbe <> bProjSacProbe Then Return SetSideAngCutProbeFlag(bCurrSacProbe)
|
|
Return True
|
|
End Function
|
|
|
|
Friend Function SetOrderMachiningFlag() As Boolean
|
|
Dim nMarkId As Integer = AddProjectMark()
|
|
Return EgtSetInfo(nMarkId, INFO_MACHORDER, 1)
|
|
End Function
|
|
|
|
Friend Function ResetOrderMachiningFlag() As Boolean
|
|
Dim nMarkId As Integer = AddProjectMark()
|
|
Return EgtRemoveInfo(nMarkId, INFO_MACHORDER)
|
|
End Function
|
|
|
|
Friend Function GetOrderMachiningFlag() As Boolean
|
|
Dim nMarkId As Integer = EgtGetFirstNameInGroup(GDB_ID.ROOT, NAME_PROJMARK)
|
|
Dim nFlag As Integer = 0
|
|
EgtGetInfo(nMarkId, INFO_MACHORDER, nFlag)
|
|
Return (nFlag <> 0)
|
|
End Function
|
|
|
|
Friend Function SetProjectName( Optional nMarkId As Integer = GDB_ID.NULL) As Boolean
|
|
If nMarkId = GDB_ID.NULL Then nMarkId = AddProjectMark()
|
|
Dim sCurrProjName As String = String.Empty
|
|
GetPrivateProfileString(S_GENERAL, K_LASTNAMEPROJ, "", sCurrProjName, m_MainWindow.GetIniFile())
|
|
Return EgtSetInfo(nMarkId, INFO_PROJNAME, sCurrProjName, True)
|
|
End Function
|
|
|
|
Friend Function SetProjectIndex( Optional nMarkId As Integer = GDB_ID.NULL) As Boolean
|
|
If nMarkId = GDB_ID.NULL Then nMarkId = AddProjectMark()
|
|
Return EgtSetInfo(nMarkId, INFO_PROJINDEX, Math.Abs(m_nCurrProj), True)
|
|
End Function
|
|
|
|
Friend Function SetProjectOrder(sOrder As String) As Boolean
|
|
Dim nMarkId As Integer = AddProjectMark()
|
|
Return EgtSetInfo(nMarkId, INFO_PROJORD, sOrder)
|
|
End Function
|
|
|
|
Friend Function GetProjectOrder(ByRef sOrder As String) As Boolean
|
|
Dim nMarkId As Integer = AddProjectMark()
|
|
Return EgtGetInfo(nMarkId, INFO_PROJORD, sOrder)
|
|
End Function
|
|
|
|
Friend Function SetLastSlab() As Boolean
|
|
Dim nMarkId As Integer = AddProjectMark()
|
|
Return EgtSetInfo(nMarkId, INFO_LASTSLAB, True)
|
|
End Function
|
|
|
|
Friend Function GetLastSlab() As Boolean
|
|
Dim nMarkId As Integer = AddProjectMark()
|
|
Return EgtExistsInfo(nMarkId, INFO_LASTSLAB)
|
|
End Function
|
|
|
|
Friend Function ResetLastSlab() As Boolean
|
|
Dim nMarkId As Integer = AddProjectMark()
|
|
Return EgtRemoveInfo(nMarkId, INFO_LASTSLAB)
|
|
End Function
|
|
|
|
Friend Function SetProjectMaterial( Optional nMarkId As Integer = GDB_ID.NULL) As Boolean
|
|
If nMarkId = GDB_ID.NULL Then nMarkId = AddProjectMark()
|
|
If IsNothing(m_MainWindow.m_CurrentMachine.CurrMat) Then Return False
|
|
Return EgtSetInfo(nMarkId, INFO_PROJMAT, m_MainWindow.m_CurrentMachine.CurrMat.sName, True)
|
|
End Function
|
|
|
|
Friend Function GetProjectMaterial() As String
|
|
Dim nMarkId As Integer = AddProjectMark()
|
|
Dim sName As String = String.Empty
|
|
EgtGetInfo(nMarkId, INFO_PROJMAT, sName)
|
|
Return sName
|
|
End Function
|
|
|
|
Friend Function SetProjectNcProgSent(nNcProg As Integer) As Boolean
|
|
Dim nMarkId As Integer = AddProjectMark()
|
|
Return EgtSetInfo(nMarkId, INFO_NCPROGSENT, nNcProg)
|
|
End Function
|
|
|
|
Friend Function GetProjectNcProgSent() As Integer
|
|
Dim nMarkId As Integer = EgtGetFirstNameInGroup(GDB_ID.ROOT, NAME_PROJMARK)
|
|
Dim nNcSent As Integer = 0
|
|
EgtGetInfo(nMarkId, INFO_NCPROGSENT, nNcSent)
|
|
Return nNcSent
|
|
End Function
|
|
|
|
Friend Function SetProjectNcRestart(nRestartPhase As Integer) As Boolean
|
|
Dim nMarkId As Integer = AddProjectMark()
|
|
Return EgtSetInfo(nMarkId, INFO_NCRESTART, nRestartPhase)
|
|
End Function
|
|
|
|
Friend Function GetProjectNcRestart() As Integer
|
|
Dim nMarkId As Integer = EgtGetFirstNameInGroup(GDB_ID.ROOT, NAME_PROJMARK)
|
|
Dim nRestartPhase As Integer = 0
|
|
EgtGetInfo(nMarkId, INFO_NCRESTART, nRestartPhase)
|
|
Return nRestartPhase
|
|
End Function
|
|
|
|
Friend Function ResetProjectNcRestart() As Boolean
|
|
Dim nMarkId As Integer = AddProjectMark()
|
|
Return EgtRemoveInfo(nMarkId, INFO_NCRESTART)
|
|
End Function
|
|
|
|
Friend Function SetLoadPath(sPath As String) As Boolean
|
|
Dim nMarkId As Integer = AddProjectMark()
|
|
Return EgtSetInfo(nMarkId, INFO_LOADPATH, sPath)
|
|
End Function
|
|
|
|
Friend Sub UpdateHeightTxBx()
|
|
HeightTxBx.Text = LenToString(m_dRawHeight, 3)
|
|
End Sub
|
|
|
|
Friend Sub UpdateMachiningTxBx()
|
|
' se macchina waterjet e senza uscita lama allora visualizzo info WJ
|
|
If m_MainWindow.m_CurrentMachine.bWaterJet And Not m_MainWindow.m_CurrentMachine.ExistsSawHead() Then
|
|
MachiningTxBx.Text = m_MainWindow.m_CurrentMachine.sCurrWaterJetting
|
|
'& "-" & m_MainWindow.m_CurrentMachine.sCurrWaterJettingQuality
|
|
Else
|
|
MachiningTxBx.Text = m_MainWindow.m_CurrentMachine.sCurrSawing
|
|
End If
|
|
End Sub
|
|
|
|
' Gestione fotografia della lastra (compreso riconoscimento contorno)
|
|
|
|
Friend Function LoadPhoto(sPath As String) As Boolean
|
|
' Verifico esistenza file immagine
|
|
If Not File.Exists(sPath) Then Return False
|
|
' Leggo eventuale file dati aggiuntivi
|
|
Dim ptOri As New Point3d(0, 0, 0)
|
|
Dim ptCen As New Point3d(0, 0, INFINITO)
|
|
Dim dMMxPixel As Double = 1
|
|
ReadAuxData(sPath, ptOri, ptCen, dMMxPixel)
|
|
' Aggiungo eventuali offset
|
|
ptOri += m_MainWindow.m_CurrentMachine.PhotoOffset
|
|
ptCen += m_MainWindow.m_CurrentMachine.PhotoOffset
|
|
' Altezza eventuale tavola aggiuntiva
|
|
Dim dAddTable As Double = m_MainWindow.m_CurrentMachine.dAdditionalTable
|
|
' Aggiusto dati per spessore grezzo
|
|
If Math.Abs(m_dRawHeight + dAddTable) > EPS_SMALL Then
|
|
' Coefficiente di scalatura
|
|
Dim dFsca As Double = (ptCen.z - m_dRawHeight - dAddTable) / (ptCen.z - ptOri.z)
|
|
dMMxPixel *= dFsca
|
|
ptOri.x = ptCen.x + (ptOri.x - ptCen.x) * dFsca
|
|
ptOri.y = ptCen.y + (ptOri.y - ptCen.y) * dFsca
|
|
ptOri.z = m_dRawHeight + dAddTable
|
|
End If
|
|
' Recupero origine della tavola e porto i punti in globale
|
|
Dim ptTab As Point3d
|
|
If Not EgtGetTableRef(1, ptTab) Then Return False
|
|
ptOri.ToGlob(New Frame3d(ptTab))
|
|
ptCen.ToGlob(New Frame3d(ptTab))
|
|
' Recupero le dimensioni della tavola
|
|
Dim ptMin, ptMax As Point3d
|
|
If Not EgtGetTableArea(1, ptMin, ptMax) Then Return False
|
|
' Elimino eventuale precedente foto
|
|
Dim nOldPhotoId = GetPhoto()
|
|
If nOldPhotoId <> GDB_ID.NULL Then EgtErase(nOldPhotoId)
|
|
' Se non esiste il gruppo per le foto, lo creo
|
|
Dim nPhGrpId As Integer = EgtGetFirstNameInGroup(GDB_ID.ROOT, PHOTO_GRP)
|
|
If nPhGrpId = GDB_ID.NULL Then
|
|
nPhGrpId = EgtCreateGroup(GDB_ID.ROOT)
|
|
If nPhGrpId = GDB_ID.NULL Then Return False
|
|
EgtSetName(nPhGrpId, PHOTO_GRP)
|
|
End If
|
|
EgtSetLevel(nPhGrpId, GDB_LV.SYSTEM)
|
|
' Carico la fotografia
|
|
Return EgtAddPhoto(PHOTO_NAME, sPath, ptOri, ptCen, dMMxPixel, nPhGrpId, ptMin, ptMax) <> GDB_ID.NULL
|
|
End Function
|
|
|
|
Friend Function LoadContour(sPath As String) As Boolean
|
|
' Elimino eventuale vecchio contorno
|
|
RemoveContour()
|
|
' Verifico esistenza file contorno
|
|
If Not File.Exists(sPath) Then Return False
|
|
' Leggo eventuale file dati aggiuntivi
|
|
Dim ptOri As New Point3d(0, 0, 0)
|
|
Dim ptCen As New Point3d(0, 0, INFINITO)
|
|
Dim dMMxPixel As Double = 1
|
|
ReadAuxData(sPath, ptOri, ptCen, dMMxPixel)
|
|
' Aggiungo eventuali offset
|
|
ptOri += m_MainWindow.m_CurrentMachine.PhotoOffset
|
|
ptCen += m_MainWindow.m_CurrentMachine.PhotoOffset
|
|
' Recupero dimensione della immagine da cui è stata derivata la fotografia
|
|
Dim nPixelX As Integer = 0
|
|
Dim nPixelY As Integer = 0
|
|
If Not EgtGetPhotoImagePixels(GetPhoto(), nPixelX, nPixelY) Then Return False
|
|
' Altezza eventuale tavola aggiuntiva
|
|
Dim dAddTable As Double = m_MainWindow.m_CurrentMachine.dAdditionalTable
|
|
' Aggiusto dati per spessore grezzo
|
|
If Math.Abs(m_dRawHeight + dAddTable) > EPS_SMALL Then
|
|
' Coefficiente di scalatura
|
|
Dim dFsca As Double = (ptCen.z - m_dRawHeight - dAddTable) / (ptCen.z - ptOri.z)
|
|
dMMxPixel *= dFsca
|
|
ptOri.x = ptCen.x + (ptOri.x - ptCen.x) * dFsca
|
|
ptOri.y = ptCen.y + (ptOri.y - ptCen.y) * dFsca
|
|
ptOri.z = m_dRawHeight + dAddTable
|
|
End If
|
|
' Recupero origine della tavola e porto i punti in globale
|
|
Dim ptTab As Point3d
|
|
If Not EgtGetTableRef(1, ptTab) Then Return False
|
|
ptOri.ToGlob(New Frame3d(ptTab))
|
|
ptCen.ToGlob(New Frame3d(ptTab))
|
|
' Carico Dxf del contorno
|
|
If Not EgtImportDxf(sPath, 1) Then Return False
|
|
Dim nPartId As Integer = EgtGetLastPart()
|
|
Dim nLayerId As Integer = EgtGetFirstLayer(nPartId)
|
|
EgtSetName(nPartId, NAME_RAW_PHOTO_OUTLINE)
|
|
EgtSetLevel(nPartId, GDB_LV.SYSTEM)
|
|
EgtSetColor(nPartId, New Color3d(0, 255, 0))
|
|
If nPartId = GDB_ID.NULL Or nLayerId = GDB_ID.NULL Then Return False
|
|
' Ribalto rispetto a YZ locale (i contorni da CW diventano CCW)
|
|
EgtMirror(nLayerId, New Point3d(0, nPixelY / 2, 0), Vector3d.Y_AX(), GDB_RT.GLOB)
|
|
' Eseguo scalatura
|
|
EgtScale(nLayerId, New Frame3d(), dMMxPixel, dMMxPixel, dMMxPixel, GDB_RT.GLOB)
|
|
' Eseguo spostamento
|
|
EgtMove(nLayerId, (ptOri - Point3d.ORIG()), GDB_RT.GLOB)
|
|
' Eseguo concatenamento
|
|
EgtSelectGroupObjs(nLayerId)
|
|
EgtCreateCurveCompoByReorder(nLayerId, 1, {GDB_ID.SEL}, New Point3d(), True)
|
|
' Conservo la curva chiusa di area massima
|
|
Dim dAreaMax As Double = 0
|
|
Dim nCrvId As Integer = GDB_ID.NULL
|
|
Dim nCurrCrvId As Integer = EgtGetFirstInGroup(nLayerId)
|
|
While nCurrCrvId <> GDB_ID.NULL
|
|
Dim dArea As Double = 0
|
|
If Not EgtCurveAreaXY(nCurrCrvId, dArea) OrElse dArea <= dAreaMax Then
|
|
Dim nToEraseId = nCurrCrvId
|
|
nCurrCrvId = EgtGetNext(nCurrCrvId)
|
|
EgtErase(nToEraseId)
|
|
Else
|
|
dAreaMax = dArea
|
|
EgtErase(nCrvId)
|
|
nCrvId = nCurrCrvId
|
|
nCurrCrvId = EgtGetNext(nCurrCrvId)
|
|
End If
|
|
End While
|
|
If nCrvId = GDB_ID.NULL Then Return False
|
|
' Eseguo le semplificazioni
|
|
Dim nApprType As Integer = APP_TYPE.RIGHT_LINES
|
|
Dim dTol As Double = m_MainWindow.m_Camera.Tolerance
|
|
EgtApproxCurve(nCrvId, nApprType, dTol)
|
|
Dim ptNew As Point3d
|
|
EgtMidPoint(nCrvId, ptNew)
|
|
EgtChangeClosedCurveStartPoint(nCrvId, ptNew)
|
|
EgtApproxCurve(nCrvId, nApprType, dTol)
|
|
Return True
|
|
End Function
|
|
|
|
Private Function ReadAuxData(sPath As String,
|
|
ByRef ptOri As Point3d, ByRef ptCen As Point3d, ByRef dMMxPixel As Double) As Boolean
|
|
Dim sAuxPath As String = Path.ChangeExtension(sPath, ".txt")
|
|
Try
|
|
Dim sLine As String = String.Empty
|
|
Dim sr As StreamReader = New StreamReader(sAuxPath)
|
|
Do While sr.Peek() > -1
|
|
sLine = sr.ReadLine()
|
|
sLine = sLine.Replace(" ", "")
|
|
If sLine.StartsWith("X=") Then
|
|
StringToDouble(sLine.Substring(2), ptOri.x)
|
|
ElseIf sLine.StartsWith("Y=") Then
|
|
StringToDouble(sLine.Substring(2), ptOri.y)
|
|
ElseIf sLine.StartsWith("Z_Lastra=") Then
|
|
StringToDouble(sLine.Substring(9), ptOri.z)
|
|
ElseIf sLine.StartsWith("X_ScaleCenter=") Then
|
|
StringToDouble(sLine.Substring(14), ptCen.x)
|
|
ElseIf sLine.StartsWith("Y_ScaleCenter=") Then
|
|
StringToDouble(sLine.Substring(14), ptCen.y)
|
|
ElseIf sLine.StartsWith("Z_ScaleCenter=") Then
|
|
StringToDouble(sLine.Substring(14), ptCen.z)
|
|
ElseIf sLine.StartsWith("Pixelxmm=") Then
|
|
Dim dTmp As Double
|
|
StringToDouble(sLine.Substring(9), dTmp)
|
|
If dTmp > EPS_SMALL Then
|
|
dMMxPixel = 1 / dTmp
|
|
End If
|
|
End If
|
|
Loop
|
|
sr.Close()
|
|
Return True
|
|
Catch ex As Exception
|
|
EgtOutLog("LoadPhoto Error on auxfile : " & sAuxPath)
|
|
Return False
|
|
End Try
|
|
End Function
|
|
|
|
Friend Function UpdatePhoto() As Boolean
|
|
' Verifico esistenza oggetto foto
|
|
Dim nPhotoId As Integer = GetPhoto()
|
|
If nPhotoId = GDB_ID.NULL Then Return False
|
|
' Verifico esistenza texture della foto
|
|
Dim sPath As String = String.Empty
|
|
If Not EgtGetPhotoPath(nPhotoId, sPath) OrElse Not File.Exists(sPath) Then Return False
|
|
' Recupero i dati aggiuntivi della foto
|
|
Dim ptOri As New Point3d(0, 0, 0)
|
|
If Not EgtGetPhotoOrigin(nPhotoId, ptOri) Then Return False
|
|
Dim ptCen As New Point3d(0, 0, 1)
|
|
If Not EgtGetPhotoCenter(nPhotoId, ptCen) Then Return False
|
|
Dim dDimX, dDimY As Double
|
|
If Not EgtGetPhotoDimensions(nPhotoId, dDimX, dDimY) Then Return False
|
|
' Recupero origine della tavola
|
|
Dim ptTab As Point3d
|
|
If Not EgtGetTableRef(1, ptTab) Then Return False
|
|
' Porto i punti in locale
|
|
ptOri.ToLoc(New Frame3d(ptTab))
|
|
ptCen.ToLoc(New Frame3d(ptTab))
|
|
' Altezza eventuale tavola aggiuntiva
|
|
Dim dAddTable As Double = m_MainWindow.m_CurrentMachine.dAdditionalTable
|
|
' Aggiusto dati per spessore grezzo (Coefficiente di scalatura)
|
|
Dim dFsca As Double = (ptCen.z - m_dRawHeight - dAddTable) / (ptCen.z - ptOri.z)
|
|
dDimX *= dFsca
|
|
dDimY *= dFsca
|
|
ptOri.x = ptCen.x + (ptOri.x - ptCen.x) * dFsca
|
|
ptOri.y = ptCen.y + (ptOri.y - ptCen.y) * dFsca
|
|
ptOri.z = m_dRawHeight + dAddTable
|
|
' Porto i punti in globale
|
|
ptOri.ToGlob(New Frame3d(ptTab))
|
|
ptCen.ToGlob(New Frame3d(ptTab))
|
|
' Recupero le dimensioni della tavola
|
|
Dim ptMin, ptMax As Point3d
|
|
If Not EgtGetTableArea(1, ptMin, ptMax) Then Return False
|
|
' Elimino eventuale precedente foto
|
|
Dim nOldPhotoId = GetPhoto()
|
|
If nOldPhotoId <> GDB_ID.NULL Then EgtErase(nOldPhotoId)
|
|
' Se non esiste il gruppo per le foto, lo creo
|
|
Dim nPhGrpId As Integer = EgtGetFirstNameInGroup(GDB_ID.ROOT, PHOTO_GRP)
|
|
If nPhGrpId = GDB_ID.NULL Then
|
|
nPhGrpId = EgtCreateGroup(GDB_ID.ROOT)
|
|
If nPhGrpId = GDB_ID.NULL Then Return False
|
|
EgtSetName(nPhGrpId, PHOTO_GRP)
|
|
End If
|
|
EgtSetLevel(nPhGrpId, GDB_LV.SYSTEM)
|
|
' Carico la fotografia
|
|
Return EgtAddPhoto2(PHOTO_NAME, sPath, ptOri, ptCen, dDimX, dDimY, nPhGrpId, ptMin, ptMax) <> GDB_ID.NULL
|
|
End Function
|
|
|
|
Friend Function UpdateContour() As Boolean
|
|
' Verifico esistenza oggetto contorno
|
|
Dim nCrvId As Integer = GetContour()
|
|
If nCrvId = GDB_ID.NULL Then Return False
|
|
' Verifico esistenza oggetto foto
|
|
Dim nPhotoId As Integer = GetPhoto()
|
|
If nPhotoId = GDB_ID.NULL Then Return False
|
|
' Recupero centro della foto
|
|
Dim ptCen As New Point3d(0, 0, 1)
|
|
EgtGetPhotoCenter(nPhotoId, ptCen)
|
|
' Recupero origine della tavola
|
|
Dim ptTab As Point3d
|
|
If Not EgtGetTableRef(1, ptTab) Then Return False
|
|
' Altezza eventuale tavola aggiuntiva
|
|
Dim dAddTable As Double = m_MainWindow.m_CurrentMachine.dAdditionalTable
|
|
' Recupero inizio contorno
|
|
Dim ptStart As Point3d
|
|
EgtStartPoint(nCrvId, GDB_ID.ROOT, ptStart)
|
|
' Calcolo coefficiente di scalatura
|
|
Dim dFsca As Double = (ptCen.z - ptTab.z - m_dRawHeight - dAddTable) / (ptCen.z - ptStart.z)
|
|
' Scalo opportunamente
|
|
EgtScale(nCrvId, New Frame3d(ptCen), dFsca, dFsca, 1, GDB_RT.GLOB)
|
|
' Sposto in Z
|
|
Dim vtMove As New Vector3d(0, 0, ptTab.z + m_dRawHeight + dAddTable - ptStart.z)
|
|
EgtMove(nCrvId, vtMove, GDB_RT.GLOB)
|
|
Return True
|
|
End Function
|
|
|
|
Friend Function ShowPhoto(ByVal bShow As Boolean, Optional bDisableModified As Boolean = True) As Boolean
|
|
' Recupero la foto
|
|
Dim nId As Integer = GetPhoto()
|
|
If nId = GDB_ID.NULL Then Return False
|
|
' Se richiesto, disabilito impostazione modificato
|
|
Dim bOldEnMod As Boolean = False
|
|
If bDisableModified Then
|
|
bOldEnMod = EgtGetEnableModified()
|
|
If bOldEnMod Then EgtDisableModified()
|
|
End If
|
|
' Ne cambio lo stato
|
|
Dim bOk As Boolean = EgtSetStatus(nId, If(bShow, GDB_ST.ON_, GDB_ST.OFF))
|
|
' Se necessario, ripristino precedente impostazione modificato
|
|
If bOldEnMod Then EgtEnableModified()
|
|
Return bOk
|
|
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
|
|
' Recupero il riferimento in globale
|
|
Return EgtGetTextureFrame(nId, GDB_ID.ROOT, refTxr)
|
|
End Function
|
|
|
|
Friend Function GetContour() As Integer
|
|
Dim nPartId As Integer = EgtGetFirstNameInGroup(GDB_ID.ROOT, NAME_RAW_PHOTO_OUTLINE)
|
|
Dim nLayerId As Integer = EgtGetFirstGroupInGroup(nPartId)
|
|
Dim nCrvId As Integer = EgtGetFirstInGroup(nLayerId)
|
|
Return nCrvId
|
|
End Function
|
|
|
|
Friend Sub RemoveContour()
|
|
EgtErase(EgtGetFirstNameInGroup(GDB_ID.ROOT, NAME_RAW_PHOTO_OUTLINE))
|
|
End Sub
|
|
|
|
Friend Sub ShowContour(bShow As Boolean)
|
|
' Disabilito impostazione modificato
|
|
Dim bOldEnMod As Boolean = EgtGetEnableModified()
|
|
If bOldEnMod Then EgtDisableModified()
|
|
' Cambio stato di visualizzazione
|
|
EgtSetStatus(EgtGetFirstNameInGroup(GDB_ID.ROOT, NAME_RAW_PHOTO_OUTLINE), If(bShow, GDB_ST.ON_, GDB_ST.OFF))
|
|
' Se necessario, ripristino precedente impostazione modificato
|
|
If bOldEnMod Then EgtEnableModified()
|
|
End Sub
|
|
|
|
' Gestione area pezzi totale e area pezzi da produrre
|
|
|
|
Friend Function SetTotalArea(dTotArea As Double) As Boolean
|
|
Dim nMarkId As Integer = AddProjectMark()
|
|
Return EgtSetInfo(nMarkId, INFO_TOTAREA, dTotArea)
|
|
End Function
|
|
|
|
Friend Function UpdateTotalArea(dNewArea As Double) As Boolean
|
|
Dim nMarkId As Integer = AddProjectMark()
|
|
Dim dTotArea As Double = 0
|
|
EgtGetInfo(nMarkId, INFO_TOTAREA, dTotArea)
|
|
dTotArea = Math.Max(dTotArea + dNewArea, 0)
|
|
Return EgtSetInfo(nMarkId, INFO_TOTAREA, dTotArea)
|
|
End Function
|
|
|
|
Friend Function GetTotalArea() As Double
|
|
Dim nMarkId As Integer = AddProjectMark()
|
|
Dim dTotArea As Double = 0
|
|
EgtGetInfo(nMarkId, INFO_TOTAREA, dTotArea)
|
|
Return dTotArea
|
|
End Function
|
|
|
|
Friend Function UpdateToProduceArea() As Boolean
|
|
Dim dToProdArea As Double = 0
|
|
' Se programma non ancora inviato al CN, ciclo sui pezzi nella lastra
|
|
If GetProjectNcProgSent() = 0 Then
|
|
Dim nPartInRawId As Integer = EgtGetFirstPartInRawPart(CamAuto.GetCurrentRaw())
|
|
While nPartInRawId <> GDB_ID.NULL
|
|
dToProdArea += GeomCalc.GetPartArea(nPartInRawId)
|
|
nPartInRawId = EgtGetNextPartInRawPart(nPartInRawId)
|
|
End While
|
|
End If
|
|
' Ciclo sui pezzi in parcheggio
|
|
Dim nPartId As Integer = EgtGetFirstPart()
|
|
While nPartId <> GDB_ID.NULL
|
|
dToProdArea += GeomCalc.GetPartArea(nPartId)
|
|
nPartId = EgtGetNextPart(nPartId)
|
|
End While
|
|
Dim nMarkId As Integer = AddProjectMark()
|
|
Return EgtSetInfo(nMarkId, INFO_TOPRODAREA, dToProdArea)
|
|
End Function
|
|
|
|
Friend Function GetToProduceArea() As Double
|
|
Dim nMarkId As Integer = AddProjectMark()
|
|
Dim dToProdArea As Double = 0
|
|
EgtGetInfo(nMarkId, INFO_TOPRODAREA, dToProdArea)
|
|
Return dToProdArea
|
|
End Function
|
|
|
|
Friend Sub ShowAreas()
|
|
' Recupero il gruppo di Mark e lo svuoto
|
|
Dim nMarkId As Integer = AddProjectMark()
|
|
EgtEmptyGroup(nMarkId)
|
|
' Se non sono da visualizzare esco
|
|
If GetPrivateProfileInt(S_STATISTICS, K_SHOWAREAS, 0, m_MainWindow.GetMachIniFile()) = 0 Then Return
|
|
' Recupero dati
|
|
Dim dTotArea As Double = GetTotalArea()
|
|
Dim dToProdArea As Double = GetToProduceArea()
|
|
' Recupero box tavola
|
|
Dim b3Tab As New BBox3d
|
|
If Not EgtGetTableArea(1, b3Tab) Then
|
|
b3Tab.Add(New Point3d(0, 0, 0))
|
|
b3Tab.Add(New Point3d(-3600, -2600, 0))
|
|
End If
|
|
' Scritte
|
|
Const TEXT_DIST As Double = 100
|
|
Dim ptIns As New Point3d(b3Tab.Center().x, b3Tab.Max().y + TEXT_DIST, b3Tab.Max().z)
|
|
Dim dCoeff As Double = 1.0 / 1000000.0
|
|
Dim sUnit As String = " m²"
|
|
If Not EgtUiUnitsAreMM() Then
|
|
dCoeff = 1.0 / (12 * ONEINCH * 12 * ONEINCH)
|
|
sUnit = " ft²"
|
|
End If
|
|
Dim sText As String = EgtMsg(90328) & " " & DoubleToString(dTotArea * dCoeff, 3) & sUnit & " " & ' Area Pezzi:
|
|
EgtMsg(90329) & " " & DoubleToString(dToProdArea * dCoeff, 3) & sUnit ' Da Produrre:
|
|
Dim nText As Integer = EgtCreateTextAdv(nMarkId, ptIns, 0, sText, "", 500, False, 100, 1, 0, INS_POS.MC)
|
|
EgtSetColor(nText, New Color3d(0, 0, 0))
|
|
End Sub
|
|
Friend Sub SetAreasStatus(bShow As Boolean)
|
|
Dim nMarkId As Integer = EgtGetFirstNameInGroup(GDB_ID.ROOT, NAME_PROJMARK)
|
|
If nMarkId = GDB_ID.NULL Then Return
|
|
|
|
' Disabilito impostazione modificato
|
|
Dim bOldEnMod As Boolean = EgtGetEnableModified()
|
|
If bOldEnMod Then EgtDisableModified()
|
|
' Cambio stato visualizzazione
|
|
EgtSetStatus(nMarkId, If(bShow, GDB_ST.ON_, GDB_ST.OFF))
|
|
' Se necessario riabilito impostazione modificato
|
|
If bOldEnMod Then EgtEnableModified()
|
|
End Sub
|
|
|
|
' Gestione messaggi in interfaccia
|
|
|
|
Friend Sub SetInfoMessage(sMessage As String)
|
|
OutMessageBrd.Background = Application.Current.FindResource("OmagCut_Green")
|
|
OutMessageTxBl.Text = sMessage
|
|
OutMessageBrd.Visibility = Windows.Visibility.Visible
|
|
End Sub
|
|
|
|
Friend Sub SetWarningMessage(sMessage As String)
|
|
OutMessageBrd.Background = Application.Current.FindResource("OmagCut_Yellow")
|
|
OutMessageTxBl.Text = sMessage
|
|
OutMessageBrd.Visibility = Windows.Visibility.Visible
|
|
EgtOutLog(sMessage)
|
|
End Sub
|
|
|
|
Friend Sub SetErrorMessage(sMessage As String)
|
|
OutMessageBrd.Background = Application.Current.FindResource("OmagCut_Red")
|
|
OutMessageTxBl.Text = sMessage
|
|
OutMessageBrd.Visibility = Windows.Visibility.Visible
|
|
EgtOutLog(sMessage)
|
|
End Sub
|
|
|
|
Friend Sub ClearMessage()
|
|
OutMessageBrd.Background = Brushes.Transparent
|
|
OutMessageTxBl.Text = ""
|
|
'OutMessageBrd.Visibility = Windows.Visibility.Hidden
|
|
End Sub
|
|
|
|
End Class
|