'---------------------------------------------------------------------------- ' 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 = ST.NULL Private m_nOldStatus As ST = ST.NULL 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 = SP.PT_GRID ' tipo di snap in selezione punto Private m_bAlsoSelDir As Boolean = False ' abilita anche selezione direzione quando selezione punto Private m_bAlsoDragIntersForSnap As Boolean = False ' abilita intersezione con drag per snap a punto Private m_bZeroDimForSel As Boolean = False ' abilita punti/vettori/frame per la selezione Private m_bCurveForSel As Boolean = False ' abilita le curve per la selezione Private m_bSurfForSel As Boolean = False ' abilita le superfici per la selezione Private m_bVolumeForSel As Boolean = False ' abilita i solidi per la selezione Private m_bExtraForSel As Boolean = False ' abilita testi/quote per la selezione Private m_bZeroDimForSnap As Boolean = False ' abilita punti/vettori/frame per lo snap a punto Private m_bCurveForSnap As Boolean = False ' abilita le curve per lo snap a punto Private m_bSurfForSnap As Boolean = False ' abilita le superfici per lo snap a punto Private m_bVolumeForSnap As Boolean = False ' abilita i solidi per lo snap a punto Private m_bExtraForSnap As Boolean = False ' abilita testi/quote per lo snap a punto Private m_bExcludeSurfInSelMenu As Boolean = False ' abilita visualizzazione voce Escludi superfici in menù contestuale Private m_PrevPoint As Point Private m_ptPrev As Point3d Private m_ptGrid As Point3d Private m_bGridCursorPos As Boolean = False 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_bZeroDimForSel = True m_bCurveForSel = True m_bSurfForSel = True m_bVolumeForSel = True m_bExtraForSel = True m_bZeroDimForSnap = True m_bCurveForSnap = True m_bSurfForSnap = True m_bVolumeForSnap = True m_bExtraForSnap = True m_bExcludeSurfInSelMenu = 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(nDriver As Integer, b2Buff As Boolean, nColorBits As Integer, 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) ' Salvo i colori m_BackTopColor = BackTopColor m_BackBotColor = BackBotColor ' Se esiste già un contesto, lo aggiorno If m_nGseContext <> 0 Then ' salvo il contesto corrente e imposto quello della scena Dim nOldGseCtx = EgtGetCurrentContext() If nOldGseCtx <> m_nGseContext Then EgtSetCurrentContext(m_nGseContext) ' imposto i colori di sfondo EgtSetBackground(m_BackTopColor, m_BackBotColor) ' ripristino il contesto originale If nOldGseCtx <> m_nGseContext Then EgtSetCurrentContext(nOldGseCtx) End If End Sub Public Sub SetDefaultMaterial(ByRef DefColor As Color3d) ' Salvo il colore m_DefColor = DefColor ' Se esiste già un contesto, lo aggiorno If m_nGseContext <> 0 Then ' salvo il contesto corrente e imposto quello della scena Dim nOldGseCtx = EgtGetCurrentContext() If nOldGseCtx <> m_nGseContext Then EgtSetCurrentContext(m_nGseContext) ' imposto il colore di default EgtSetDefaultMaterial(m_DefColor) ' ripristino il contesto originale If nOldGseCtx <> m_nGseContext Then EgtSetCurrentContext(nOldGseCtx) End If 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(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(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 Dim nGseContext As Integer = 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() m_nGseContext = nGseContext 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(ClientSize.Width, ClientSize.Height) ' Ripristino il contesto originale If nOldGseCtx <> m_nGseContext Then EgtSetCurrentContext(nOldGseCtx) End If End Sub '---- Events ---------- Public Event OnMouseSetObjFilterForSelect(sender As Object, bZeroDim As Boolean, bCurve As Boolean, bSurf As Boolean, bVolume As Boolean, bExtra As Boolean) Public Event OnMouseSelectedAll(sender As Object, bOnlyVisible As Boolean) Public Event OnMouseDeselectedAll(sender As Object) Public Event OnMouseSelectedObj(sender As Object, nId As Integer, bLast As Boolean) Public Event OnMouseSelectedPart(sender As Object, nId As Integer) Public Event OnMouseSelectedLayer(sender As Object, nId As Integer) Public Event OnMouseSelectedPath(sender As Object, nId As Integer, bHaltOnFork As Boolean) Public Event OnMouseAnalyzed(sender As Object, nId As Integer) Public Event OnMouseAnalyzedEx(sender As Object, nId As Integer, nSub As Integer, ptP As Point3d) Public Event OnMousePointFromSelection(sender As Object, nId As Integer, PtP As Point3d, nAux As Integer) Public Event OnMouseDownScene(sender As Object, e As System.Windows.Forms.MouseEventArgs) Public Event OnMouseUpScene(sender As Object, e As System.Windows.Forms.MouseEventArgs) Public Event OnMouseMoveScene(sender As Object, e As System.Windows.Forms.MouseEventArgs) Public Event OnCursorPos(sender As Object, sCursorPos As String) Public Event OnShowDistance(sender As Object, sDistance As String) Public Event OnShowDistanceVector(sender As Object, vtDist As Vector3d) Public Event OnCloseAnalyze(sender As Object) Public Event OnCloseGetDist(sender As Object) Public Event OnMouseDone(sender As Object) Public Event OnMouseSelectedPoint(sender As Object, PtP As Point3d, nSep As SEP, nId As Integer) Public Event OnMouseSelectedDir(sender As Object, VtDir As Vector3d) Public Event OnMouseMoveSelPoint(sender As Object, PtP As Point3d) Public Event OnChangedSnapPointType(sender As Object, nSpType As SP, bForced As Boolean) Public Event OnMouseSelectingObj(sender As Object, nId As Integer, ByRef bOk As Boolean) '---- Mouse ----------- Private m_bSetFocusOnMove As Boolean = True Public Sub SetFocusOnMove(bVal As Boolean) m_bSetFocusOnMove = bVal End Sub Protected Overrides Sub OnMouseDown(e As System.Windows.Forms.MouseEventArgs) ' Imposto il contesto della scena 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 + Control ElseIf m_nStatus = ST.SELPATH Or m_nStatus = ST.SELPATHAUTO Or (m_nStatus = ST.SEL And (ModifierKeys And Keys.Control) = Keys.Control And (ModifierKeys And Keys.Alt) = Keys.None) Then EgtSetObjFilterForSelWin(False, m_bCurveForSel, False, False, False) ' abilito solo le curve Dim nId As Integer = ChooseOneSelectedObj(e.Location, m_nStatus) 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 ' SEL + Ctrl + Alt --> SELLAYER If m_nStatus = ST.SEL And (ModifierKeys And Keys.Control) = Keys.Control And (ModifierKeys And Keys.Alt) = Keys.Alt Then m_nStatus = ST.SELLAYER ' SEL + Alt --> SELPART If m_nStatus = ST.SEL And (ModifierKeys And Keys.Alt) = Keys.Alt Then m_nStatus = ST.SELPART EgtSetObjFilterForSelWin(m_bZeroDimForSel, m_bCurveForSel, m_bSurfForSel, m_bVolumeForSel, m_bExtraForSel) Dim nId As Integer = ChooseOneSelectedObj(e.Location, m_nStatus) 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 PAN ElseIf m_nStatus = ST.PAN Then Cursor = New Cursor(Me.GetType(), "Pan.cur") ' salvo il punto in coordinate finestra m_PrevPoint = e.Location ' se stato ROT ElseIf m_nStatus = ST.ROT Then Cursor = New Cursor(Me.GetType(), "Rotate.cur") ' salvo il punto in coordinate finestra m_PrevPoint = e.Location ' se stato ZOOMWIN ElseIf m_nStatus = ST.ZOOMWIN Then Cursor = New Cursor(Me.GetType(), "ZoomWin.cur") ' salvo il punto in coordinate finestra m_PrevPoint = e.Location ' se stato ANALYZE ElseIf m_nStatus = ST.ANALYZE Then EgtSetObjFilterForSelWin(m_bZeroDimForSel, m_bCurveForSel, m_bSurfForSel, m_bVolumeForSel, m_bExtraForSel) Dim nId As Integer = ChooseOneSelectedObj(e.Location, m_nStatus) If nId <> GDB_ID.NULL Then ' richiamo gestione evento standard RaiseEvent OnMouseAnalyzed(Me, nId) ' determino subId e posizione punto di selezione Dim PtTemp As Point3d Dim nAux As Integer = -1 EgtGetPointFromSelect(nId, e.Location, PtTemp, nAux) RaiseEvent OnMouseAnalyzedEx( Me, nId, nAux, PtTemp) End If ' se stato GETDIST (primo punto per misura di distanza) ElseIf m_nStatus = ST.GETDIST Then EgtSetObjFilterForSelWin(m_bZeroDimForSnap, m_bCurveForSnap, m_bSurfForSnap, m_bVolumeForSnap, m_bExtraForSnap) 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 EgtSetObjFilterForSelWin(m_bZeroDimForSnap, m_bCurveForSnap, m_bSurfForSnap, m_bVolumeForSnap, m_bExtraForSnap) 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)) Dim dLen, dTheta, dPhi As double : vtDist.ToSpherical( dLen, dTheta, dPhi) sOut.Append( " φ=") sOut.Append( dPhi.ToString("F2", CultureInfo.InvariantCulture)) sOut.Append( " θ=") sOut.Append( dTheta.ToString("F2", CultureInfo.InvariantCulture)) ' lancio l'evento per visualizzare la distanza RaiseEvent OnShowDistance(Me, sOut.ToString()) RaiseEvent OnShowDistanceVector(Me, vtDist) m_nStatus = ST.GETDIST End If ' se stato selezione punto ElseIf m_nStatus = ST.SELPOINT Then EgtSetObjFilterForSelWin(m_bZeroDimForSnap, m_bCurveForSnap, m_bSurfForSnap, m_bVolumeForSnap, m_bExtraForSnap) 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 ' Evento che può essere gestito da altri RaiseEvent OnMouseDownScene(Me, e) Focus() 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) ' --- Rilascio tasto sinistro o tasto medio (rotella) --- If e.Button = Windows.Forms.MouseButtons.Left Or e.Button = Windows.Forms.MouseButtons.Middle Then If m_nStatus = ST.WINSEL Then EgtResetWinRect(True) EgtSetObjFilterForSelWin(m_bZeroDimForSel, m_bCurveForSel, m_bSurfForSel, m_bVolumeForSel, m_bExtraForSel) ' 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) ' filtro custom e notifico per ogni entità selezionata Dim nLastId = GDB_ID.NULL Dim nId = EgtGetFirstObjInSelWin() While nId <> GDB_ID.NULL Dim nNextId = EgtGetNextObjInSelWin() Dim bOk As Boolean = True RaiseEvent OnMouseSelectingObj(Me, nId, bOk) If bOk Then RaiseEvent OnMouseSelectedObj(Me, nId, (nNextId = GDB_ID.NULL)) nLastId = nId End If 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") ElseIf m_nStatus = ST.ZOOMWIN Then EgtResetWinRect(False) EgtZoomWin(m_PrevPoint, e.Location, True) End If ' Per stati PAN, ROT e ZOOMWIN (unici compatibili con eventuale pressione tasto medio) If m_nStatus = ST.PAN Or m_nStatus = ST.ROT Or m_nStatus = ST.ZOOMWIN Then ' 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 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 ' Evento che può essere gestito da altri RaiseEvent OnMouseUpScene(Me, e) ' Ripristino il contesto originale If nOldGseCtx <> m_nGseContext Then EgtSetCurrentContext(nOldGseCtx) 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 (15% della dimensione), imposto il focus If m_bSetFocusOnMove Then Const BordPu As Double = 0.15 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 End If ' Visualizzo le coordinate del mouse ShowCursorPos(e.Location) ' Imposto il cursore in base allo stato If m_nStatus = ST.WINSEL Then Cursor = New Cursor(Me.GetType(), "WinSelect.cur") ElseIf m_nStatus = ST.ZOOMWIN Then Cursor = New Cursor(Me.GetType(), "ZoomWin.cur") ElseIf m_nStatus = ST.ROT Then Cursor = New Cursor(Me.GetType(), "Rotate.cur") ElseIf m_nStatus = ST.PAN Then Cursor = New Cursor(Me.GetType(), "Pan.cur") 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 Or m_nStatus = ST.GETDIST2 Then Cursor = New Cursor(Me.GetType(), "GetDist.cur") ElseIf m_nStatus = ST.SELPOINT Or m_nStatus = ST.SELPOINTZ Then Cursor = New Cursor(Me.GetType(), "SelPoint.cur") End If ' --- Premuto tasto sinistro o centrale (rotella) --- If e.Button = Windows.Forms.MouseButtons.Left Or e.Button = Windows.Forms.MouseButtons.Middle Then If m_nStatus = ST.WINSEL Then EgtSetWinRect(m_PrevPoint, e.Location, True) ElseIf m_nStatus = ST.ZOOMWIN Then EgtSetWinRect(m_PrevPoint, e.Location, True) 'Il punto di riferimento deve rimanere quello originale ElseIf m_nStatus = ST.ROT Then EgtRotateView(m_PrevPoint, e.Location, True) m_PrevPoint = e.Location ElseIf m_nStatus = ST.PAN Then EgtPanView(m_PrevPoint, e.Location, True) m_PrevPoint = e.Location ElseIf m_nStatus <> ST.NULL And e.Button = Windows.Forms.MouseButtons.Middle Then m_nStatus = ST.SEL End If ' --- Senza pressione tasti --- ElseIf m_nStatus = ST.GETDIST2 Then Dim ptP As Point3d EgtUnProjectPoint(e.Location, ptP) EgtSetGeoLine(m_ptPrev, ptP) ElseIf m_nStatus = ST.SELPOINT Then 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 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 ' Eventuale aggiornamento cursore per cambio di stato appena avvenuto If m_nStatus = ST.NULL Then Cursor = Cursors.Default ElseIf m_nStatus = ST.SEL Then Cursor = New Cursor(Me.GetType(), "Select.cur") End If ' Evento che può essere gestito da altri RaiseEvent OnMouseMoveScene(Me, e) ' 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.1 * 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(WinXY As Point, Status As ST) As Integer ' Fotografo entità nel mirino Dim nSel As Integer EgtSelect(WinXY, DIM_SEL, DIM_SEL, nSel) ' Filtro le entità nel mirino e le inserisco in lista Dim vId As New List(Of Integer) Dim nId = EgtGetFirstObjInSelWin() While nId <> GDB_ID.NULL Dim bOk As Boolean = True RaiseEvent OnMouseSelectingObj(Me, nId, bOk) If bOk Then vId.Add(nId) nId = EgtGetNextObjInSelWin() End While ' Se selezione layer, tengo un solo oggetto per layer If Status = ST.SELLAYER Then Dim nI As Integer = 0 While nI < vId.Count() Dim nLayI As Integer = EgtGetParent(vId(nI)) Dim nJ As Integer = nI + 1 While nJ < vId.Count() If nLayI <> GDB_ID.NULL And EgtGetParent(vId(nJ)) = nLayI Then vId.RemoveAt(nJ) Else nJ += 1 End If End While nI += 1 End While ' se altrimenti selezione pezzo, tengo un solo oggetto per pezzo ElseIf Status = ST.SELPART Then Dim nI As Integer = 0 While nI < vId.Count() Dim nPartI As Integer = EgtGetParent(EgtGetParent(vId(nI))) Dim nJ As Integer = nI + 1 While nJ < vId.Count() If nPartI <> GDB_ID.NULL And EgtGetParent(EgtGetParent(vId(nJ))) = nPartI Then vId.RemoveAt(nJ) Else nJ += 1 End If End While nI += 1 End While End If ' Se una sola la ritorno If vId.Count() = 1 Then Return vId(0) ' altrimenti faccio scegliere all'utente ElseIf vId.Count() > 1 Then Dim MselDlg As New SelectMulti(vId) With { .StartPosition = FormStartPosition.Manual } Dim ptScreen As Point = PointToScreen(WinXY) ptScreen.Offset(10, 0) MselDlg.Location = ptScreen If MselDlg.ShowDialog() = System.Windows.Forms.DialogResult.OK Then Return MselDlg.GetId() End If End If Return GDB_ID.NULL End Function Private Sub ShowCursorPos(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) ' se coordinate globali If Not m_bGridCursorPos Then ' 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) ' altrimenti coordinate griglia Else ' porto il punto nel riferimento griglia Dim ptGrid As Point3d = ptWorld.Loc(GDB_ID.GRID) ' ricavo vettore direzione di vista e lo porto nel riferimento griglia Dim dAngVertDeg, dAngHorizDeg As Double EgtGetGenericView(dAngVertDeg, dAngHorizDeg) Dim vtView As Vector3d = Vector3d.FromSpherical(1, dAngVertDeg, dAngHorizDeg).Loc(GDB_ID.GRID) ' costruisco stringa con dati ' la direzione di vista sicuramente deve coincidere con uno dei tre assi della griglia Dim sCursorPos As New System.Text.StringBuilder If Math.Abs(vtView.x) < EPS_SMALL And Math.Abs(vtView.y) < EPS_SMALL Then sCursorPos.Append("X=") sCursorPos.Append(EgtToUiUnits(ptGrid.x).ToString("F4", CultureInfo.InvariantCulture)) sCursorPos.Append(" Y=") sCursorPos.Append(EgtToUiUnits(ptGrid.y).ToString("F4", CultureInfo.InvariantCulture)) ElseIf Math.Abs(vtView.x) < EPS_SMALL And Math.Abs(vtView.z) < EPS_SMALL Then sCursorPos.Append("X=") sCursorPos.Append(EgtToUiUnits(ptGrid.x).ToString("F4", CultureInfo.InvariantCulture)) sCursorPos.Append(" Z=") sCursorPos.Append(EgtToUiUnits(ptGrid.z).ToString("F4", CultureInfo.InvariantCulture)) ElseIf Math.Abs(vtView.y) < EPS_SMALL And Math.Abs(vtView.z) < EPS_SMALL Then sCursorPos.Append("Y=") sCursorPos.Append(EgtToUiUnits(ptGrid.y).ToString("F4", CultureInfo.InvariantCulture)) sCursorPos.Append(" Z=") sCursorPos.Append(EgtToUiUnits(ptGrid.z).ToString("F4", CultureInfo.InvariantCulture)) Else sCursorPos.Append(" ") End If ' visualizzazione stringa RaiseEvent OnCursorPos(Me, sCursorPos.ToString) End If 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 Or m_nStatus = ST.WINSEL Or m_nStatus = ST.SELPART Or m_nStatus = ST.SELLAYER Or m_nStatus = ST.SELPATH Or m_nStatus = ST.SELPATHAUTO Then For Each i As ToolStripItem In MenuScene.Items Select Case i.Name Case "cmdSelectAllVisible" i.Text = EgtMsg(1016) ' Select All Visible i.Visible = True Case "cmdSelectAll" i.Text = EgtMsg(1001) ' Select All i.Visible = True Case "cmdDeselectAll" i.Text = EgtMsg(1003) ' Deselect All i.Visible = True Case "sepSel1" i.Visible = True Case "cmdWinSelect" i.Text = EgtMsg(1005) ' Select Window i.Visible = True DirectCast(i, ToolStripMenuItem).Checked = (m_nStatus = ST.WINSEL) Case "cmdSelectPart" i.Text = EgtMsg(1007) ' Select Part i.Visible = True DirectCast(i, ToolStripMenuItem).Checked = (m_nStatus = ST.SELPART) Case "cmdSelectLayer" i.Text = EgtMsg(1009) ' Select Layer i.Visible = True DirectCast(i, ToolStripMenuItem).Checked = (m_nStatus = ST.SELLAYER) Case "cmdSelectPath" i.Text = EgtMsg(1011) ' Select Path i.Visible = True DirectCast(i, ToolStripMenuItem).Checked = (m_nStatus = ST.SELPATH) Case "cmdSelectPathAuto" i.Text = EgtMsg(1013) ' Select Path Auto i.Visible = True DirectCast(i, ToolStripMenuItem).Checked = (m_nStatus = ST.SELPATHAUTO) Case "cmdSelectEntity" i.Text = EgtMsg(1015) ' Select Entity i.Visible = True DirectCast(i, ToolStripMenuItem).Checked = (m_nStatus = ST.SEL) Case "sepSelPnt1" i.Visible = m_bExcludeSurfInSelMenu Case "cmdExcludeSurfFromSel" i.Text = EgtMsg(1123) ' Exclude Surfaces i.Visible = m_bExcludeSurfInSelMenu DirectCast(i, ToolStripMenuItem).Checked = Not m_bSurfForSel Case Else i.Visible = False End Select Next MenuScene.Visible = True ' per selezione punti o distanza ElseIf m_nStatus = ST.SELPOINT Or m_nStatus = ST.GETDIST Or m_nStatus = ST.GETDIST2 Then ' se drag abilitato o distanza If m_bDragOn Or m_nStatus = ST.GETDIST Or m_nStatus = ST.GETDIST2 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 "cmdExcludeSurfFromSnap" i.Text = EgtMsg(1123) ' Exclude Surfaces i.Visible = True DirectCast(i, ToolStripMenuItem).Checked = Not m_bSurfForSnap 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 selezione punto e 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 = "cmdSelectAllVisible" Then RaiseEvent OnMouseSelectedAll(Me, True) ElseIf e.ClickedItem.Name = "cmdSelectAll" Then RaiseEvent OnMouseSelectedAll(Me, False) 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 ElseIf e.ClickedItem.Name = "cmdSelectEntity" Then m_nStatus = ST.SEL ' 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 = "cmdExcludeSurfFromSel" Then m_bSurfForSel = Not m_bSurfForSel RaiseEvent OnMouseSetObjFilterForSelect(Me, m_bZeroDimForSel, m_bCurveForSel, m_bSurfForSel, m_bVolumeForSel, m_bExtraForSel) ' esclusione superfici da punto snap ElseIf e.ClickedItem.Name = "cmdExcludeSurfFromSnap" Then m_bSurfForSnap = Not m_bSurfForSnap ' Sospensione drag ElseIf e.ClickedItem.Name = "cmdStopDrag" Then m_bDragOn = False End If 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 Function SetSnapPointType(SnapPointType As SP) As Boolean If IsNothing(SnapPointType) Then Return False If SnapPointType = m_nSnapType Then Return True m_nSnapType = If(SnapPointType >= SP.PT_NONE And SnapPointType <= SP.PT_MINDIST, SnapPointType, SP.PT_NONE) RaiseEvent OnChangedSnapPointType(Me, m_nSnapType, True) Return True End Function '-------------------------------- KeyDown -------------------------------------------------------- Private Sub Scene_KeyDown(sender As System.Object, 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 m_nOldStatus = ST.NULL End Sub Public Function IsStatusNull() As Boolean Return (m_nStatus = ST.NULL) End Function Public Sub SetStatusPan() SaveCurrStatus() m_nStatus = ST.PAN End Sub Public Sub SetStatusRot() SaveCurrStatus() m_nStatus = ST.ROT End Sub Public Sub SetStatusZoomWin() SaveCurrStatus() m_nStatus = ST.ZOOMWIN End Sub Public Sub SetStatusAnalyze() If m_nStatus = ST.ANALYZE Then Return SaveCurrStatus() m_nStatus = ST.ANALYZE If m_nOldStatus = ST.GETDIST Or m_nOldStatus = ST.GETDIST2 Then EgtResetGeoLine() RaiseEvent OnCloseGetDist(Me) End If End Sub Public Sub SetStatusGetDistance() If m_nStatus = ST.GETDIST Or m_nStatus = ST.GETDIST2 Then Return SaveCurrStatus() m_nStatus = ST.GETDIST If m_nOldStatus = ST.ANALYZE Then RaiseEvent OnCloseAnalyze(Me) End Sub Public Sub SetStatusSelPoint(Optional bAlsoDir As Boolean = False) SaveCurrStatus() m_nStatus = ST.SELPOINT m_bAlsoSelDir = bAlsoDir End Sub Public Sub ResetStatus(Optional bRedraw As Boolean = True) ResetStatusAnalyze() ResetStatusGetDistance() ' Pulisco eventuali geometrie temporanee EraseDragGroup() EgtResetGeoLine(False) EgtResetGeoTria(False) EgtResetWinRect(False) ' Reset entità non selezionabili EgtSetObjFilterForSelWin(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 ' Se richiesto, aggiorno visualizzazione If bRedraw Then EgtDraw() End Sub Public Sub ResetStatusAnalyze() If m_nStatus <> ST.ANALYZE Then Return ' Reset analisi m_nStatus = If(m_nOldStatus <> ST.ANALYZE And m_nOldStatus <> ST.GETDIST And m_nOldStatus <> ST.GETDIST2, m_nOldStatus, ST.SEL) m_nOldStatus = ST.SEL RaiseEvent OnCloseAnalyze(Me) End Sub Public Sub ResetStatusGetDistance() If m_nStatus <> ST.GETDIST And m_nStatus <> ST.GETDIST2 Then Return ' Reset misura distanza m_nStatus = If(m_nOldStatus <> ST.ANALYZE And m_nOldStatus <> ST.GETDIST And m_nOldStatus <> ST.GETDIST2, m_nOldStatus, ST.SEL) m_nOldStatus = ST.SEL EgtResetGeoLine() RaiseEvent OnCloseGetDist(Me) End Sub Public Sub SetDragIntersForSelPoint(bVal As Boolean) m_bAlsoDragIntersForSnap = bVal End Sub Public Sub SetObjFilterForSel(bZeroDim As Boolean, bCurve As Boolean, bSurf As Boolean, bVolume As Boolean, bExtra As Boolean) m_bZeroDimForSel = bZeroDim m_bCurveForSel = bCurve m_bSurfForSel = bSurf m_bVolumeForSel = bVolume m_bExtraForSel = bExtra EgtSetObjFilterForSelect(m_bZeroDimForSel, m_bCurveForSel, m_bSurfForSel, m_bVolumeForSel, m_bExtraForSel) End Sub Public Sub GetObjFilterForSel(ByRef bZeroDim As Boolean, ByRef bCurve As Boolean, ByRef bSurf As Boolean, ByRef bVolume As Boolean, ByRef bExtra As Boolean) bZeroDim = m_bZeroDimForSel bCurve = m_bCurveForSel bSurf = m_bSurfForSel bVolume = m_bVolumeForSel bExtra = m_bExtraForSel End Sub Public Sub SetObjFilterForSnap(bZeroDim As Boolean, bCurve As Boolean, bSurf As Boolean, bVolume As Boolean, bExtra As Boolean) m_bZeroDimForSnap = bZeroDim m_bCurveForSnap = bCurve m_bSurfForSnap = bSurf m_bVolumeForSnap = bVolume m_bExtraForSnap = bExtra End Sub Public Sub GetObjFilterForSnap(ByRef bZeroDim As Boolean, ByRef bCurve As Boolean, ByRef bSurf As Boolean, ByRef bVolume As Boolean, ByRef bExtra As Boolean) bZeroDim = m_bZeroDimForSnap bCurve = m_bCurveForSnap bSurf = m_bSurfForSnap bVolume = m_bVolumeForSnap bExtra = m_bExtraForSnap End Sub Public Sub SetShowExcludeSurfInSelMenu(bVal As Boolean) m_bExcludeSurfInSelMenu = bVal End Sub Public Sub GetShowExcludeSurfInSelMenu(ByRef bVal As Boolean) bVal = m_bExcludeSurfInSelMenu 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(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 Public Sub ZoomSel() EgtZoomObject(GDB_ID.SEL) 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