'---------------------------------------------------------------------------- ' EgalTech 2014-2015 '---------------------------------------------------------------------------- ' File : Scene.vb Data : 27.01.15 Versione : 1.6a6 ' Contenuto : Classe Scene (parte di MVC). ' ' ' ' Modifiche : 04.11.14 DS Creazione modulo. ' ' '---------------------------------------------------------------------------- Imports System.Math Imports System.IO Imports System.Globalization Imports TestEIn.EgtInterface Public Class Scene '---- Constants ------- Public Const DIM_SEL As Integer = 13 '---- Members --------- Private m_nGseContext As Integer Private m_nStatus As ST Private m_nOldStatus As ST Private Enum ST As Integer NULL = 0 SEL PAN ROT ZOOMWIN WINSEL SELPART SELLAYER SELPATH SELPATHAUTO ANALYZE GETDIST GETDIST2 SELPOINT SELPOINTZ End Enum Private m_nSnapType As SP ' tipo di snap in selezione punto Private m_bAlsoSelDir As Boolean ' abilita anche selezione direzione quando selezione punto Private m_bAlsoDragIntersForSnap As Boolean ' abilita intersezione con drag per snap a punto Private m_bAlsoSurfForSnap As Boolean ' abilita anche le superfici come sorgenti per snap a punto Private m_PrevPoint As Point Private m_ptPrev As Point3d Private m_ptGrid As Point3d Private m_bGridCursorPos As Boolean Private m_nDriver As Integer Private m_b2Buff As Boolean Private m_nColorBits As Integer Private m_nDepthBits As Integer Private m_BackTopColor As Color3d Private m_BackBotColor As Color3d Private m_DefColor As Color3d Private m_MarkColor As Color3d Private m_SelSurfColor As Color3d Private m_bZwOutline As Boolean Private m_ZwColor As Color3d Private m_DstLnColor As Color3d '---- Constructor ----- Sub New() ' Chiamata richiesta dalla finestra di progettazione. InitializeComponent() ' Istruzioni di inizializzazione. Me.BorderStyle = Windows.Forms.BorderStyle.FixedSingle SetStyle(ControlStyles.Opaque, True) SetStyle(ControlStyles.UserPaint, True) SetStyle(ControlStyles.AllPaintingInWmPaint, True) m_nGseContext = 0 m_nStatus = ST.SEL m_nOldStatus = ST.SEL m_nSnapType = SP.PT_GRID m_bAlsoSelDir = False m_bAlsoSurfForSnap = True m_PrevPoint = Point.Empty m_bGridCursorPos = False m_nDriver = 3 m_b2Buff = True m_nColorBits = 24 m_nDepthBits = 32 m_BackTopColor.Setup(140, 154, 168) m_BackBotColor.Setup(40, 44, 48) m_DefColor.Setup(255, 165, 0) m_MarkColor.Setup(255, 255, 0) m_SelSurfColor.Setup(255, 255, 192) m_bZwOutline = True m_ZwColor.Setup(0, 0, 0) m_DstLnColor.Setup(255, 0, 0) Cursor = New Cursor(Me.GetType(), "Select.cur") End Sub '---- Initials -------- Public Sub SetViewAttributes(ByVal nDriver As Integer, ByVal b2Buff As Boolean, ByVal nColorBits As Integer, ByVal nDepthBits As Integer) m_nDriver = nDriver m_b2Buff = b2Buff m_nColorBits = nColorBits m_nDepthBits = nDepthBits End Sub Public Sub SetViewBackground(ByRef BackTopColor As Color3d, ByRef BackBotColor As Color3d) m_BackTopColor = BackTopColor m_BackBotColor = BackBotColor End Sub Public Sub SetDefaultMaterial(ByRef DefColor As Color3d) m_DefColor = DefColor End Sub Public Sub SetMarkMaterial(ByRef DefColor As Color3d) m_MarkColor = DefColor End Sub Public Sub SetSelSurfMaterial(ByRef DefColor As Color3d) m_SelSurfColor = DefColor End Sub Public Sub SetZoomWinAttribs(ByVal bZwOutline As Boolean, ByRef ZwColor As Color3d) m_bZwOutline = bZwOutline m_ZwColor = ZwColor End Sub Public Sub SetDistLineMaterial(ByRef DstLnColor As Color3d) m_DstLnColor = DstLnColor End Sub Public Sub SetGridCursorPos(ByVal bGridCursorPos As Boolean) m_bGridCursorPos = bGridCursorPos End Sub 'Mettere EgtInit, EgtSetKey, EgtSetFont e EgtSetLuaLibsDir nell'evento Load del Form, prima di inizializzare la o le Scene 'Mettere EgtExit nell'evento FormClosing Public Function Init() As Boolean m_nGseContext = EgtInitContext() Dim bOk As Boolean = EgtSetDefaultMaterial(m_DefColor) EgtInitScene(Handle, m_nDriver, m_b2Buff, m_nColorBits, m_nDepthBits) EgtSetBackground(m_BackTopColor, m_BackBotColor) EgtSetMarkAttribs(m_MarkColor) EgtSetSelSurfAttribs(m_SelSurfColor) EgtSetWinRectAttribs(m_bZwOutline, m_ZwColor) EgtSetGeoLineAttribs(m_DstLnColor) EgtSetGeoTriaAttribs(m_DstLnColor) EgtInitTscExec() RaiseEvent OnChangedSnapPointType(Me, m_nSnapType, True) Return bOk End Function Public Sub Terminate() If m_nGseContext <> 0 Then EgtDeleteContext(m_nGseContext) m_nGseContext = 0 End If End Sub Public Function GetCtx() As Integer Return m_nGseContext End Function Protected Overrides Sub OnPaint(e As PaintEventArgs) MyBase.OnPaint(e) ' Se contesto non valido, esco subito If m_nGseContext = 0 Then Return End If ' Salvo il contesto corrente e imposto quello della scena Dim nOldGseCtx = EgtGetCurrentContext() If nOldGseCtx <> m_nGseContext Then EgtSetCurrentContext(m_nGseContext) End If ' Eseguo il disegno EgtDraw() ' Ripristino il contesto originale If nOldGseCtx <> m_nGseContext Then EgtSetCurrentContext(nOldGseCtx) End If End Sub Protected Overrides Sub OnPaintBackground(pevent As PaintEventArgs) MyBase.OnPaintBackground(pevent) End Sub Protected Overrides Sub OnResize(e As System.EventArgs) MyBase.OnResize(e) ' Se contesto non valido, esco subito If m_nGseContext = 0 Then Return End If ' Salvo il contesto corrente e imposto quello della scena Dim nOldGseCtx = EgtGetCurrentContext() If nOldGseCtx <> m_nGseContext Then EgtSetCurrentContext(m_nGseContext) End If ' Eseguo ridimensionamento vista EgtResize(Width, Height) ' Ripristino il contesto originale If nOldGseCtx <> m_nGseContext Then EgtSetCurrentContext(nOldGseCtx) End If End Sub '---- Events ---------- Public Event OnMouseSelectedAll(ByVal sender As Object) Public Event OnMouseDeselectedAll(ByVal sender As Object) Public Event OnMouseSelectedObj(ByVal sender As Object, ByVal nId As Integer, ByVal bLast As Boolean) Public Event OnMouseSelectedPart(ByVal sender As Object, ByVal nId As Integer) Public Event OnMouseSelectedLayer(ByVal sender As Object, ByVal nId As Integer) Public Event OnMouseSelectedPath(ByVal sender As Object, ByVal nId As Integer, ByVal bHaltOnFork As Boolean) Public Event OnMouseAnalyzed(ByVal sender As Object, ByVal nId As Integer) Public Event OnMousePointFromSelection(ByVal sender As Object, ByVal nId As Integer, ByVal PtP As Point3d, ByVal nAux As Integer) Public Event OnMouseDownScene(ByVal sender As Object, e As System.Windows.Forms.MouseEventArgs) Public Event OnCursorPos(ByVal sender As Object, ByVal sCursorPos As String) Public Event OnShowDistance(ByVal sender As Object, ByVal sDistance As String) Public Event OnCloseGetDist(ByVal sender As Object) Public Event OnMouseDone(ByVal sender As Object) Public Event OnMouseSelectedPoint(ByVal sender As Object, ByVal PtP As Point3d, ByVal nSep As SEP, ByVal nId As Integer) Public Event OnMouseSelectedDir(ByVal sender As Object, ByVal VtDir As Vector3d) Public Event OnMouseMoveSelPoint(ByVal sender As Object, ByVal PtP As Point3d) Public Event OnChangedSnapPointType(ByVal sender As Object, ByVal nSpType As SP, ByVal bForced As Boolean) '---- Mouse ----------- ' Per correggere un problema con hot spot cursore, nei file cur è stato spostato di 4 pixel in Y+ (in basso) Protected Overrides Sub OnMouseDown(e As System.Windows.Forms.MouseEventArgs) ' Imposto il contesto della scena come corrente EgtSetCurrentContext(m_nGseContext) ' --- Pressione tasto sinistro --- If e.Button = Windows.Forms.MouseButtons.Left Then ' se stato WINSEL oppure SEL e premuto SHIFT allora inizio selezione a finestra If m_nStatus = ST.WINSEL Or (m_nStatus = ST.SEL And (ModifierKeys And Keys.Shift) = Keys.Shift) Then If m_nStatus <> ST.WINSEL Then Cursor = New Cursor(Me.GetType(), "WinSelect.cur") m_nStatus = ST.WINSEL End If m_PrevPoint = e.Location ' se stato SELPATH, SELPATHAUTO oppure SEL e premuto CONTROL ElseIf m_nStatus = ST.SELPATH Or m_nStatus = ST.SELPATHAUTO Or (m_nStatus = ST.SEL And (ModifierKeys And Keys.Control) = Keys.Control) Then EgtSetObjFilterForSelect(False, True, False, False, False) ' abilito solo le curve Dim nId As Integer = ChooseOneSelectedObj(e.Location) If nId <> GDB_ID.NULL Then RaiseEvent OnMouseSelectedPath(Me, nId, (m_nStatus <> ST.SELPATHAUTO)) Dim PtTemp As Point3d Dim nAux As Integer If EgtGetPointFromSelect(nId, e.Location, PtTemp, nAux) Then RaiseEvent OnMousePointFromSelection(Me, nId, PtTemp, nAux) End If m_nStatus = ST.SEL End If ' se stato SEL, SELPART, SELLAYER ElseIf m_nStatus = ST.SEL Or m_nStatus = ST.SELPART Or m_nStatus = ST.SELLAYER Then EgtSetObjFilterForSelect(True, True, True, True, True) Dim nId As Integer = ChooseOneSelectedObj(e.Location) If nId <> GDB_ID.NULL Then ' evento per entità selezionate Select Case m_nStatus Case ST.SEL RaiseEvent OnMouseSelectedObj(Me, nId, True) Case ST.SELPART RaiseEvent OnMouseSelectedPart(Me, nId) Case ST.SELLAYER RaiseEvent OnMouseSelectedLayer(Me, nId) End Select ' evento per posizione punto di selezione Dim PtTemp As Point3d Dim nAux As Integer If EgtGetPointFromSelect(nId, e.Location, PtTemp, nAux) Then RaiseEvent OnMousePointFromSelection(Me, nId, PtTemp, nAux) End If m_nStatus = ST.SEL End If ' se stato ANALYZE ElseIf m_nStatus = ST.ANALYZE Then EgtSetObjFilterForSelect(True, True, True, True, True) Dim nId As Integer = ChooseOneSelectedObj(e.Location) If nId <> GDB_ID.NULL Then RaiseEvent OnMouseAnalyzed(Me, nId) End If ' se stato GETDIST (primo punto per misura di distanza) ElseIf m_nStatus = ST.GETDIST Then EgtSetObjFilterForSelect(True, True, m_bAlsoSurfForSnap, True, True) If EgtGetGraphicSnapPoint(m_nSnapType, e.Location, DIM_SEL, DIM_SEL, m_ptPrev) Then ' salvo il punto di riferimento Dim ptWin As Point3d EgtProjectPoint(m_ptPrev, ptWin) m_PrevPoint = New Point(ptWin.x, ptWin.y) m_nStatus = ST.GETDIST2 End If ' se stato GETDIST2(secondo punto per misura di distanza) ElseIf m_nStatus = ST.GETDIST2 Then EgtSetObjFilterForSelect(True, True, m_bAlsoSurfForSnap, True, True) Dim ptSel As Point3d If EgtGetGraphicSnapPoint(m_nSnapType, e.Location, DIM_SEL, DIM_SEL, ptSel) Then ' disegno la linea (coordinate geo globali) EgtSetGeoLine(m_ptPrev, ptSel) ' calcolo la distanza e il delta e li visualizzo Dim vtDist As Vector3d = ptSel - m_ptPrev If m_bGridCursorPos Then vtDist.ToLoc(EgtGetGridFrame()) End If Dim sOut As New System.Text.StringBuilder sOut.Append(EgtMsg(1301)) ' Dist= sOut.Append(EgtToUiUnits(vtDist.Len()).ToString("F4", CultureInfo.InvariantCulture)) sOut.Append(" dX=") sOut.Append(EgtToUiUnits(vtDist.x).ToString("F4", CultureInfo.InvariantCulture)) sOut.Append(" dY=") sOut.Append(EgtToUiUnits(vtDist.y).ToString("F4", CultureInfo.InvariantCulture)) sOut.Append(" dZ=") sOut.Append(EgtToUiUnits(vtDist.z).ToString("F4", CultureInfo.InvariantCulture)) ' lancio l'evento per visualizzare la distanza RaiseEvent OnShowDistance(Me, sOut.ToString()) m_nStatus = ST.GETDIST m_nOldStatus = ST.SEL End If ' se stato selezione punto ElseIf m_nStatus = ST.SELPOINT Then EgtSetObjFilterForSelect(True, True, m_bAlsoSurfForSnap, True, True) If Not m_bDragOn Then ' rendo selezionabile gruppo di drag EgtUnselectableRemove(m_nDragGroup) ' eseguo selezione Dim nSel As Integer = GDB_ID.NULL EgtSelect(e.Location, DIM_SEL, DIM_SEL, nSel) ' ripristino stato precedente di selezionabilità drag EgtUnselectableAdd(m_nDragGroup) ' click su geometria di drag equivale a Done Dim nId As Integer = EgtGetFirstObjInSelWin() While nId <> GDB_ID.NULL If EgtGetParent(nId) = m_nDragGroup Then RaiseEvent OnMouseDone(Me) Exit While End If nId = EgtGetNextObjInSelWin() End While Else If m_bAlsoDragIntersForSnap And m_nSnapType = SP.PT_INTERS Then EgtUnselectableRemove(m_nDragGroup) Else EgtUnselectableAdd(m_nDragGroup) End If If EgtGetGraphicSnapPoint(m_nSnapType, e.Location, DIM_SEL, DIM_SEL, m_ptPrev) Then ' se Snap Sketch o Grid e premuto SHIFT si passa a modalità elevatore If (m_nSnapType = SP.PT_SKETCH Or m_nSnapType = SP.PT_GRID) And (ModifierKeys And Keys.Shift) = Keys.Shift Then m_nStatus = ST.SELPOINTZ m_ptGrid = m_ptPrev ' altrimenti si restituisce il punto Else ' se richiesta anche direzione, restituisco prima questa If m_bAlsoSelDir Then Dim vtDir As Vector3d If EgtGetLastSnapDir(vtDir) Then RaiseEvent OnMouseSelectedDir(Me, vtDir) End If End If ' restituisco punto con info ausiliarie Dim nSep As SEP If m_nSnapType = SP.PT_TANGENT Then nSep = SEP.PT_TG ElseIf m_nSnapType = SP.PT_PERPENDICULAR Then nSep = SEP.PT_PERP ElseIf m_nSnapType = SP.PT_MINDIST Then nSep = SEP.PT_MINDIST Else nSep = SEP.PT_STD End If RaiseEvent OnMouseSelectedPoint(Me, m_ptPrev, nSep, EgtGetLastSnapId()) End If End If End If ' se stato selezione Z di punto ElseIf m_nStatus = ST.SELPOINTZ Then If EgtGetGridSnapPointZ((m_nSnapType = SP.PT_SKETCH), e.Location, m_ptGrid, m_ptPrev) Then ' ritorno allo stato base di selezione punto m_nStatus = ST.SELPOINT RaiseEvent OnMouseSelectedPoint(Me, m_ptPrev, SEP.PT_STD, GDB_ID.NULL) ' non ci può essere selezione di ddirezione End If End If ' --- Pressione tasto medio (rotella) --- ElseIf e.Button = Windows.Forms.MouseButtons.Middle Then ' devo essere in uno stato ripristinabile If IsRestorableCurrStatus() Then ' se premuto SHIFT entro in zoom a finestra If (ModifierKeys And Keys.Shift) = Keys.Shift Then SaveCurrStatus() m_nStatus = ST.ZOOMWIN Cursor = New Cursor(Me.GetType(), "ZoomWin.cur") ' se premuto CTRL entro in rotazione vista ElseIf (ModifierKeys And Keys.Control) = Keys.Control Then SaveCurrStatus() m_nStatus = ST.ROT Cursor = New Cursor(Me.GetType(), "Rotate.cur") ' altrimenti entro in pan Else SaveCurrStatus() m_nStatus = ST.PAN Cursor = New Cursor(Me.GetType(), "Pan.cur") End If ' salvo il punto in coordinate finestra m_PrevPoint = e.Location End If ' --- Tutti gli altri casi --- Else MyBase.OnMouseDown(e) End If Focus() RaiseEvent OnMouseDownScene(Me, e) End Sub Protected Overrides Sub OnMouseUp(e As System.Windows.Forms.MouseEventArgs) ' salvo il contesto corrente e imposto quello della scena Dim nOldGseCtx = EgtGetCurrentContext() If nOldGseCtx <> m_nGseContext Then EgtSetCurrentContext(m_nGseContext) End If ' --- Rilascio tasto sinistro --- If e.Button = Windows.Forms.MouseButtons.Left Then If m_nStatus = ST.WINSEL Then EgtResetWinRect(True) ' determino entità selezionate Dim Center As Point Center.X = 0.5 * (e.Location.X + m_PrevPoint.X) Center.Y = 0.5 * (e.Location.Y + m_PrevPoint.Y) Dim nH As Integer = Abs(e.Location.X - m_PrevPoint.X) Dim nW As Integer = Abs(e.Location.Y - m_PrevPoint.Y) Dim nSel As Integer EgtSelect(Center, nH, nW, nSel) ' notifico per ogni entità selezionata Dim nLastId = GDB_ID.NULL Dim nId = EgtGetFirstObjInSelWin() While nId <> GDB_ID.NULL Dim nNextId = EgtGetNextObjInSelWin() RaiseEvent OnMouseSelectedObj(Me, nId, (nNextId = GDB_ID.NULL)) nLastId = nId nId = nNextId End While ' evento per posizione punto di selezione Dim PtTemp As Point3d Dim nAux As Integer If EgtGetPointFromSelect(nLastId, e.Location, PtTemp, nAux) Then RaiseEvent OnMousePointFromSelection(Me, nLastId, PtTemp, nAux) End If ' ritorno allo stato SEL m_nStatus = ST.SEL Cursor = New Cursor(Me.GetType(), "Select.cur") End If ' --- Rilascio tasto medio (rotella) --- ElseIf e.Button = Windows.Forms.MouseButtons.Middle Then If m_nStatus = ST.ZOOMWIN Then EgtResetWinRect(False) EgtZoomWin(m_PrevPoint, e.Location, True) End If ' eventuale ripristino vecchio stato If RestoreStatus() Then ' non devo fare alcunché ' reset dello stato se non SEL ElseIf m_nStatus <> ST.SEL Then m_nStatus = ST.SEL Cursor = New Cursor(Me.GetType(), "Select.cur") End If ' --- Rilascio tasto destro --- ElseIf e.Button = Windows.Forms.MouseButtons.Right Then ' sistemazioni menù contestuale PrepareMenuScene() ' --- Tutti gli altri casi --- Else MyBase.OnMouseUp(e) End If ' Ripristino il contesto originale If nOldGseCtx <> m_nGseContext Then EgtSetCurrentContext(nOldGseCtx) End If End Sub Protected Overrides Sub OnMouseMove(e As System.Windows.Forms.MouseEventArgs) ' Salvo il contesto corrente e imposto quello della scena Dim nOldGseCtx = EgtGetCurrentContext() If nOldGseCtx <> m_nGseContext Then EgtSetCurrentContext(m_nGseContext) End If ' Se sono abbastanza all'interno della scena (10% della dimensione), imposto il focus Const BordPu As Double = 0.10000000000000001 If e.Location.X > BordPu * Size.Width AndAlso e.Location.X < (1 - BordPu) * Size.Width AndAlso e.Location.Y > BordPu * Size.Height AndAlso e.Location.Y < (1 - BordPu) * Size.Height Then Focus() End If ' Visualizzo le coordinate del mouse ShowCursorPos(e.Location) ' --- Premuto tasto sinistro --- If e.Button = Windows.Forms.MouseButtons.Left Then If m_nStatus = ST.WINSEL Then Cursor = New Cursor(Me.GetType(), "WinSelect.cur") EgtSetWinRect(m_PrevPoint, e.Location, True) End If ' --- Premuto tasto centrale (rotella) --- ElseIf e.Button = Windows.Forms.MouseButtons.Middle Then If m_nStatus = ST.ZOOMWIN Then Cursor = New Cursor(Me.GetType(), "ZoomWin.cur") EgtSetWinRect(m_PrevPoint, e.Location, True) 'Il punto di riferimento deve rimanere quello originale ElseIf m_nStatus = ST.ROT Then Cursor = New Cursor(Me.GetType(), "Rotate.cur") EgtRotateView(m_PrevPoint, e.Location, True) m_PrevPoint = e.Location ElseIf m_nStatus = ST.PAN Then Cursor = New Cursor(Me.GetType(), "Pan.cur") EgtPanView(m_PrevPoint, e.Location, True) m_PrevPoint = e.Location Else m_nStatus = ST.SEL End If ' --- Altri casi dipendenti dallo stato --- ElseIf m_nStatus = ST.WINSEL Then Cursor = New Cursor(Me.GetType(), "WinSelect.cur") ElseIf m_nStatus = ST.ANALYZE Then Cursor = New Cursor(Me.GetType(), "Analyze.cur") ElseIf m_nStatus = ST.GETDIST Then Cursor = New Cursor(Me.GetType(), "GetDist.cur") ElseIf m_nStatus = ST.GETDIST2 Then Cursor = New Cursor(Me.GetType(), "GetDist.cur") Dim ptP As Point3d EgtUnProjectPoint(e.Location, ptP) EgtSetGeoLine(m_ptPrev, ptP) ElseIf m_nStatus = ST.SELPOINT Then Cursor = New Cursor(Me.GetType(), "SelPoint.cur") Dim ptP As Point3d If EgtGetGraphicSnapPoint(If(m_nSnapType = SP.PT_GRID, SP.PT_GRID, SP.PT_SKETCH), e.Location, DIM_SEL, DIM_SEL, ptP) Then If m_bDragOn Then RaiseEvent OnMouseMoveSelPoint(Me, ptP) End If End If ElseIf m_nStatus = ST.SELPOINTZ Then Cursor = New Cursor(Me.GetType(), "SelPoint.cur") Dim ptP As Point3d If EgtGetGridSnapPointZ((m_nSnapType = SP.PT_SKETCH), e.Location, m_ptGrid, ptP) Then EgtSetGeoLine(m_ptGrid, ptP) If m_bDragOn Then RaiseEvent OnMouseMoveSelPoint(Me, ptP) End If End If Else MyBase.OnMouseMove(e) End If If m_nStatus = ST.NULL Then Cursor = Cursors.Default ElseIf m_nStatus = ST.SEL Then Cursor = New Cursor(Me.GetType(), "Select.cur") End If ' Ripristino il contesto originale If nOldGseCtx <> m_nGseContext Then EgtSetCurrentContext(nOldGseCtx) End If End Sub Protected Overrides Sub OnMouseWheel(e As System.Windows.Forms.MouseEventArgs) ' devo essere in uno stato ripristinabile If Not IsRestorableCurrStatus() Then Return End If ' trascuro rotazioni molto piccole If Abs(e.Delta) < 30 Then Return End If ' calcolo coefficiente Const WHEEL_DELTA As Double = 120 Dim dCoeff As Double = 1 - 0.10000000000000001 * Abs(e.Delta) / WHEEL_DELTA If e.Delta < 0 Then dCoeff = 1 / dCoeff End If ' salvo il contesto corrente e imposto quello della scena Dim nOldGseCtx = EgtGetCurrentContext() If nOldGseCtx <> m_nGseContext Then EgtSetCurrentContext(m_nGseContext) End If ' eseguo zoom EgtZoomOnPoint(e.Location, dCoeff, True) ' Ripristino il contesto originale If nOldGseCtx <> m_nGseContext Then EgtSetCurrentContext(nOldGseCtx) End If End Sub Private Function ChooseOneSelectedObj(ByVal WinXY As Point) As Integer Dim nId As Integer = GDB_ID.NULL Dim nSel As Integer EgtSelect(WinXY, DIM_SEL, DIM_SEL, nSel) If nSel = 1 Then nId = EgtGetFirstObjInSelWin() ElseIf nSel > 1 Then Dim MselDlg As New SelectMulti MselDlg.StartPosition = System.Windows.Forms.FormStartPosition.Manual Dim ptScreen As Point = PointToScreen(WinXY) ptScreen.Offset(10, 0) MselDlg.Location = ptScreen If MselDlg.ShowDialog() = System.Windows.Forms.DialogResult.OK Then nId = MselDlg.GetId() End If End If Return nId End Function Private Sub ShowCursorPos(ByVal WinXY As Point) ' se coord. griglia e non snap a punto in Z If m_bGridCursorPos And m_nStatus <> ST.SELPOINTZ Then ' calcolo lo snap da utilizzare Dim nSnap As SP = SP.PT_SKETCH If m_nStatus = ST.SELPOINT And m_nSnapType = SP.PT_GRID Then nSnap = SP.PT_GRID End If ' se riesco a ricavare un punto 3d snap Dim ptSnap As Point3d If EgtGetGraphicSnapPoint(nSnap, WinXY, DIM_SEL, DIM_SEL, ptSnap) Then ' porto nel riferimento griglia ptSnap.ToLoc(EgtGetGridFrame()) ' costruisco la stringa Dim sCursorPos As New System.Text.StringBuilder sCursorPos.Append("X=") sCursorPos.Append(EgtToUiUnits(ptSnap.x).ToString("F4", CultureInfo.InvariantCulture)) sCursorPos.Append(" Y=") sCursorPos.Append(EgtToUiUnits(ptSnap.y).ToString("F4", CultureInfo.InvariantCulture)) sCursorPos.Append(" Z=") sCursorPos.Append(EgtToUiUnits(ptSnap.z).ToString("F4", CultureInfo.InvariantCulture)) ' visualizzazione stringa RaiseEvent OnCursorPos(Me, sCursorPos.ToString) Return End If End If ' se snap a punto in Z e riesco a ricavare un punto 3d snap If m_nStatus = ST.SELPOINTZ Then ' se riesco a ricavare un punto Z snap Dim ptSnap As Point3d If EgtGetGridSnapPointZ((m_nSnapType = SP.PT_SKETCH), WinXY, m_ptGrid, ptSnap) Then ' se richiesto, porto nel riferimento griglia If m_bGridCursorPos Then ptSnap.ToLoc(EgtGetGridFrame()) End If ' costruisco la stringa Dim sCursorPos As New System.Text.StringBuilder sCursorPos.Append("X=") sCursorPos.Append(EgtToUiUnits(ptSnap.x).ToString("F4", CultureInfo.InvariantCulture)) sCursorPos.Append(" Y=") sCursorPos.Append(EgtToUiUnits(ptSnap.y).ToString("F4", CultureInfo.InvariantCulture)) sCursorPos.Append(" Z=") sCursorPos.Append(EgtToUiUnits(ptSnap.z).ToString("F4", CultureInfo.InvariantCulture)) ' visualizzazione stringa RaiseEvent OnCursorPos(Me, sCursorPos.ToString) Return End If End If ' in tutti gli altri casi If True Then ' ricavo il punto 3d da proiezione inversa Dim ptWorld As Point3d EgtUnProjectPoint(WinXY, ptWorld) 'ricavo direzione di vista Dim nDir As Integer EgtGetView(nDir) 'costruisco stringa con dati Dim sCursorPos As New System.Text.StringBuilder Select Case nDir Case VT.TOP, VT.BOTTOM sCursorPos.Append("X=") sCursorPos.Append(EgtToUiUnits(ptWorld.x).ToString("F4", CultureInfo.InvariantCulture)) sCursorPos.Append(" Y=") sCursorPos.Append(EgtToUiUnits(ptWorld.y).ToString("F4", CultureInfo.InvariantCulture)) Case VT.FRONT, VT.BACK sCursorPos.Append("X=") sCursorPos.Append(EgtToUiUnits(ptWorld.x).ToString("F4", CultureInfo.InvariantCulture)) sCursorPos.Append(" Z=") sCursorPos.Append(EgtToUiUnits(ptWorld.z).ToString("F4", CultureInfo.InvariantCulture)) Case VT.LEFT, VT.RIGHT sCursorPos.Append("Y=") sCursorPos.Append(EgtToUiUnits(ptWorld.y).ToString("F4", CultureInfo.InvariantCulture)) sCursorPos.Append(" Z=") sCursorPos.Append(EgtToUiUnits(ptWorld.z).ToString("F4", CultureInfo.InvariantCulture)) Case Else sCursorPos.Append(" ") End Select ' visualizzazione stringa RaiseEvent OnCursorPos(Me, sCursorPos.ToString) End If End Sub '---- Contextual Menu management ------------- Private m_bTangentPointOn As Boolean = False Private m_bPerpendicularPointOn As Boolean = False Private m_bMinDistPointOn As Boolean = False Public Sub EnableTangentPoint() m_bTangentPointOn = True End Sub Public Sub EnablePerpendicularPoint() m_bPerpendicularPointOn = True End Sub Public Sub EnableMinDistPoint() m_bMinDistPointOn = True End Sub Public Sub DisableTangentPoint() m_bTangentPointOn = False If m_nSnapType = SP.PT_TANGENT Then m_nSnapType = SP.PT_GRID RaiseEvent OnChangedSnapPointType(Me, m_nSnapType, False) End If End Sub Public Sub DisablePerpendicularPoint() m_bPerpendicularPointOn = False If m_nSnapType = SP.PT_PERPENDICULAR Then m_nSnapType = SP.PT_GRID RaiseEvent OnChangedSnapPointType(Me, m_nSnapType, False) End If End Sub Public Sub DisableMinDistPoint() m_bMinDistPointOn = False If m_nSnapType = SP.PT_MINDIST Then m_nSnapType = SP.PT_GRID RaiseEvent OnChangedSnapPointType(Me, m_nSnapType, False) End If End Sub Private Sub PrepareMenuScene() ' per selezione oggetti If m_nStatus = ST.SEL Then For Each i As ToolStripItem In MenuScene.Items If i.Name = "cmdSelectAll" Then i.Text = EgtMsg(1001) ' Select All i.Visible = True ElseIf i.Name = "cmdDeselectAll" Then i.Text = EgtMsg(1003) ' Deselect All i.Visible = True ElseIf i.Name = "sepSel1" Then i.Visible = True ElseIf i.Name = "cmdWinSelect" Then i.Text = EgtMsg(1005) ' Select Window i.Visible = True ElseIf i.Name = "cmdSelectPart" Then i.Text = EgtMsg(1007) ' Select Part i.Visible = True ElseIf i.Name = "cmdSelectLayer" Then i.Text = EgtMsg(1009) ' Select Layer i.Visible = True ElseIf i.Name = "cmdSelectPath" Then i.Text = EgtMsg(1011) ' Select Path i.Visible = True ElseIf i.Name = "cmdSelectPathAuto" Then i.Text = EgtMsg(1013) ' Select Path Auto i.Visible = True Else i.Visible = False End If Next MenuScene.Visible = True ' per selezione punti ElseIf m_nStatus = ST.GETDIST Or m_nStatus = ST.GETDIST2 Or m_nStatus = ST.SELPOINT Then ' se drag abilitato If m_bDragOn Then For Each i As ToolStripItem In MenuScene.Items Select Case i.Name Case "cmdSketchPoint" i.Text = EgtMsg(1101) ' Sketch Point i.Visible = True DirectCast(i, ToolStripMenuItem).Checked = (m_nSnapType = SP.PT_SKETCH) Case "cmdGridPoint" i.Text = EgtMsg(1103) ' Grid Point i.Visible = True DirectCast(i, ToolStripMenuItem).Checked = (m_nSnapType = SP.PT_GRID) Case "cmdEndPoint" i.Text = EgtMsg(1105) ' End Point i.Visible = True DirectCast(i, ToolStripMenuItem).Checked = (m_nSnapType = SP.PT_END) Case "cmdMidPoint" i.Text = EgtMsg(1107) ' Mid Point i.Visible = True DirectCast(i, ToolStripMenuItem).Checked = (m_nSnapType = SP.PT_MID) Case "cmdCenterPoint" i.Text = EgtMsg(1109) ' Center Point i.Visible = True DirectCast(i, ToolStripMenuItem).Checked = (m_nSnapType = SP.CENTER) Case "cmdCentroid" i.Text = EgtMsg(1111) ' Centroid i.Visible = True DirectCast(i, ToolStripMenuItem).Checked = (m_nSnapType = SP.CENTROID) Case "cmdNearPoint" i.Text = EgtMsg(1113) ' Near Point i.Visible = True DirectCast(i, ToolStripMenuItem).Checked = (m_nSnapType = SP.PT_NEAR) Case "cmdIntersectionPoint" i.Text = EgtMsg(1115) ' Intersection Point i.Visible = True DirectCast(i, ToolStripMenuItem).Checked = (m_nSnapType = SP.PT_INTERS) Case "cmdTangentPoint" i.Text = EgtMsg(1117) ' Tangent Point If m_bTangentPointOn Then i.Visible = True DirectCast(i, ToolStripMenuItem).Checked = (m_nSnapType = SP.PT_TANGENT) Else i.Visible = False End If Case "cmdPerpendicularPoint" i.Text = EgtMsg(1119) ' Perpendicular Point If m_bPerpendicularPointOn Then i.Visible = True DirectCast(i, ToolStripMenuItem).Checked = (m_nSnapType = SP.PT_PERPENDICULAR) Else i.Visible = False End If Case "cmdMinDistPoint" i.Text = EgtMsg(1121) ' Min Dist Point If m_bMinDistPointOn Then i.Visible = True DirectCast(i, ToolStripMenuItem).Checked = (m_nSnapType = SP.PT_MINDIST) Else i.Visible = False End If Case "sepSelPnt1" i.Visible = True Case "cmdExcludeSurfForSnap" i.Text = EgtMsg(1123) ' Exclude Surfaces i.Visible = True DirectCast(i, ToolStripMenuItem).Checked = Not m_bAlsoSurfForSnap Case "sepSelPnt2" i.Visible = (m_nStatus <> ST.GETDIST And m_nStatus <> ST.GETDIST2) Case "cmdStopDrag" i.Text = EgtMsg(1201) ' Drag Off i.Visible = (m_nStatus <> ST.GETDIST And m_nStatus <> ST.GETDIST2) Case Else i.Visible = False End Select Next ' altrimenti con drag disabilitato Else For Each i As ToolStripItem In MenuScene.Items If i.Name = "cmdRestartDrag" Then i.Text = EgtMsg(1203) ' Drag On i.Visible = True Else i.Visible = False End If Next End If MenuScene.Visible = True ' altri casi Else MenuScene.Visible = False End If End Sub Private Sub MenuScene_ItemClicked(sender As Object, e As ToolStripItemClickedEventArgs) Handles MenuScene.ItemClicked ' Per selezione If e.ClickedItem.Name = "cmdSelectAll" Then RaiseEvent OnMouseSelectedAll(Me) ElseIf e.ClickedItem.Name = "cmdDeselectAll" Then RaiseEvent OnMouseDeselectedAll(Me) ElseIf e.ClickedItem.Name = "cmdWinSelect" Then m_nStatus = ST.WINSEL ElseIf e.ClickedItem.Name = "cmdSelectPart" Then m_nStatus = ST.SELPART ElseIf e.ClickedItem.Name = "cmdSelectLayer" Then m_nStatus = ST.SELLAYER ElseIf e.ClickedItem.Name = "cmdSelectPath" Then m_nStatus = ST.SELPATH ElseIf e.ClickedItem.Name = "cmdSelectPathAuto" Then m_nStatus = ST.SELPATHAUTO ' Riabilitazione drag sospeso ElseIf e.ClickedItem.Name = "cmdRestartDrag" Then EgtResetGeoLine() EgtResetGeoTria() m_bDragOn = True ' Scelta tipo punto snap ElseIf e.ClickedItem.Name = "cmdSketchPoint" Then m_nSnapType = SP.PT_SKETCH RaiseEvent OnChangedSnapPointType(Me, m_nSnapType, True) ElseIf e.ClickedItem.Name = "cmdGridPoint" Then m_nSnapType = SP.PT_GRID RaiseEvent OnChangedSnapPointType(Me, m_nSnapType, True) ElseIf e.ClickedItem.Name = "cmdEndPoint" Then m_nSnapType = SP.PT_END RaiseEvent OnChangedSnapPointType(Me, m_nSnapType, True) ElseIf e.ClickedItem.Name = "cmdMidPoint" Then m_nSnapType = SP.PT_MID RaiseEvent OnChangedSnapPointType(Me, m_nSnapType, True) ElseIf e.ClickedItem.Name = "cmdCenterPoint" Then m_nSnapType = SP.CENTER RaiseEvent OnChangedSnapPointType(Me, m_nSnapType, True) ElseIf e.ClickedItem.Name = "cmdCentroid" Then m_nSnapType = SP.CENTROID RaiseEvent OnChangedSnapPointType(Me, m_nSnapType, True) ElseIf e.ClickedItem.Name = "cmdNearPoint" Then m_nSnapType = SP.PT_NEAR RaiseEvent OnChangedSnapPointType(Me, m_nSnapType, True) ElseIf e.ClickedItem.Name = "cmdIntersectionPoint" Then m_nSnapType = SP.PT_INTERS RaiseEvent OnChangedSnapPointType(Me, m_nSnapType, True) ElseIf e.ClickedItem.Name = "cmdTangentPoint" Then m_nSnapType = SP.PT_TANGENT RaiseEvent OnChangedSnapPointType(Me, m_nSnapType, True) ElseIf e.ClickedItem.Name = "cmdPerpendicularPoint" Then m_nSnapType = SP.PT_PERPENDICULAR RaiseEvent OnChangedSnapPointType(Me, m_nSnapType, True) ElseIf e.ClickedItem.Name = "cmdMinDistPoint" Then m_nSnapType = SP.PT_MINDIST RaiseEvent OnChangedSnapPointType(Me, m_nSnapType, True) ' esclusione superfici da punto snap ElseIf e.ClickedItem.Name = "cmdExcludeSurfForSnap" Then m_bAlsoSurfForSnap = Not m_bAlsoSurfForSnap ' Sospensione drag ElseIf e.ClickedItem.Name = "cmdStopDrag" Then m_bDragOn = False End If End Sub '-------------------------------- KeyDown -------------------------------------------------------- Private Sub Scene_KeyDown(ByVal sender As System.Object, ByVal e As KeyEventArgs) Handles MyBase.KeyDown ' Con selezione punti e drag abilitato If (m_nStatus = ST.GETDIST Or m_nStatus = ST.GETDIST2 Or m_nStatus = ST.SELPOINT) And m_bDragOn Then ' Con 'S' imposto Punto Sketch If e.KeyData = Keys.S Then m_nSnapType = SP.PT_SKETCH RaiseEvent OnChangedSnapPointType(Me, m_nSnapType, True) ' Con 'G' imposto Punto Griglia ElseIf e.KeyData = Keys.G Then m_nSnapType = SP.PT_GRID RaiseEvent OnChangedSnapPointType(Me, m_nSnapType, True) ' Con 'E' imposto Punto Finale ElseIf e.KeyData = Keys.E Then m_nSnapType = SP.PT_END RaiseEvent OnChangedSnapPointType(Me, m_nSnapType, True) ' Con 'M' imposto Punto Medio ElseIf e.KeyData = Keys.M Then m_nSnapType = SP.PT_MID RaiseEvent OnChangedSnapPointType(Me, m_nSnapType, True) ' Con 'C' imposto Centro ElseIf e.KeyData = Keys.C Then m_nSnapType = SP.CENTER RaiseEvent OnChangedSnapPointType(Me, m_nSnapType, True) ' Con 'B' imposto Baricentro ElseIf e.KeyData = Keys.B Then m_nSnapType = SP.CENTROID RaiseEvent OnChangedSnapPointType(Me, m_nSnapType, True) ' Con 'N' imposto Punto Vicino ElseIf e.KeyData = Keys.N Then m_nSnapType = SP.PT_NEAR RaiseEvent OnChangedSnapPointType(Me, m_nSnapType, True) ' Con 'I' imposto Punto Intersezione ElseIf e.KeyData = Keys.I Then m_nSnapType = SP.PT_INTERS RaiseEvent OnChangedSnapPointType(Me, m_nSnapType, True) ' Con 'T' imposto Punto Tangente ElseIf e.KeyData = Keys.T Then If m_bTangentPointOn Then m_nSnapType = SP.PT_TANGENT RaiseEvent OnChangedSnapPointType(Me, m_nSnapType, True) End If ' Con 'P' imposto Punto Perpendicolare ElseIf e.KeyData = Keys.P Then If m_bPerpendicularPointOn Then m_nSnapType = SP.PT_PERPENDICULAR RaiseEvent OnChangedSnapPointType(Me, m_nSnapType, True) End If ' Con 'D' imposto Punto Minima Distanza ElseIf e.KeyData = Keys.D Then If m_bMinDistPointOn Then m_nSnapType = SP.PT_MINDIST RaiseEvent OnChangedSnapPointType(Me, m_nSnapType, True) End If End If End If End Sub '---- Status management ------------- Private Function IsRestorableCurrStatus() As Boolean Select Case m_nStatus Case ST.NULL, ST.SEL, ST.ANALYZE, ST.SELPART, ST.SELLAYER, ST.SELPATH, ST.SELPATHAUTO, ST.GETDIST, ST.GETDIST2, ST.SELPOINT, ST.SELPOINTZ Return True Case Else Return False End Select End Function Private Sub SaveCurrStatus() If IsRestorableCurrStatus() Then m_nOldStatus = m_nStatus End If End Sub Private Function RestoreStatus() As Boolean ' eventuale ripristino vecchio stato If m_nOldStatus = ST.NULL Then m_nStatus = m_nOldStatus Cursor = Cursors.Default Return True ElseIf m_nOldStatus = ST.SEL Or m_nOldStatus = ST.SELPART Or m_nOldStatus = ST.SELLAYER Or m_nOldStatus = ST.SELPATH Or m_nOldStatus = ST.SELPATHAUTO Then m_nStatus = m_nOldStatus Cursor = New Cursor(Me.GetType(), "Select.cur") Return True ElseIf m_nOldStatus = ST.ANALYZE Then m_nStatus = m_nOldStatus Cursor = New Cursor(Me.GetType(), "Analyze.cur") Return True ElseIf m_nOldStatus = ST.GETDIST Or m_nOldStatus = ST.GETDIST2 Then m_nStatus = m_nOldStatus Cursor = New Cursor(Me.GetType(), "GetDist.cur") Return True ElseIf m_nOldStatus = ST.SELPOINT Or m_nOldStatus = ST.SELPOINTZ Then m_nStatus = m_nOldStatus Cursor = New Cursor(Me.GetType(), "SelPoint.cur") Return True End If Return False End Function Public Sub SetStatusNull() m_nStatus = ST.NULL End Sub Public Sub SetStatusAnalyze() m_nStatus = ST.ANALYZE End Sub Public Sub SetStatusGetDistance() m_nStatus = ST.GETDIST End Sub Public Sub SetStatusSelPoint(Optional ByVal bAlsoDir As Boolean = False) m_nStatus = ST.SELPOINT m_bAlsoSelDir = bAlsoDir End Sub Public Sub ResetStatus(Optional ByVal bRedraw As Boolean = True) ' pulisco eventuali geometrie temporanee EraseDragGroup() EgtResetGeoLine(False) EgtResetGeoTria(False) EgtResetWinRect(False) ' reset entità non selezionabili EgtSetObjFilterForSelect(True, True, True, True, True) EgtUnselectableClearAll() m_bAlsoDragIntersForSnap = False ' imposto lo stato m_nStatus = ST.SEL m_nOldStatus = ST.SEL ' abilito drag m_bDragOn = True ' aggiorno visualizzazione If bRedraw Then EgtDraw() End If End Sub Public Sub ResetStatusAnalyze() If m_nStatus = ST.ANALYZE Then m_nStatus = ST.SEL m_nOldStatus = ST.SEL End If End Sub Public Sub ResetStatusGetDistance() If m_nStatus = ST.GETDIST Or m_nStatus = ST.GETDIST2 Then m_nStatus = ST.SEL m_nOldStatus = ST.SEL End If EgtResetGeoLine() RaiseEvent OnCloseGetDist(Me) End Sub Public Function GetSnapPointType() As SP If m_nStatus <> ST.SELPOINT And m_nStatus <> ST.SELPOINTZ Then Return SP.PT_NONE Else Return m_nSnapType End If End Function Public Sub SetDragIntersForSelPoint(ByVal bVal As Boolean) m_bAlsoDragIntersForSnap = bVal End Sub Public Sub SetSurfForSelPoint(ByVal bVal As Boolean) m_bAlsoSurfForSnap = bVal End Sub '---- Drag Group ------ Private m_bDragOn As Boolean = True Private m_nDragGroup As Integer = GDB_ID.NULL Public Sub EnableDrag() m_bDragOn = True End Sub Public Sub DisableDrag() m_bDragOn = False End Sub Public Function GetDragStatus() As Boolean Return m_bDragOn End Function Public Function CreateDragGroup() As Boolean ' le azioni successive sono temporanee -> non devono cambiare lo stato di modifica del progetto EgtDisableModified() ' creo il gruppo di drag m_nDragGroup = EgtCreateGroup(GDB_ID.ROOT) Dim bOk As Boolean = (m_nDragGroup <> GDB_ID.NULL) If bOk Then EgtSetLevel(m_nDragGroup, GDB_LV.TEMP) EgtSetMark(m_nDragGroup) EgtUnselectableAdd(m_nDragGroup) End If ' riabilito possibilità modifica stato progetto EgtEnableModified() Return bOk End Function Public Function EraseDragGroup() As Boolean ' le azioni successive sono temporanee -> non devono cambiare lo stato di modifica del progetto EgtDisableModified() ' cancello il gruppo di drag EgtErase(m_nDragGroup) EgtUnselectableRemove(m_nDragGroup) m_nDragGroup = GDB_ID.NULL ' riabilito possibilità modifica stato progetto EgtEnableModified() Return True End Function Public Function AddToDragGroup(ByVal nId As Integer) As Integer ' le azioni successive sono temporanee -> non devono cambiare lo stato di modifica del progetto EgtDisableModified() ' copio entità Dim nNewId As Integer = EgtCopyGlob(nId, m_nDragGroup, GDB_POS.LAST_SON) If nNewId <> GDB_ID.NULL Then ' assegno il colore (potrebbe essere da layer, quindi va fatto) Dim ColObj As Color3d EgtGetCalcColor(nId, ColObj) EgtSetColor(nNewId, ColObj) ' assegno Id entità origine EgtSetInfo(nNewId, "Id", nId.ToString()) End If ' riabilito possibilità modifica stato progetto EgtEnableModified() Return nNewId End Function Public Function GetDragGroup() As Integer Return m_nDragGroup End Function '---- Zoom Buttons ---- Public Sub ZoomAll() EgtZoom(ZM.ALL) End Sub Public Sub ZoomIn() EgtZoom(ZM.IN_) End Sub Public Sub ZoomOut() EgtZoom(ZM.OUT) End Sub '---- Rendering Buttons ---- Public Sub WireFrame() EgtSetShowMode(SM.WIREFRAME) End Sub Public Sub HiddenLine() EgtSetShowMode(SM.HIDDENLINE) End Sub Public Sub Shading() EgtSetShowMode(SM.SHADING) End Sub '---- LookFrom Buttons ---- Public Sub TopView() EgtSetView(VT.TOP) End Sub Public Sub FrontView() EgtSetView(VT.FRONT) End Sub Public Sub BackView() EgtSetView(VT.BACK) End Sub Public Sub LeftView() EgtSetView(VT.LEFT) End Sub Public Sub RightView() EgtSetView(VT.RIGHT) End Sub Public Sub BottomView() EgtSetView(VT.BOTTOM) End Sub Public Sub IsoViewSW() EgtSetView(VT.ISO_SW) End Sub Public Sub IsoViewSE() EgtSetView(VT.ISO_SE) End Sub Public Sub IsoViewNE() EgtSetView(VT.ISO_NE) End Sub Public Sub IsoViewNW() EgtSetView(VT.ISO_NW) End Sub Public Sub CPlaneView() EgtSetView(VT.CPLANE) End Sub End Class