Samuele E. Locatelli
614 lines
26 KiB
VB.net
614 lines
26 KiB
VB.net
Imports System.Windows.Interop
|
|
Imports System.IO
|
|
Imports EgtUILib
|
|
Imports EgtWPFLib5
|
|
|
|
Public Class MySceneHostVM
|
|
Inherits EgtWPFLib5.SceneHostVM
|
|
|
|
' Identificativi per pezzo da selezionare/deselezionare
|
|
Private m_nIdToSel As Integer = GDB_ID.NULL
|
|
Private m_nIdToDesel As Integer = GDB_ID.NULL
|
|
' Dati movimento
|
|
Private m_dMaxStep As Double = 0
|
|
' Dati per Drag
|
|
Private m_nRestRadius As Integer = 3
|
|
Private m_bDrag As Boolean = False
|
|
Private m_bDragToStart As Boolean = False
|
|
Private m_bVerify As Boolean = False
|
|
Private m_bFromParking As Boolean = False
|
|
Private m_bDragging As Boolean = False
|
|
Private m_locPrev As System.Drawing.Point
|
|
Private m_ptPrev As Point3d
|
|
Private m_vtTotMove As Vector3d
|
|
Private m_dSnapDist As Double = 0
|
|
|
|
|
|
Private bReducedCut As Boolean = False
|
|
Private m_bMagnetic As Boolean
|
|
|
|
|
|
#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
|
|
AddHandler MainController.OnImportingProject, AddressOf OnImportingProject
|
|
AddHandler MainController.OnImportedProject, AddressOf OnImportedProject
|
|
End Sub
|
|
|
|
#End Region ' CONSTRUCTOR
|
|
|
|
#Region "METHODS"
|
|
|
|
Overrides Sub InitScene()
|
|
InitSceneEvents()
|
|
' Inizializzazione Scena
|
|
PreInitializeScene()
|
|
' Se tutto bene
|
|
If MainScene.Init() Then 'And Map.refMainWindowVM.MainWindowM.GetKeyOption(KEY_OPT.OFFICE_BASE) 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)
|
|
EgtSetCurrentContext(MainScene.GetCtx())
|
|
' inizializzo gestore travi e pareti
|
|
EgtInitBeamMgr(EIB_FL.TS3_POS + EIB_FL.USEUATTR)
|
|
' inizializzo gestore lavorazioni
|
|
EgtInitMachMgr(Map.refMainWindowVM.MainWindowM.sMachinesRoot, Map.refMainWindowVM.MainWindowM.sToolMakersDir)
|
|
' Seleziono la macchina impostata nel file ini
|
|
Map.refMachinePanelVM.LoadCurrentMachine()
|
|
Return
|
|
End If
|
|
' Problemi
|
|
' Se manca la chiave
|
|
If Map.refMainWindowVM.MainWindowM.nKeyLevel = -1 Or Map.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(Map.refMainWindowVM.MainWindowM.sConfigDir), StringComparison.OrdinalIgnoreCase) Then
|
|
Try
|
|
File.Copy(LicDlg.FileName, Path.Combine(Map.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)
|
|
' Map.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
|
|
|
|
#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
|
|
|
|
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
|
|
|
|
Public Overrides Sub ImportProject()
|
|
Dim sDir As String = String.Empty
|
|
GetMainPrivateProfileString(S_MRUIMPORT, K_FILE & "1", "", sDir)
|
|
If Not String.IsNullOrWhiteSpace(sDir) Then
|
|
sDir = Path.GetDirectoryName(sDir)
|
|
End If
|
|
sDir.TrimEnd("\"c)
|
|
MainController.ImportProject(sDir)
|
|
End Sub
|
|
|
|
#End Region ' ProjectManager
|
|
|
|
#Region "EVENTS"
|
|
|
|
Private Sub OnNewProject(sender As Object, bOk As Boolean)
|
|
Map.refMainWindowVM.SetTitle(" New - EgtBEAMWALL")
|
|
Map.refProjectVM.BTLStructure = BTLStructure.Empty
|
|
End Sub
|
|
|
|
Private Sub OnOpenProject(sender As Object, sFile As String, bOk As Boolean)
|
|
' Procedo a seconda del risultato
|
|
If bOk Then
|
|
' leggo struttura BTL
|
|
Map.refProjectVM.BTLStructure = BTLStructure.Init()
|
|
If Map.refMainMenuVM.SelPage = Pages.MACHINING Then
|
|
Map.refProjectVM.MachGroupPanelVM = New MyMachGroupPanelVM
|
|
End If
|
|
Map.refProjectVM.BTLStructure.ShowAll()
|
|
WriteMainPrivateProfileString(S_GENERAL, K_LASTPROJ, sFile)
|
|
Else
|
|
EgtNewFile()
|
|
Map.refMainWindowVM.SetTitle(" New - EgtBEAMWALL")
|
|
Dim sMsg As String = EgtMsg(10003) & " '" & sFile & "'" 'Error opening file
|
|
MessageBox.Show(sMsg, EgtMsg(10001), MessageBoxButton.OK, MessageBoxImage.Error) 'Error
|
|
End If
|
|
MainScene.SetStatusNull()
|
|
End Sub
|
|
|
|
Private Sub OnSavingProject(ByVal sender As Object, sFile As String)
|
|
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
|
|
Dim sMsg As String = EgtMsg(10004) & " '" & sFile & "'" 'Error saving file
|
|
MessageBox.Show(sMsg, EgtMsg(10001), MessageBoxButton.OK, MessageBoxImage.Error) ' Error
|
|
Return
|
|
End If
|
|
' Salvo nome ultimo file
|
|
WriteMainPrivateProfileString(S_GENERAL, K_LASTPROJ, sFile)
|
|
End Sub
|
|
|
|
Private Sub OnImportingProject(sender As Object, nType As Integer, ByRef nFlag As Integer)
|
|
If nType = FT.BTL Or nType = FT.BTLX Then
|
|
nFlag = GetMainPrivateProfileInt(S_IMPORT, K_BTLFLAG, EIB_FL.TS3_POS + EIB_FL.SORT + EIB_FL.USEUATTR)
|
|
Else
|
|
MessageBox.Show(Application.Current.MainWindow, EgtMsg(10005), EgtMsg(10001), MessageBoxButton.OK, MessageBoxImage.Error) ' File type unknown - Error
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub OnImportedProject(ByVal sender As Object, ByVal sFile As String, ByVal bOk As Boolean)
|
|
WriteMainPrivateProfileString(S_GENERAL, K_LASTIMPDIR, Path.GetDirectoryName(sFile))
|
|
If bOk Then
|
|
' leggo struttura BTL
|
|
Map.refProjectVM.BTLStructure = BTLStructure.Init()
|
|
' Ricavo il tipo di Warehouse settato nell'INI
|
|
Dim nDefault As Integer = 1
|
|
If GetMainPrivateProfileInt(S_GENERAL, K_WAREHOUSE, nDefault) = WarehouseType.MEDIUM Then
|
|
' Se di tipo Medium confronto le Sezioni del BTL importato con quelle in Warehouse
|
|
WarehouseWndVM.CheckExistingSectionXMaterial()
|
|
End If
|
|
' scrivo in ogni pezzo identificativo proj
|
|
Dim nPartId As Integer = EgtGetFirstPart()
|
|
While nPartId <> GDB_ID.NULL
|
|
' guardo se esiste info numero progetto a cui appartiene
|
|
If Not EgtGetInfo(nPartId, PROJ, Map.refProjManagerVM.nLastProjId) Then
|
|
EgtSetInfo(nPartId, PROJ, Map.refProjManagerVM.nLastProjId)
|
|
End If
|
|
nPartId = EgtGetNextPart(nPartId)
|
|
End While
|
|
' mostro tutti i pezzi
|
|
Map.refProjectVM.BTLStructure.ShowAll()
|
|
Else
|
|
Dim sMsg As String = EgtMsg(10006) & " '" & sFile & "'" 'Error importing file
|
|
MessageBox.Show(Application.Current.MainWindow, sMsg, EgtMsg(10001), MessageBoxButton.OK, MessageBoxImage.Error) ' Error
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub OnMouseDownScene(sender As Object, e As Windows.Forms.MouseEventArgs)
|
|
If e.Button = Forms.MouseButtons.Middle Then Return
|
|
Select Case Map.refMainMenuVM.SelPage
|
|
Case Pages.VIEW
|
|
If Not IsNothing(Map.refProjectVM.BTLStructure) Then
|
|
View_OnMouseDownScene(sender, e)
|
|
End If
|
|
Case Pages.MACHINING
|
|
If Not IsNothing(Map.refMachGroupPanelVM) AndAlso Not IsNothing(Map.refMachGroupPanelVM.SelectedMachGroup) Then
|
|
Dim SelectedMachGroup As Core.MyMachGroup = DirectCast(Map.refMachGroupPanelVM.SelectedMachGroup, Core.MyMachGroup)
|
|
If SelectedMachGroup.nMachineType = MachineType.WALL Then
|
|
Wall_OnMouseDownScene(sender, e)
|
|
End If
|
|
End If
|
|
End Select
|
|
End Sub
|
|
|
|
Private Sub OnMouseMoveScene(sender As Object, e As Windows.Forms.MouseEventArgs)
|
|
If e.Button = Forms.MouseButtons.Middle Then Return
|
|
Select Case Map.refMainMenuVM.SelPage
|
|
Case Pages.VIEW
|
|
If Not IsNothing(Map.refProjectVM.BTLStructure) Then
|
|
View_OnMouseMoveScene(sender, e)
|
|
End If
|
|
Case Pages.MACHINING
|
|
If Not IsNothing(Map.refMachGroupPanelVM) AndAlso Not IsNothing(Map.refMachGroupPanelVM.SelectedMachGroup) Then
|
|
Dim SelectedMachGroup As Core.MyMachGroup = DirectCast(Map.refMachGroupPanelVM.SelectedMachGroup, Core.MyMachGroup)
|
|
If SelectedMachGroup.nMachineType = MachineType.WALL Then
|
|
Wall_OnMouseMoveScene(sender, e)
|
|
End If
|
|
End If
|
|
End Select
|
|
End Sub
|
|
|
|
Private Sub OnMouseUpScene(sender As Object, e As Windows.Forms.MouseEventArgs)
|
|
If e.Button = Forms.MouseButtons.Middle Then Return
|
|
Select Case Map.refMainMenuVM.SelPage
|
|
Case Pages.VIEW
|
|
If Not IsNothing(Map.refProjectVM.BTLStructure) Then
|
|
View_OnMouseUpScene(sender, e)
|
|
End If
|
|
Case Pages.MACHINING
|
|
If Not IsNothing(Map.refMachGroupPanelVM) AndAlso Not IsNothing(Map.refMachGroupPanelVM.SelectedMachGroup) Then
|
|
Dim SelectedMachGroup As Core.MyMachGroup = DirectCast(Map.refMachGroupPanelVM.SelectedMachGroup, Core.MyMachGroup)
|
|
If SelectedMachGroup.nMachineType = MachineType.WALL Then
|
|
Wall_OnMouseUpScene(sender, e)
|
|
End If
|
|
End If
|
|
End Select
|
|
|
|
End Sub
|
|
|
|
Private Sub OnKeyDownScene(sender As Object, e As System.Windows.Forms.KeyEventArgs)
|
|
End Sub
|
|
|
|
Private Sub OnCursorPos(ByVal sender As Object, ByVal sCursorPos As String)
|
|
'Map.refStatusBarVM.SetCurrPos(sCursorPos)
|
|
End Sub
|
|
|
|
Private Sub OnShowDistance(ByVal sender As Object, ByVal sDistance As String)
|
|
Map.refMyStatusBarVM.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
|
|
' Map.refStatusBarVM.SetSnapPointType(EgtMsg(1102), BtnColor) 'Sketch Point
|
|
' Case SP.PT_GRID
|
|
' Map.refStatusBarVM.SetSnapPointType(EgtMsg(1104), BtnColor) 'Grid Point
|
|
' Case SP.PT_END
|
|
' Map.refStatusBarVM.SetSnapPointType(EgtMsg(1106), BtnColor) 'End Point
|
|
' Case SP.PT_MID
|
|
' Map.refStatusBarVM.SetSnapPointType(EgtMsg(1108), BtnColor) 'Mid Point
|
|
' Case SP.CENTER
|
|
' Map.refStatusBarVM.SetSnapPointType(EgtMsg(1110), BtnColor) 'Center
|
|
' Case SP.CENTROID
|
|
' Map.refStatusBarVM.SetSnapPointType(EgtMsg(1112), BtnColor) 'Centroid
|
|
' Case SP.PT_NEAR
|
|
' Map.refStatusBarVM.SetSnapPointType(EgtMsg(1114), BtnColor) 'Near Point
|
|
' Case SP.PT_INTERS
|
|
' Map.refStatusBarVM.SetSnapPointType(EgtMsg(1116), BtnColor) 'Inters Point
|
|
' Case SP.PT_TANGENT
|
|
' Map.refStatusBarVM.SetSnapPointType(EgtMsg(1118), BtnColor) 'Tang Point
|
|
' Case SP.PT_PERPENDICULAR
|
|
' Map.refStatusBarVM.SetSnapPointType(EgtMsg(1120), BtnColor) 'Perp Point
|
|
' Case SP.PT_MINDIST
|
|
' Map.refStatusBarVM.SetSnapPointType(EgtMsg(1122), BtnColor) 'MinDist Point
|
|
' Case Else
|
|
' Map.refStatusBarVM.SetSnapPointType("---", BtnColor)
|
|
'End Select
|
|
End Sub
|
|
|
|
#End Region ' EVENTS
|
|
|
|
#Region "WALL EVENTS"
|
|
|
|
Friend Sub Wall_OnMouseDownScene(sender As Object, e As Windows.Forms.MouseEventArgs)
|
|
' 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()
|
|
While nId <> GDB_ID.NULL
|
|
' Recupero l'identificativo del pezzo cui appartiene
|
|
Dim nPartId As Integer = EgtGetParent(EgtGetParent(nId))
|
|
Dim WallMachGroup As WallMachGroup = DirectCast(Map.refMachGroupPanelVM.SelectedMachGroup, WallMachGroup)
|
|
Dim bPartInTable As Boolean = (EgtGetParent(nPartId) = WallMachGroup.nRawPartId)
|
|
If EgtIsPart(nPartId) OrElse EgtIsDuplo(nPartId) OrElse bPartInTable Then
|
|
Dim nStat As Integer = GDB_ST.ON_
|
|
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()
|
|
End Sub
|
|
|
|
Friend Sub Wall_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)
|
|
' 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 Vector3d = ptCurr - m_ptPrev
|
|
' 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
|
|
Dim x = EgtMove(nMoveId, vtMove)
|
|
m_vtTotMove += vtMove
|
|
' altrimenti caso con verifica durante il movimento
|
|
Else
|
|
'' Aggiorno regioni per nesting
|
|
'UpdateNestRegions() !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
'EnableReferenceRegion(False)
|
|
' muovo il pezzo
|
|
Dim x = EgtMovePartInRawPart(nMoveId, vtMove) 'EgtMovePart(nMoveId, 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, 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, bReducedCut, bAlignMoved)
|
|
'End If
|
|
If m_dSnapDist > EPS_SMALL Then
|
|
EgtRestoreCollInfo()
|
|
EgtMovePartToSnapPointOnCollision(nMoveId, bReducedCut, m_dSnapDist, bSnapMoved)
|
|
End If
|
|
End If
|
|
End If
|
|
EgtDraw()
|
|
End If
|
|
' Aggiorno il punto precedente
|
|
m_ptPrev = ptCurr
|
|
' Terminata esecuzione di drag
|
|
m_bDragging = False
|
|
End Sub
|
|
|
|
Friend Sub Wall_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, bReducedCut) Then
|
|
' Non superata riporto alla posizione iniziale
|
|
Else
|
|
EgtMove(nMoveId, -m_vtTotMove)
|
|
End If
|
|
'm_bFromParking = False
|
|
' altrimenti caso con verifica durante il movimento
|
|
Else
|
|
' Basta reset alla fine
|
|
End If
|
|
' Se selezione da eseguire
|
|
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 ' WALL EVENTS
|
|
|
|
#Region "VIEW EVENTS"
|
|
|
|
Friend Sub View_OnMouseDownScene(sender As Object, e As Windows.Forms.MouseEventArgs)
|
|
' 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()
|
|
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)
|
|
' 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
|
|
Exit While
|
|
End If
|
|
nId = EgtGetNextObjInSelWin()
|
|
End While
|
|
' Dati per drag
|
|
m_bDragToStart = True
|
|
End Sub
|
|
|
|
Friend Sub View_OnMouseMoveScene(sender As Object, e As System.Windows.Forms.MouseEventArgs)
|
|
' Se drag non abilitato o già in esecuzione, esco
|
|
If Not m_bDragToStart 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
|
|
End Sub
|
|
|
|
Friend Sub View_OnMouseUpScene(sender As Object, e As System.Windows.Forms.MouseEventArgs)
|
|
' Se eseguito drag
|
|
If Not m_bDragToStart Then
|
|
' Se selezione da eseguire
|
|
ElseIf m_nIdToSel <> GDB_ID.NULL Then
|
|
' Se pezzo da selezionare non è già selezionato
|
|
If IsNothing(Map.refProjectVM.BTLStructure.SelPart) OrElse Map.refProjectVM.BTLStructure.SelPart.nPartId <> m_nIdToSel Then
|
|
' Eseguo la selezione
|
|
Map.refProjectVM.BTLStructure.SelPart = Map.refProjectVM.BTLStructure.PartList.First(Function(x) x.nPartId = m_nIdToSel)
|
|
End If
|
|
End If
|
|
' Reset
|
|
m_bDrag = False
|
|
m_nIdToSel = GDB_ID.NULL
|
|
m_nIdToDesel = GDB_ID.NULL
|
|
EgtDraw()
|
|
End Sub
|
|
|
|
#End Region ' VIEW EVENTS
|
|
|
|
End Class
|