Imports System.Windows.Interop Imports System.IO Imports EgtUILib Imports EgtWPFLib5 Imports System.Text.RegularExpressions Public Class MySceneHostVM Inherits EgtWPFLib5.SceneHostVM Public Property IsLayoutCheched As Boolean Get Return Map.refMainWindowVM.UnloadingAreaIsChecked End Get Set(value As Boolean) Map.refMainWindowVM.UnloadingAreaIsChecked = value End Set End Property Public ReadOnly Property VisibilityManulaPartCommand As Visibility Get ' verifico che la lastra sia prenotata If Not Map.refUnloadingAreaVM.IsChecked_Manual Then Return Visibility.Collapsed ' verifico se il progetto corrente è già stato scaricato sulla rulliera Dim CurrProj As Proj = Nothing For Each ItemProj In Map.refMainWindowVM.MainWindowM.ProjIndList If ItemProj.nProjInd = Map.refMainWindowVM.MainWindowM.nProjInd Then CurrProj = ItemProj End If Next If IsNothing(CurrProj) Then Return Visibility.Collapsed If CurrProj.enStatus <> StatusProj.WAITING Then Return Visibility.Collapsed Return Visibility.Visible End Get End Property Private m_cmdConfirmManaulPart As ICommand #Region "CONSTRUCTOR" Sub New() MyBase.New() AddHandler MainController.OnNewProject, AddressOf OnNewProject AddHandler MainController.OnOpenProject, AddressOf OnOpenProject 'AddHandler MainController.OnSavingProject, AddressOf OnSavingProject 'AddHandler MainController.OnSavedProject, AddressOf OnSavedProject Map.SetRefSceneHostVM(Me) End Sub #End Region ' CONSTRUCTOR #Region "METHODS" Overrides Sub InitScene() InitSceneEvents() ' Inizializzazione Scena PreInitializeScene() ' Se tutto bene -> And Map.refMainWindowVM.MainWindowM.GetKeyOption(KEY_OPT.OFFICE_BASE) If MainScene.Init() Then PostInitializeScene() ' Imposto stato gestione mouse diretto della scena a nessuno 'MainScene.SetStatusNull() ' Recupero e imposto handle finestra principale Dim hMainWnd As IntPtr = New WindowInteropHelper(Application.Current.MainWindow).Handle EgtSetMainWindowHandle(hMainWnd) ' inizializzo gestore lavorazioni EgtInitMachMgr(Map.refMainWindowVM.MainWindowM.sMachinesRoot, Map.refMainWindowVM.MainWindowM.sToolMakersDir) Return End If ' Problemi : MainWindowM->InitializeEgtEnvironment() ' Se manca la chiave 'If OmagOFFICEMap.refMainWindowVM.MainWindowM.nKeyLevel = -1 Or OmagOFFICEMap.refMainWindowVM.MainWindowM.nKeyLevel = -2 Then ' EgtOutLog("Missing Dongle") ' ' Box di avviso chiave mancante : "Chiave non presente. \n Inserirla e riavviare il programma." "Errore" ' Dim sText As String = EgtMsg(MSG_MISSINGKEYWD + 2) & vbCrLf & EgtMsg(MSG_MISSINGKEYWD + 3) ' Dim sTitle As String = EgtMsg(MSG_MISSINGKEYWD + 1) ' MessageBox.Show(sText, sTitle, MessageBoxButton.OK, MessageBoxImage.Error) '' 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 sText As String = EgtMsg(MSG_MISSINGKEYWD + 5) & vbCrLf & EgtMsg(MSG_MISSINGKEYWD + 6) ' Dim sTitle As String = EgtMsg(MSG_MISSINGKEYWD + 1) ' If MessageBox.Show(sText, sTitle, MessageBoxButton.OKCancel, MessageBoxImage.Error) = MessageBoxResult.OK 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 = Path.GetDirectoryName(LicDlg.FileName) ' ' Se il file non è già nel direttorio di configurazione lo copio ' If Not String.Equals(Path.GetFullPath(sDir), Path.GetFullPath(OmagOFFICEMap.refMainWindowVM.MainWindowM.sConfigDir), StringComparison.OrdinalIgnoreCase) Then ' Try ' File.Copy(LicDlg.FileName, Path.Combine(OmagOFFICEMap.refMainWindowVM.MainWindowM.sConfigDir, LicDlg.SafeFileName), True) ' Catch ex As Exception ' End Try ' End If ' ' Imposto il nuovo file di licenza nell'Ini ' WriteMainPrivateProfileString(S_GENERAL, K_LICENCE, LicDlg.SafeFileName) ' End If ' End If 'End If ' Chiudo il programma End End Sub Public Overrides Sub InitSceneEvents() AddHandler MainScene.OnMouseDownScene, AddressOf OnMouseDownScene AddHandler MainScene.OnMouseMoveScene, AddressOf OnMouseMoveScene AddHandler MainScene.OnMouseUpScene, AddressOf OnMouseUpScene 'AddHandler MainScene.KeyDown, AddressOf OnKeyDownScene 'AddHandler MainScene.OnCursorPos, AddressOf OnCursorPos 'AddHandler MainScene.OnShowDistance, AddressOf OnShowDistance 'AddHandler MainScene.OnChangedSnapPointType, AddressOf OnChangedSnapPointType End Sub Private Sub PreInitializeScene() ' imposto colore di default Dim DefColor As New Color3d(0, 0, 0) GetMainPrivateProfileColor(S_GEOMDB, K_DEFAULTCOLOR, DefColor) MainScene.SetDefaultMaterial(DefColor) ' imposto colori sfondo Dim BackTopColor As New Color3d(192, 192, 192) GetMainPrivateProfileColor(S_SCENE, K_BACKTOP, BackTopColor) Dim BackBotColor As New Color3d(BackTopColor) GetMainPrivateProfileColor(S_SCENE, K_BACKBOTTOM, BackBotColor) MainScene.SetViewBackground(BackTopColor, BackBotColor) ' imposto colore di evidenziazione Dim MarkColor As New Color3d(255, 255, 0) GetMainPrivateProfileColor(S_SCENE, K_MARK, MarkColor) MainScene.SetMarkMaterial(MarkColor) ' imposto colore per superfici selezionate Dim SelSurfColor As New Color3d(255, 255, 192) GetMainPrivateProfileColor(S_SCENE, K_SELSURF, SelSurfColor) MainScene.SetSelSurfMaterial(SelSurfColor) ' imposto tipo e colore del rettangolo di zoom Dim bOutline As Boolean = True Dim ZwColor As New Color3d(0, 0, 0) GetMainPrivateProfileZoomWin(S_SCENE, K_ZOOMWIN, bOutline, ZwColor) MainScene.SetZoomWinAttribs(bOutline, ZwColor) ' imposto colore della linea di distanza Dim DstLnColor As New Color3d(255, 0, 0) GetMainPrivateProfileColor(S_SCENE, K_DISTLINE, DstLnColor) MainScene.SetDistLineMaterial(DstLnColor) ' imposto parametri OpenGL Dim nDriver As Integer = GetMainPrivateProfileInt(S_OPENGL, K_DRIVER, 3) Dim b2Buff As Boolean = (GetMainPrivateProfileInt(S_OPENGL, K_DOUBLEBUFFER, 1) <> 0) Dim nColorBits As Integer = GetMainPrivateProfileInt(S_OPENGL, K_COLORBITS, 32) Dim nDepthBits As Integer = GetMainPrivateProfileInt(S_OPENGL, K_DEPTHBITS, 32) MainScene.SetViewAttributes(nDriver, b2Buff, nColorBits, nDepthBits) End Sub Private Sub PostInitializeScene() ' Impostazioni Controller MainController.SetScene(MainScene) ' imposto tipo coordinate MainScene.SetGridCursorPos(True) ' modo di visualizzazione Dim nShowMode As Integer = GetMainPrivateProfileInt(S_SCENE, K_SHOWMODE, SM.SHADING) 'OmagOFFICEMap.refShowPanelVM.SetShowMode(DirectCast(nShowMode, SM)) ' visualizzazione avanzata dei triangoli costituenti le superfici Dim bShowTriaAdv As Boolean = (GetMainPrivateProfileInt(S_SCENE, K_SHOWTRIAADV, 1) <> 0) EgtSetShowTriaAdv(bShowTriaAdv) ' tipo visualizzazione per Zmap Dim nShowZmap As Integer = GetMainPrivateProfileInt(S_SCENE, K_SHOWZMAP, 1) EgtSetShowZmap(DirectCast(nShowZmap, ZSM), False) ' dimensione lineare max in pixel delle textures Dim nTxrMaxLinPix As Integer = GetMainPrivateProfileInt(S_SCENE, K_TEXMAXLINPIX, 4096) EgtSetTextureMaxLinPixels(nTxrMaxLinPix) ' tipo snap point MainScene.SetSnapPointType(SP.PT_SKETCH) End Sub Public Overrides Sub SaveProject() MyBase.SaveProject() ' Imposto stato gestione mouse diretto della scena a nessuno 'MainScene.SetStatusNull() End Sub Public Overrides Sub SaveAsProject() MyBase.SaveAsProject() ' Imposto stato gestione mouse diretto della scena a nessuno 'MainScene.SetStatusNull() End Sub #End Region ' METHODS #Region "ProjectManager" Public Overrides Sub NewProject() EgtSetCurrentContext(MainScene.GetCtx()) Dim bOk As Boolean = MainController.NewProject() 'MainScene.SetStatusNull() End Sub Public Overrides Sub OpenProject(sFilePath As String) EgtSetCurrentContext(MainScene.GetCtx()) Dim bOk As Boolean = False If String.IsNullOrEmpty(sFilePath) Then ' Recupero cartella dell'ultimo progetto aperto Dim sDir As String = MainController.GetCurrFile() If String.IsNullOrWhiteSpace(sDir) Then GetMainPrivateProfileString(S_MRUFILES, K_FILE, "", sDir) End If If Not String.IsNullOrWhiteSpace(sDir) Then sDir = Path.GetDirectoryName(sDir) End If bOk = MainController.OpenProject(sDir) Else bOk = MainController.OpenProject(sFilePath, False) End If 'MainScene.SetStatusNull() End Sub #End Region ' ProjectManager #Region "EVENTS" Private Sub OnNewProject(sender As Object, bOk As Boolean) Map.refMainWindowVM.Title = " New - OmagVIEWPlus" End Sub Private Sub OnOpenProject(sender As Object, sFile As String, bOk As Boolean) ' Verifico la validità del file appena aperto (deve contenere almeno un gruppo di lavoro) If EgtGetMachGroupCount() = 0 Then bOk = False ' Procedo a seconda del risultato If bOk Then Map.refMainWindowVM.Title = sFile & " - OmagVIEWPlus" WriteMainPrivateProfileString(S_GENERAL, K_LASTPROJ, sFile) 'OmagOFFICEMap.refTopCommandBarVM.m_MruFiles.Add(sFile) Else EgtNewFile() Map.refMainWindowVM.Title = " New - OmagVIEWPlus" 'OmagOFFICEMap.refTopCommandBarVM.m_MruFiles.Remove(sFile) Dim sMsg As String = EgtMsg(10003) & " '" & sFile & "'" 'Error opening file MessageBox.Show(sMsg, EgtMsg(10001), MessageBoxButton.OK, MessageBoxImage.Error) 'Error End If 'MainScene.SetStatusNull() MainScene.SetObjFilterForSel(False, False, True, False, False) End Sub 'Private Sub OnSavingProject(ByVal sender As Object, sFile As String) ' ' Recupero tutti i file di texture associabili ai gruppi di lavoro del progetto ' Dim sDirToSearch As String = Path.GetDirectoryName(sFile) ' Dim sFileToSearch As String = Path.GetFileNameWithoutExtension(sFile) & "." & PHOTO_NAME & "*" ' Dim vsTxrFile As New List(Of String) ' For Each sTxrFile In My.Computer.FileSystem.GetFiles(sDirToSearch, FileIO.SearchOption.SearchTopLevelOnly, sFileToSearch) ' vsTxrFile.Add(sTxrFile) ' Next ' ' Rinomino path di eventuali fotografie ' Dim nPhotoId As Integer = EgtGetFirstInGroup(EgtGetFirstNameInGroup(GDB_ID.ROOT, PHOTO_GRP)) ' While nPhotoId <> GDB_ID.NULL ' ' Path originale ' Dim sPhoto As String = String.Empty ' If EgtGetPhotoPath(nPhotoId, sPhoto) Then ' ' Nome della foto ' Dim sName As String = String.Empty ' EgtGetName(nPhotoId, sName) ' ' Nuova path ' Dim sNewPhoto As String = Path.GetDirectoryName(sFile) & "\" & ' Path.GetFileNameWithoutExtension(sFile) & "." & sName & ' Path.GetExtension(sPhoto) ' ' Se diverse, eseguo copia ' If String.Compare(sPhoto, sNewPhoto, True) <> 0 Then ' Try ' ' Eseguo copia ' File.Copy(sPhoto, sNewPhoto, True) ' ' Notifico a foto il cambio di path ' EgtChangePhotoPath(nPhotoId, sNewPhoto) ' ' Eventuale notifica a VeinMatching del cambio di path ' VeinMatching.ChangePhotoPath(sPhoto, sNewPhoto) ' Catch ex As Exception ' End Try ' End If ' ' Tolgo da lista file texture associabili, se presente ' vsTxrFile.Remove(sNewPhoto) ' End If ' ' passo alla successiva ' nPhotoId = EgtGetNext(nPhotoId) ' End While ' ' Se rimasti file associabili, li cancello ' For Each sTxrFile In vsTxrFile ' Try ' My.Computer.FileSystem.DeleteFile(sTxrFile) ' Catch ' End Try ' Next 'End Sub 'Private Sub OnSavedProject(ByVal sender As Object, ByVal sFile As String, ByVal bOk As Boolean) ' ' Se salvataggio non riuscito, esco subito ' If Not bOk Then ' OmagOFFICEMap.refTopCommandBarVM.m_MruFiles.Remove(sFile) ' Dim sMsg As String = EgtMsg(10004) & " '" & sFile & "'" 'Error saving file ' MessageBox.Show(sMsg, EgtMsg(10001), MessageBoxButton.OK, MessageBoxImage.Error) ' Error ' Return ' End If ' ' Eventuale salvataggio VM ' Dim sVmFile As String = Path.ChangeExtension(sFile, ".vme") ' VeinMatching.Save(sVmFile) ' ' Eventuale salvataggio CSV ' CsvM.SaveCsvPartList() ' ' Aggiornamento titolo ' OmagOFFICEMap.refMainWindowVM.Title = sFile & " - OmagOFFICE" ' ' Riabilito visualizzazione pezzi in parcheggio ' EstCalc.ShowParkedParts() ' ' Inserisco nome in MRU ' OmagOFFICEMap.refTopCommandBarVM.m_MruFiles.Add(sFile) ' ' Salvo nome ultimo file ' WriteMainPrivateProfileString(S_GENERAL, K_LASTPROJ, sFile) 'End Sub '' selezione della scena: Grezzo, Nesting, lavorazione, simulazione 'Private Sub OnMouseDownScene(sender As Object, e As Windows.Forms.MouseEventArgs) ' ' Si può selezionare solo con il tasto sinistro e se stato NULL ' If e.Button <> Windows.Forms.MouseButtons.Left Or Not MainScene.IsStatusNull() Then Return ' ' Chiamo l'opportuno gestore ' Select Case OmagOFFICEMap.refOptionPanelVM.SelItem ' Case OptionPanelVM.Tabs.RAWPART ' OmagOFFICEMap.refRawPartTabVM.OnMouseDownScene(sender, e) ' Case OptionPanelVM.Tabs.NESTING ' OmagOFFICEMap.refNestingTabVM.OnMouseDownScene(sender, e) ' Case OptionPanelVM.Tabs.MACHINING ' OmagOFFICEMap.refMachiningTabVM.OnMouseDownScene(sender, e) ' Case OptionPanelVM.Tabs.SIMUL ' End Select 'End Sub 'Private Sub OnMouseMoveScene(sender As Object, e As Windows.Forms.MouseEventArgs) ' ' Chiamo l'opportuno gestore ' Select Case OmagOFFICEMap.refOptionPanelVM.SelItem ' Case OptionPanelVM.Tabs.RAWPART ' OmagOFFICEMap.refRawPartTabVM.OnMouseMoveScene(sender, e) ' Case OptionPanelVM.Tabs.NESTING ' OmagOFFICEMap.refNestingTabVM.OnMouseMoveScene(sender, e) ' Case OptionPanelVM.Tabs.MACHINING ' Case OptionPanelVM.Tabs.SIMUL ' End Select 'End Sub 'Private Sub OnMouseUpScene(sender As Object, e As Windows.Forms.MouseEventArgs) ' ' Chiamo l'opportuno gestore ' Select Case OmagOFFICEMap.refOptionPanelVM.SelItem ' Case OptionPanelVM.Tabs.RAWPART ' OmagOFFICEMap.refRawPartTabVM.OnMouseUpScene(sender, e) ' Case OptionPanelVM.Tabs.NESTING ' OmagOFFICEMap.refNestingTabVM.OnMouseUpScene(sender, e) ' Case OptionPanelVM.Tabs.MACHINING ' Case OptionPanelVM.Tabs.SIMUL ' End Select 'End Sub 'Private Sub OnKeyDownScene(sender As Object, e As System.Windows.Forms.KeyEventArgs) ' ' Chiamo l'opportuno gestore ' Select Case OmagOFFICEMap.refOptionPanelVM.SelItem ' Case OptionPanelVM.Tabs.RAWPART ' Case OptionPanelVM.Tabs.NESTING ' OmagOFFICEMap.refNestingTabVM.OnKeyDownScene(sender, e) ' Case OptionPanelVM.Tabs.MACHINING ' Case OptionPanelVM.Tabs.SIMUL ' End Select 'End Sub 'Private Sub OnCursorPos(ByVal sender As Object, ByVal sCursorPos As String) ' OmagOFFICEMap.refStatusBarVM.SetCurrPos(sCursorPos) 'End Sub 'Private Sub OnShowDistance(ByVal sender As Object, ByVal sDistance As String) ' OmagOFFICEMap.refStatusBarVM.SetOutputMessage(sDistance) 'End Sub 'Private Sub OnChangedSnapPointType(ByVal sender As Object, ByVal nSpType As SP, ByVal bUser As Boolean) ' Dim BtnColor As Brush ' If bUser Then ' BtnColor = New SolidColorBrush(SystemColors.ControlColor) ' Else ' BtnColor = Brushes.Bisque ' End If ' Select Case nSpType ' Case SP.PT_SKETCH ' OmagOFFICEMap.refStatusBarVM.SetSnapPointType(EgtMsg(1102), BtnColor) 'Sketch Point ' Case SP.PT_GRID ' OmagOFFICEMap.refStatusBarVM.SetSnapPointType(EgtMsg(1104), BtnColor) 'Grid Point ' Case SP.PT_END ' OmagOFFICEMap.refStatusBarVM.SetSnapPointType(EgtMsg(1106), BtnColor) 'End Point ' Case SP.PT_MID ' OmagOFFICEMap.refStatusBarVM.SetSnapPointType(EgtMsg(1108), BtnColor) 'Mid Point ' Case SP.CENTER ' OmagOFFICEMap.refStatusBarVM.SetSnapPointType(EgtMsg(1110), BtnColor) 'Center ' Case SP.CENTROID ' OmagOFFICEMap.refStatusBarVM.SetSnapPointType(EgtMsg(1112), BtnColor) 'Centroid ' Case SP.PT_NEAR ' OmagOFFICEMap.refStatusBarVM.SetSnapPointType(EgtMsg(1114), BtnColor) 'Near Point ' Case SP.PT_INTERS ' OmagOFFICEMap.refStatusBarVM.SetSnapPointType(EgtMsg(1116), BtnColor) 'Inters Point ' Case SP.PT_TANGENT ' OmagOFFICEMap.refStatusBarVM.SetSnapPointType(EgtMsg(1118), BtnColor) 'Tang Point ' Case SP.PT_PERPENDICULAR ' OmagOFFICEMap.refStatusBarVM.SetSnapPointType(EgtMsg(1120), BtnColor) 'Perp Point ' Case SP.PT_MINDIST ' OmagOFFICEMap.refStatusBarVM.SetSnapPointType(EgtMsg(1122), BtnColor) 'MinDist Point ' Case Else ' OmagOFFICEMap.refStatusBarVM.SetSnapPointType("---", BtnColor) ' End Select 'End Sub Private m_bDrag As Boolean = False Private m_nIdToSel As Integer = GDB_ID.NULL Private m_nIdToDesel As Integer = GDB_ID.NULL Private m_bDragToStart As Boolean = False Private m_locPrev As System.Drawing.Point Private m_ptPrev As Point3d Private m_bVerify As Boolean = False Private m_vtTotMove As Vector3d Private m_bDragging As Boolean = False Private m_nRestRadius As Integer = 3 Private m_Rotate As Boolean = False ' selezione degli oggetti nella grafica Friend Sub OnMouseDownScene(sender As Object, e As Windows.Forms.MouseEventArgs) If Not e.Button = Forms.MouseButtons.Left Then Return ' devo attendere che sia terminato lo scarico della tavola 1 -> GetPart(Place.ON_TABLE).Count = 0 If Not IsNothing(Map.refUnloadingAreaVM) AndAlso Not Map.refUnloadingAreaVM.IsChecked_Manual Then Return ' Per default no drag m_bDrag = False ' Verifico se selezionato indicativo di pezzo EgtSetObjFilterForSelWin(True, True, True, True, True) Dim nSel As Integer EgtSelect(e.Location, Scene.DIM_SEL, Scene.DIM_SEL, nSel) Dim nId As Integer = EgtGetFirstObjInSelWin() 'usato come test (tutto in una sola funzione) Dim nPartId As Integer = EgtGetParent(EgtGetParent(nId)) If EgtGetRawPartFromPart(nPartId) = GDB_ID.NULL Then Return Dim nStat As Integer = GDB_ST.ON_ EgtGetStatus(nPartId, nStat) 'If nStat = GDB_ST.SEL Then ' EgtDeselectObj(nPartId) 'Else ' EgtSelectObj(nPartId) 'End If While nId <> GDB_ID.NULL ' Recupero l'identificativo del pezzo cui appartiene nPartId = EgtGetParent(EgtGetParent(nId)) Dim bPartInTable As Boolean = (EgtGetParent(nPartId) = GetRawId()) If EgtGetRawPartFromPart(nPartId) <> GDB_ID.NULL Then 'Dim nStat As Integer = GDB_ST.ON_ ' recupero lo stato del pezzo EgtGetStatus(nPartId, nStat) ' Se già selezionato If nStat = GDB_ST.SEL Then ' Memorizzo Id da deselezionare m_nIdToDesel = nPartId Else ' Memorizzo Id da selezionare m_nIdToSel = nPartId End If ' Drag possibile m_bDrag = True Exit While End If nId = EgtGetNextObjInSelWin() End While ' Dati per drag m_locPrev = e.Location m_bDrag = m_bDrag AndAlso EgtUnProjectPoint(e.Location, m_ptPrev) m_bDragToStart = m_bDrag m_bVerify = m_bDrag AndAlso (Keyboard.Modifiers And ModifierKeys.Shift) > 0 m_vtTotMove = Vector3d.NULL() m_Rotate = m_bDrag AndAlso (Keyboard.Modifiers And ModifierKeys.Control) > 0 End Sub ' movimento degli oggetti nella scena Friend Sub OnMouseMoveScene(sender As Object, e As System.Windows.Forms.MouseEventArgs) ' Se drag non abilitato o già in esecuzione, esco If Not m_bDrag Or m_bDragging Then Return ' Se primo movimento di drag, verifico di aver superato la soglia di movimento in pixel If m_bDragToStart Then If Math.Abs(e.Location.X - m_locPrev.X) < m_nRestRadius And Math.Abs(e.Location.Y - m_locPrev.Y) < m_nRestRadius Then Return End If m_bDragToStart = False End If ' Determino cosa muovere Dim nMoveId = If(m_nIdToSel <> GDB_ID.NULL, m_nIdToSel, GDB_ID.SEL) '' Verifico se in tavola o in parcheggio 'Dim nTestId = If(nMoveId <> GDB_ID.SEL, nMoveId, EgtGetFirstSelectedObj()) 'If EgtGetParent(nTestId) <> GetRawId() Then ' ' Dal parcheggio ammesso drag di un singolo pezzo ' If nMoveId = GDB_ID.SEL Then Return ' ' Applico le lavorazioni al pezzo ' Dim b3Curr As New BBox3d ' EgtGetBBoxGlob(EgtGetFirstNameInGroup(nTestId, NAME_REGION), BBFLAG, b3Curr) ' If Not EstCalc.PreInsertOnePart(nTestId) Then Return ' Dim b3Ins As New BBox3d ' EgtGetBBoxGlob(EgtGetFirstNameInGroup(nTestId, NAME_REGION), BBFLAG, b3Ins) ' Dim vtDiff As New Vector3d(b3Curr.Min().x - b3Ins.Min().x, b3Curr.Min().y - b3Ins.Min().y, 0) ' EgtMove(nMoveId, vtDiff) ' '' Gestione VeinMatching ' 'VeinMatching.OnInsertPartInRaw(nMoveId) ' ' Imposto stato ' m_bVerify = True ' m_bFromParking = True 'End If ' Inizio esecuzione di drag m_bDragging = True ' Ricavo il punto corrente in coordinate mondo Dim ptCurr As Point3d EgtUnProjectPoint(e.Location, ptCurr) ' Ricavo il vettore di movimento Dim vtMove As New Vector3d(ptCurr.x - m_ptPrev.x, ptCurr.y - m_ptPrev.y, 0) ' Muovo i pezzi selezionati di quanto possibile If vtMove.SqLen() > EPS_SMALL * EPS_SMALL Then ' Se movimento con sola verifica finale If m_bVerify Then EgtMove(nMoveId, vtMove) m_vtTotMove += vtMove ' altrimenti caso con verifica durante il movimento 'Else ' ' Aggiorno regioni per nesting ' UpdateNestRegions() ' EnableReferenceRegion(False) ' ' muovo il pezzo ' EgtMovePart(nMoveId, CurrentMachine.bReducedCut, vtMove) ' EgtSaveCollInfo() ' ' se movimento risultante nullo, provo con movimento tangente ' Dim bTgMoved As Boolean = False ' If vtMove.IsSmall() Then ' ' riprovo con movimento tangente ' Dim vtTgMove As Vector3d = ptCurr - m_ptPrev ' EgtTgMovePartOnCollision(nMoveId, CurrentMachine.bReducedCut, vtTgMove) ' bTgMoved = (Not vtTgMove.IsSmall()) ' End If ' ' se abilitato magnetico (allineamento + snap), lo provo ' Dim bAlignMoved As Boolean = False ' Dim bSnapMoved As Boolean = False ' If m_bMagnetic Then ' If Not GetLockOnRotation(nMoveId) Then ' EgtAlignPartOnCollision(nMoveId, CurrentMachine.bReducedCut, bAlignMoved) ' End If ' If m_dSnapDist > EPS_SMALL Then ' EgtRestoreCollInfo() ' EgtMovePartToSnapPointOnCollision(nMoveId, CurrentMachine.bReducedCut, m_dSnapDist, bSnapMoved) ' End If ' End If ' EstCalc.ResetOrderMachiningFlag() ElseIf m_Rotate Then Dim ptCen As Point3d If Not EgtGetPartPartClusterCenterGlob(nMoveId, ptCen) Then Return Dim dLen, dAngV, dAngHPrev, dAngHCurr As Double Dim vtPrev As Vector3d = m_ptPrev - ptCen Dim vtCurr As Vector3d = ptCurr - ptCen vtPrev.ToSpherical(dLen, dAngV, dAngHPrev) vtCurr.ToSpherical(dLen, dAngV, dAngHCurr) Dim dAngRotDeg As Double = If(dAngHCurr < 0, 360 + dAngHCurr, dAngHCurr) - If(dAngHPrev < 0, 360 + dAngHPrev, dAngHPrev) EgtRotate(nMoveId, ptCen, Vector3d.Z_AX(), dAngRotDeg, GDB_RT.GLOB) End If EgtDraw() End If ' Aggiorno il punto precedente m_ptPrev = ptCurr ' Terminata esecuzione di drag m_bDragging = False End Sub Private m_nPartPos As Integer = PART_POS.NONE_TABLE Enum PART_POS As Integer IN_TABLE = -1 NONE_TABLE = 0 OUT_TABLE = 1 End Enum Friend Sub OnMouseUpScene(sender As Object, e As System.Windows.Forms.MouseEventArgs) ' Se eseguito drag If Not m_bDragToStart Then ''Se movimento con sola verifica finale 'If m_bVerify Then '' Determino cosa verificare 'Dim nMoveId = If(m_nIdToSel <> GDB_ID.NULL, m_nIdToSel, GDB_ID.SEL) '' Aggiorno regioni per nesting ' UpdateNestRegions() ' EnableReferenceRegion(False) '' Eseguo verifica ' If EgtVerifyPart(nMoveId, CurrentMachine.bReducedCut) Then ' EstCalc.ResetOrderMachiningFlag() ' Non superata riporto alla posizione iniziale ' Else ' If m_bFromParking Then ' PreRemoveOnePart(nMoveId) ' VeinMatching.OnRemovePartFromRaw(nMoveId) ' Else ' EgtMove(nMoveId, -m_vtTotMove) '' Eventuale notifica al VeinMatching ' If nMoveId = GDB_ID.SEL Then ' Dim nId As Integer = EgtGetFirstSelectedObj() ' While nId <> GDB_ID.NULL ' VeinMatching.OnMovePartInRaw(nId) ' nId = EgtGetNextSelectedObj() ' End While ' Else ' VeinMatching.OnMovePartInRaw(nMoveId) ' End If ' End If ' End If ' m_bFromParking = False '' altrimenti caso con verifica durante il movimento 'Else '' Basta Reset alla fine 'End If 'Se selezione da eseguire ---> ElseIf ElseIf m_nIdToSel <> GDB_ID.NULL Then ' Eseguo la selezione EgtSelectObj(m_nIdToSel) ' Se deselezione da eseguire ElseIf m_nIdToDesel <> GDB_ID.NULL Then EgtDeselectObj(m_nIdToDesel) End If ' Reset m_bDrag = False m_nIdToSel = GDB_ID.NULL m_nIdToDesel = GDB_ID.NULL '' Se nessun pezzo selezionato, reset flag posizione selezionati 'If EgtGetSelectedObjCount() = 0 Then ' m_nPartPos = PART_POS.NONE_TABLE 'End If EgtDraw() End Sub #End Region ' EVENTS #Region "COMMAND" Public ReadOnly Property ConfirmManualPart_Command() As ICommand Get If m_cmdConfirmManaulPart Is Nothing Then m_cmdConfirmManaulPart = New Command(AddressOf ConfirmManualPart) End If Return m_cmdConfirmManaulPart End Get End Property ' comunico che è terminata la selezione dei pezzi manuali Public Sub ConfirmManualPart() If VisibilityManulaPartCommand <> Visibility.Visible Then Return Map.refUnloadingAreaVM.IsChecked_Manual = False NotifyPropertyChanged("VisibilityManulaPartCommand") End Sub #End Region ' COMMAND End Class