Imports System.Collections.ObjectModel Imports System.IO Imports EgtUILib Imports System.Runtime.InteropServices Public Class ImportPageUC 'Riferimento alla MainWindow Private m_MainWindow As MainWindow = Application.Current.MainWindow 'Dichiarazione del UserControl SceneButtons Friend m_SceneButtons As SceneButtonsUC ' Properties Private m_sCurrDir As String = String.Empty Private m_sCurrFile As String = String.Empty Private m_nFileType As Integer = FT.NULL Private m_bFirst As Boolean = True Private m_bMM As Boolean = True 'Dichiarazione Scene Friend WithEvents ImportScene As New Scene Dim ImportSceneHost As New System.Windows.Forms.Integration.WindowsFormsHost Private Sub ImportPage_Initialized(sender As Object, e As EventArgs) 'Creazione del UserCOntrol SceneButtons m_SceneButtons = New SceneButtonsUC 'Posizionemento nella griglia del UserControl SceneButtons m_SceneButtons.SetValue(Grid.ColumnProperty, 1) UpperButtonGrid.Children.Add(m_SceneButtons) 'Assegnazione scena all'host e posizionamento nella ImportPageGrid ImportSceneHost.Child = ImportScene ImportSceneHost.SetValue(Grid.ColumnProperty, 1) ImportSceneHost.SetValue(Grid.RowProperty, 2) 'ImportSceneHost.SetValue(Grid.RowSpanProperty, 2) Me.ImportPageGrid.Children.Add(ImportSceneHost) 'Imposto i messaggi letti dal file dei messaggi UseLayerBtn.Content = EgtMsg(MSG_IMPORTPAGEUC + 1) 'Usa layer - Use layers UseRegionBtn.Content = EgtMsg(MSG_IMPORTPAGEUC + 2) 'Usa regioni - Use regions UseClosedCurveBtn.Content = EgtMsg(MSG_IMPORTPAGEUC + 6) 'Usa curve chiuse - Use closed curves ResetBtn.Content = EgtMsg(MSG_IMPORTPAGEUC + 3) 'Reset mmBtn.Content = EgtMsg(MSG_IMPORTPAGEUC + 4) 'mm inchBtn.Content = EgtMsg(MSG_IMPORTPAGEUC + 5) 'inch 'Definizione del collegamento tra ItemList e ListBox1 FileListBox.ItemsSource = m_MainWindow.m_ImportItemList End Sub Private Sub ImportPage_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()) ImportScene.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()) ImportScene.SetViewBackground(BackTopColor, BackBotColor) ' imposto colore di evidenziazione Dim MarkColor As New Color3d(255, 255, 0) GetPrivateProfileColor(S_SCENE, K_MARK, MarkColor, m_MainWindow.GetIniFile()) ImportScene.SetMarkMaterial(MarkColor) ' imposto colore per superfici selezionate Dim SelSurfColor As New Color3d(255, 255, 192) GetPrivateProfileColor(S_SCENE, K_SELSURF, SelSurfColor, m_MainWindow.GetIniFile()) ImportScene.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()) ImportScene.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()) ImportScene.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()) ImportScene.SetViewAttributes(nDriver, b2Buff, nColorBits, nDepthBits) ' Inizializzazione delle viste ImportScene.Init() ' Imposto griglia LoadGridData() ' leggo direttorio corrente GetPrivateProfileString(S_FLATPARTS, K_FLPCURRDIR, "", m_sCurrDir, m_MainWindow.GetIniFile()) ' lo carico LoadCurrDir() m_bFirst = False Else EgtSetCurrentContext(ImportScene.GetCtx()) End If ' Pulisco tutto ClearView() ' inibisco selezione diretta da Scene ImportScene.SetStatusNull() ' imposto misura m_bMM = EgtUiUnitsAreMM() If m_bMM Then mmBtn.IsChecked = True Else inchBtn.IsChecked = True End If End Sub Private Sub LoadGridData() Dim dSnapStep As Double = GetPrivateProfileDouble(S_GRID, K_SNAPSTEP, 10, m_MainWindow.GetIniFile()) Dim nMinLineSStep As Integer = GetPrivateProfileInt(S_GRID, K_MINLINESSTEP, 1, m_MainWindow.GetIniFile()) Dim nMajLineSStep As Integer = GetPrivateProfileInt(S_GRID, K_MAJLINESSTEP, 10, m_MainWindow.GetIniFile()) Dim nExtSStep As Integer = GetPrivateProfileInt(S_GRID, K_EXTSSTEP, 50, m_MainWindow.GetIniFile()) Dim MinLnColor As New Color3d(160, 160, 160) GetPrivateProfileColor(S_GRID, K_MINLNCOLOR, MinLnColor, m_MainWindow.GetIniFile()) Dim MajLnColor As New Color3d(160, 160, 160) GetPrivateProfileColor(S_GRID, K_MAJLNCOLOR, MajLnColor, m_MainWindow.GetIniFile()) EgtSetGridFrame(Frame3d.GLOB) EgtSetGridGeo(dSnapStep, nMinLineSStep, nMajLineSStep, nExtSStep) EgtSetGridColor(MinLnColor, MajLnColor) Dim bShowGrid As Boolean = (GetPrivateProfileInt(S_GRID, K_SHOWGRID, 1, m_MainWindow.GetIniFile()) <> 0) EgtSetGridShow(bShowGrid, False) End Sub Private Function LoadCurrDir() As Boolean ' se direttorio corrente non valido, carico l'elenco dei dischi If String.IsNullOrWhiteSpace(m_sCurrDir) OrElse Not IO.Directory.Exists(m_sCurrDir) Then Return LoadDisks() End If Dim TempPath As New Text.StringBuilder(260) PathCompactPathEx(TempPath, m_sCurrDir, 28, 0) ' lo visualizzo FilePathTxBl.Content = TempPath.ToString ' pulisco la lista m_MainWindow.m_ImportItemList.Clear() ' per risalire al direttorio padre m_MainWindow.m_ImportItemList.Add(New IconListBoxItem("..", 0)) ' elenco dei sottodirettori Dim DirInfo As New DirectoryInfo(m_sCurrDir) Dim vDirI As DirectoryInfo() = DirInfo.GetDirectories("*") Dim DirI As DirectoryInfo For Each DirI In vDirI ' per saltare i link, troppo complessi da gestire If (DirI.Attributes And FileAttributes.Hidden) <> FileAttributes.Hidden Or (DirI.Attributes And FileAttributes.System) <> FileAttributes.System Then m_MainWindow.m_ImportItemList.Add(New IconListBoxItem(DirI.Name, 2)) End If Next ' elenco dei file Dim vFileI As FileInfo() = DirInfo.GetFiles() Dim FileI As FileInfo For Each FileI In vFileI Dim sExt As String = Path.GetExtension(FileI.Name).ToUpper() If sExt = ".DXF" Or sExt = ".NGE" Then m_MainWindow.m_ImportItemList.Add(New IconListBoxItem(FileI.Name, 3)) End If Next ' pulisco la vista ClearView() Return True End Function Private Function LoadDisks() As Boolean ' dir corrente vuoto m_sCurrDir = "" ' lo visualizzo FilePathTxBl.Content = m_sCurrDir ' pulisco la lista m_MainWindow.m_ImportItemList.Clear() ' elenco dei dischi Dim vDriI As DriveInfo() = DriveInfo.GetDrives() Dim DriI As DriveInfo For Each DriI In vDriI m_MainWindow.m_ImportItemList.Add(New IconListBoxItem(DriI.Name, 1)) Next ' pulisco la vista ClearView() Return True End Function Private Sub FileListBox_PreviewMouseUp(sender As Object, e As MouseButtonEventArgs) Handles FileListBox.PreviewMouseUp ' Recupero item selezionato If FileListBox.SelectedItems.Count() = 0 Then Return End If Dim vItems As IconListBoxItem = FileListBox.SelectedItems(0) ' A seconda del tipo Select Case vItems.PictureID Case 0 ' Vai nel direttorio padre m_sCurrDir = IO.Path.GetDirectoryName(m_sCurrDir) m_sCurrFile = "" LoadCurrDir() Case 1 ' Vai nella radice del disco m_sCurrDir = vItems.Name m_sCurrFile = "" LoadCurrDir() Case 2 ' Vai nel sottodirettorio m_sCurrDir = IO.Path.Combine(m_sCurrDir, vItems.Name) m_sCurrFile = "" LoadCurrDir() Case 3 ' File m_sCurrFile = vItems.Name LoadCurrFile() End Select End Sub Private Sub FileListBox_SelectionChanged(sender As Object, e As SelectionChangedEventArgs) Handles FileListBox.SelectionChanged ' Recupero item selezionato If FileListBox.SelectedItems.Count() = 0 Then Return End If Dim vItems As IconListBoxItem = FileListBox.SelectedItems(0) ' Gestisco solo aggiornamento visualizzazione file If vItems.PictureID = 3 Then m_sCurrFile = vItems.Name LoadCurrFile() End If End Sub Private Function ClearView() As Boolean ' Pulisco il DB geometrico locale EgtNewFile() ' Eseguo zoom ImportScene.ZoomAll() ' disabilito bottoni Process e Insert UseLayerBtn.IsEnabled = False UseClosedCurveBtn.IsEnabled = False UseRegionBtn.IsEnabled = False ResetBtn.IsEnabled = False 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 m_nFileType = EgtGetFileType(sPath) If m_nFileType = FT.DXF Then ' recupero unità di misura del file Dim dScale As Double = If(m_bMM, ONEMM, ONEINCH) ' Importo file DXF bOk = bOk AndAlso EgtImportDxf(sPath, dScale) ElseIf m_nFileType = FT.NGE Then ' Carico Nge bOk = bOk AndAlso EgtOpenFile(sPath) ' Filtro Nge bOk = bOk AndAlso FilterNge() Else ' Formato sconosciuto bOk = False End If ' Eseguo zoom ImportScene.ZoomAll() ' abilito bottoni UseLayer, UseClosedCurve e UseRegion, disabilito Reset e Insert UseLayerBtn.IsEnabled = True UseClosedCurveBtn.IsEnabled = True UseRegionBtn.IsEnabled = True ResetBtn.IsEnabled = False OkBtn.IsEnabled = False Return bOk End Function Private Sub OnMouseDownScene(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles ImportScene.OnMouseDownScene ' Si può selezionare solo con il tasto sinistro e se stato NULL If e.Button <> Windows.Forms.MouseButtons.Left Or Not ImportScene.IsStatusNull() Then Return End If ' Verifico se selezionato indicativo di pezzo EgtSetObjFilterForSelect(True, True, True, True, True) Dim nSel As Integer EgtSelect(e.Location, Scene.DIM_SEL, Scene.DIM_SEL, nSel) Dim nId As Integer = EgtGetFirstObjInSelWin() While nId <> GDB_ID.NULL ' Recupero l'identificativo del pezzo cui appartiene Dim nPartId As Integer = EgtGetParent(EgtGetParent(nId)) If EgtIsPart(nPartId) Then Dim nStat As Integer = GDB_ST.ON_ EgtGetStatus(nPartId, nStat) If nStat = GDB_ST.SEL Then EgtDeselectObj(nPartId) Else EgtSelectObj(nPartId) End If EgtDraw() Exit While End If nId = EgtGetNextObjInSelWin() End While End Sub Private Sub UseLayerBtn_Click(sender As Object, e As RoutedEventArgs) Handles UseLayerBtn.Click ' Creo i pezzi Dim nType As Integer = If(m_nFileType = FT.NGE, FPC_TYPE.NGE, FPC_TYPE.LAYER) EgtCreateFlatParts(nType) AdjustFlatParts() ' Eseguo zoom ImportScene.ZoomAll() ' disabilito bottoni UseLayer e UseRegion, abilito bottoni Reset e Insert UseLayerBtn.IsEnabled = False UseClosedCurveBtn.IsEnabled = False UseRegionBtn.IsEnabled = False ResetBtn.IsEnabled = True OkBtn.IsEnabled = True End Sub Private Sub UseClosedCurveBtn_Click(sender As Object, e As RoutedEventArgs) Handles UseClosedCurveBtn.Click ' Creo i pezzi Dim nType As Integer = If(m_nFileType = FT.NGE, FPC_TYPE.NGE, FPC_TYPE.CLOSEDCURVE) EgtCreateFlatParts(nType) AdjustFlatParts() ' Eseguo zoom ImportScene.ZoomAll() ' disabilito bottoni UseLayer e UseRegion, abilito bottoni Reset e Insert UseLayerBtn.IsEnabled = False UseClosedCurveBtn.IsEnabled = False UseRegionBtn.IsEnabled = False ResetBtn.IsEnabled = True OkBtn.IsEnabled = True End Sub Private Sub UseRegionBtn_Click(sender As Object, e As RoutedEventArgs) Handles UseRegionBtn.Click ' Creo i pezzi Dim nType As Integer = If(m_nFileType = FT.NGE, FPC_TYPE.NGE, FPC_TYPE.REGION) EgtCreateFlatParts(nType) AdjustFlatParts() ' Eseguo zoom ImportScene.ZoomAll() ' disabilito bottoni UseLayer e UseRegion, abilito bottoni Reset e Insert UseLayerBtn.IsEnabled = False UseClosedCurveBtn.IsEnabled = False UseRegionBtn.IsEnabled = False ResetBtn.IsEnabled = True OkBtn.IsEnabled = True End Sub Private Function FilterNge() As Boolean ' Rimuovo eventuali gruppi con livello System Dim nId As Integer = EgtGetFirstGroupInGroup(GDB_ID.ROOT) While nId <> GDB_ID.NULL ' Recupero il prossimo gruppo Dim nNextId = EgtGetNextGroup(nId) ' Verifico il livello e se necessario cancello Dim nLevel As Integer = GDB_LV.USER EgtGetLevel(nId, nLevel) If nLevel = GDB_LV.SYSTEM Then EgtErase(nId) End If ' Passo al prossimo gruppo nId = nNextId End While ' Processo i sottogruppi, se di livello System li rimuovo altrimenti ne cancello il nome 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 o rimozione nome Dim nLevel As Integer = GDB_LV.USER EgtGetLevel(nSubId, nLevel) If nLevel = GDB_LV.SYSTEM Then EgtErase(nSubId) Else EgtRemoveName(nSubId) End If nSubId = nNextSubId End While ' Passo al prossimo gruppo nGrpId = EgtGetNextGroup(nGrpId) End While Return True End Function Private Sub AdjustFlatParts() ' Ciclo sui pezzi Dim nPartId As Integer = EgtGetFirstPart() While nPartId <> GDB_ID.NULL ' Sistemo il pezzo AdjustFlatPart(nPartId) ' Passo al pezzo successivo nPartId = EgtGetNextPart(nPartId) End While End Sub Private Sub ResetBtn_Click(sender As Object, e As RoutedEventArgs) Handles ResetBtn.Click ' Ricarico file corrente LoadCurrFile() End Sub Private Sub mmBtn_Click(sender As Object, e As RoutedEventArgs) Handles mmBtn.Click, inchBtn.Click ' Dal bottone premuto imposto l'unità di misura Dim bMM As Boolean = mmBtn.IsChecked ' Se stato cambiato, salvo e ricarico file If m_bMM <> bMM Then m_bMM = bMM LoadCurrFile() End If End Sub Private Sub OkBtn_Click(sender As Object, e As RoutedEventArgs) Handles OkBtn.Click ' Vettore nomi file temporanei Dim sTmpFiles As New ArrayList() ' Ciclo di salvataggio dei pezzi Dim nId As Integer = EgtGetFirstPart() While nId <> GDB_ID.NULL ' Esporto il pezzo in un file temporaneo Dim sTmpFile As String = m_MainWindow.GetTempDir() & "\FlatPart" & nId & ".Nge" sTmpFiles.Add(sTmpFile) If Not EgtSaveObjToFile(nId, sTmpFile, NGE.BIN) Then Return End If ' Passo al pezzo successivo nId = EgtGetNextPart(nId) End While ' Passo al contesto principale EgtSetCurrentContext(m_MainWindow.m_CurrentProjectPageUC.CurrentProjectScene.GetCtx()) ' Recupero flag per inserimento diretto in grezzo (altrimenti in parcheggio) Dim bDirect As Boolean = (GetPrivateProfileInt(S_NEST, K_DIRECT, 0, m_MainWindow.GetIniFile()) <> 0) ' Elimino eventuali precedenti pezzi vuoti EgtEraseEmptyParts() ' Ciclo di caricamento dei pezzi For Each sTmpfile As String In sTmpFiles If My.Computer.FileSystem.FileExists(sTmpfile) Then ' Inserisco il pezzo EgtInsertFile(sTmpfile) ' Ne recupero l'Id Dim nId2 As Integer = EgtGetLastPart() ' Muovo la regione in Z per evitare problemi in visualizzazione Dim nRegId = EgtGetFirstNameInGroup(nId2, NAME_REGION) EgtMove(nRegId, New Vector3d(0, 0, DELTAZ_REG), GDB_RT.GLOB) ' Inserisco in parcheggio m_MainWindow.m_CadCutPageUC.m_NestPage.StoreOnePart(nId2, True) ' Se richiesto posizionamento diretto, lo eseguo If bDirect Then m_MainWindow.m_CadCutPageUC.m_NestPage.InsertOnePart(nId2) End If ' Cancello il file My.Computer.FileSystem.DeleteFile(sTmpfile) End If Next ' Aggiorno ambiente principale EgtZoom(ZM.ALL) 'Istruzioni per chiudere ImportPageUC e aprire CadCutPageUC m_MainWindow.MainWindowGrid.Children.Remove(m_MainWindow.m_ImportPageUC) 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 ImportPageUC e aprire CadCutPageUC m_MainWindow.MainWindowGrid.Children.Remove(m_MainWindow.m_ImportPageUC) m_MainWindow.MainWindowGrid.Children.Add(m_MainWindow.m_CurrentProjectPageUC) m_MainWindow.m_ActivePage = MainWindow.Pages.CadCut End Sub Private Sub ImportPage_Unloaded(sender As Object, e As RoutedEventArgs) ' Salvo direttorio corrente WritePrivateProfileString(S_FLATPARTS, K_FLPCURRDIR, m_sCurrDir, m_MainWindow.GetIniFile()) End Sub End Class Public Class IconListBoxItem Private m_iPictureID As Integer Private m_sName As String Public Property PictureID() As Integer Get Return m_iPictureID End Get Set(value As Integer) m_iPictureID = value End Set End Property Public Property Name() As String Get Return m_sName End Get Set(value As String) m_sName = value End Set End Property Public ReadOnly Property PictureString() As String Get Return "/Resources/ImportPageListBoxImages/" + PictureID.ToString() + ".png" End Get End Property Sub New() Me.Name = String.Empty Me.PictureID = 0 End Sub Sub New(Name As String, PictureID As Integer) Me.Name = Name Me.PictureID = PictureID End Sub End Class