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 PAN ROT ZOOMWIN WINSEL SELPART SELLAYER 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_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.NULL m_nOldStatus = ST.NULL m_nSnapType = SP.PT_GRID RaiseEvent OnChangedSnapPointType(Me, m_nSnapType) m_bAlsoSelDir = False 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 = Cursors.Default 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 Sub Init() m_nGseContext = EgtInitGeomDB() 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) EgtInitTscExec() End Sub Public Function GetCtx() As Integer Return m_nGseContext End Function Protected Overrides Sub OnPaint(e As PaintEventArgs) MyBase.OnPaint(e) ' 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) ' 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 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 OnMouseAnalyzed(ByVal sender As Object, ByVal nId As Integer) Public Event OnMousePointFromSelection(ByVal sender As Object, ByVal PtP As Point3d) Public Event OnMouseDownScene(ByVal sender As Object) 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) Public Event OnNewProject(ByVal sender As Object, ByVal bOk As Boolean) Public Event OnOpeningProject(ByVal sender As Object) Public Event OnOpenProject(ByVal sender As Object, ByVal sFile As String, ByVal bOk As Boolean) Public Event OnSavingProject(ByVal sender As Object, ByVal sFile As String) Public Event OnSavedProject(ByVal sender As Object, ByVal bOk As Boolean) Public Event OnImportingProject(ByVal sender As Object, ByVal bOkType As Boolean) Public Event OnImportedProject(ByVal sender As Object, ByVal sFile As String, ByVal bOk As Boolean) Public Event OnExportingProject(ByVal sender As Object, ByVal sFile As String) Public Event OnExportedProject(ByVal sender As Object, ByVal bOk As Boolean) Public Event OnExecutingScript(ByVal sender As Object, ByVal sFile As String) Public Event OnExecutedScript(ByVal sender As Object, ByVal bOk As Boolean, ByVal sError As String) '---- Mouse ----------- Protected Overrides Sub OnMouseEnter(e As System.EventArgs) MyBase.OnMouseEnter(e) Focus() End Sub 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 NULL e premuto SHIFT allora inizio selezione a finestra If m_nStatus = ST.WINSEL Or (m_nStatus = ST.NULL And (ModifierKeys And Keys.Shift) = Keys.Shift) Then Cursor = New Cursor(Me.GetType(), "WinSelect.cur") m_PrevPoint = e.Location m_nStatus = ST.WINSEL ' se stato NULL (selezione), SELPART, SELLAYER o ANALYZE ElseIf m_nStatus = ST.NULL Or m_nStatus = ST.SELPART Or m_nStatus = ST.SELLAYER Or m_nStatus = ST.ANALYZE Then If m_nStatus <> ST.ANALYZE Then Cursor = New Cursor(Me.GetType(), "Select.cur") Else Cursor = New Cursor(Me.GetType(), "Analyze.cur") End If Dim nId As Integer = GDB_ID.NULL Dim nSel As Integer EgtSelect(e.Location, 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(e.Location) ptScreen.Offset(10, 0) MselDlg.Location = ptScreen If MselDlg.ShowDialog() = System.Windows.Forms.DialogResult.OK Then nId = MselDlg.GetId() End If End If If nId <> GDB_ID.NULL Then ' evento per entità selezionate Select Case m_nStatus Case ST.NULL RaiseEvent OnMouseSelectedObj(Me, nId, True) Case ST.SELPART RaiseEvent OnMouseSelectedPart(Me, nId) m_nStatus = ST.NULL Case ST.SELLAYER RaiseEvent OnMouseSelectedLayer(Me, nId) m_nStatus = ST.NULL Case Else RaiseEvent OnMouseAnalyzed(Me, nId) End Select ' evento per posizione punto di selezione Dim PtTemp As Point3d If EgtGetPointFromSelect(nId, e.Location, PtTemp) Then RaiseEvent OnMousePointFromSelection(Me, PtTemp) End If End If ' se stato misura di distanza (primo punto) ElseIf m_nStatus = ST.GETDIST Then 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 misura di distanza (secondo punto) ElseIf m_nStatus = ST.GETDIST2 Then 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 dX As Double = ptSel.x - m_ptPrev.x Dim dY As Double = ptSel.y - m_ptPrev.y Dim dZ As Double = ptSel.z - m_ptPrev.z Dim dDist As Double = Sqrt(dX * dX + dY * dY + dZ * dZ) Dim sOut As New System.Text.StringBuilder sOut.Append("Dist=") sOut.Append(dDist.ToString("F4", CultureInfo.InvariantCulture)) sOut.Append(" dX=") sOut.Append(dX.ToString("F4", CultureInfo.InvariantCulture)) sOut.Append(" dY=") sOut.Append(dY.ToString("F4", CultureInfo.InvariantCulture)) sOut.Append(" dZ=") sOut.Append(dZ.ToString("F4", CultureInfo.InvariantCulture)) ' lancio l'evento per visualizzare la distanza RaiseEvent OnShowDistance(Me, sOut.ToString()) m_nStatus = ST.GETDIST m_nOldStatus = ST.NULL End If ' se stato selezione punto ElseIf m_nStatus = ST.SELPOINT Then If Not m_bDragOn Then RaiseEvent OnMouseDone(Me) ElseIf 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 ' 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) 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 nId = EgtGetFirstObjInSelWin() While nId <> GDB_ID.NULL Dim nNextId = EgtGetNextObjInSelWin() RaiseEvent OnMouseSelectedObj(Me, nId, (nNextId = GDB_ID.NULL)) nId = nNextId End While ' ritorno allo stato NULL m_nStatus = ST.NULL 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 NULL ElseIf m_nStatus <> ST.NULL Then m_nStatus = ST.NULL 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 ' 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") EgtRotateCamera(m_PrevPoint, e.Location, True) m_PrevPoint = e.Location ElseIf m_nStatus = ST.PAN Then Cursor = New Cursor(Me.GetType(), "Pan.cur") EgtPanCamera(m_PrevPoint, e.Location, True) m_PrevPoint = e.Location Else m_nStatus = ST.NULL 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(IIf(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 = 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.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 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 Dim frGrid As New Frame3d EgtGetGridFrame(frGrid) ptSnap.ToLoc(frGrid) ' costruisco la stringa Dim sCursorPos As New System.Text.StringBuilder sCursorPos.Append("X=") sCursorPos.Append(ptSnap.x.ToString("F4", CultureInfo.InvariantCulture)) sCursorPos.Append(" Y=") sCursorPos.Append(ptSnap.y.ToString("F4", CultureInfo.InvariantCulture)) sCursorPos.Append(" Z=") sCursorPos.Append(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 Dim frGrid As New Frame3d EgtGetGridFrame(frGrid) ptSnap.ToLoc(frGrid) End If ' costruisco la stringa Dim sCursorPos As New System.Text.StringBuilder sCursorPos.Append("X=") sCursorPos.Append(ptSnap.x.ToString("F4", CultureInfo.InvariantCulture)) sCursorPos.Append(" Y=") sCursorPos.Append(ptSnap.y.ToString("F4", CultureInfo.InvariantCulture)) sCursorPos.Append(" Z=") sCursorPos.Append(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 EgtGetCameraDir(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(ptWorld.x.ToString("F4", CultureInfo.InvariantCulture)) sCursorPos.Append(" Y=") sCursorPos.Append(ptWorld.y.ToString("F4", CultureInfo.InvariantCulture)) Case VT.FRONT, VT.BACK sCursorPos.Append("X=") sCursorPos.Append(ptWorld.x.ToString("F4", CultureInfo.InvariantCulture)) sCursorPos.Append(" Z=") sCursorPos.Append(ptWorld.z.ToString("F4", CultureInfo.InvariantCulture)) Case VT.LEFT, VT.RIGHT sCursorPos.Append("Y=") sCursorPos.Append(ptWorld.y.ToString("F4", CultureInfo.InvariantCulture)) sCursorPos.Append(" Z=") sCursorPos.Append(ptWorld.z.ToString("F4", CultureInfo.InvariantCulture)) Case Else sCursorPos.Append(" ") End Select ' lancio l'evento per visualizzare la 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_NEAR RaiseEvent OnChangedSnapPointType(Me, m_nSnapType) End If End Sub Public Sub DisablePerpendicularPoint() m_bPerpendicularPointOn = False If m_nSnapType = SP.PT_PERPENDICULAR Then m_nSnapType = SP.PT_NEAR RaiseEvent OnChangedSnapPointType(Me, m_nSnapType) End If End Sub Public Sub DisableMinDistPoint() m_bMinDistPointOn = False If m_nSnapType = SP.PT_MINDIST Then m_nSnapType = SP.PT_NEAR RaiseEvent OnChangedSnapPointType(Me, m_nSnapType) End If End Sub Private Sub PrepareMenuScene() ' per selezione oggetti If m_nStatus = ST.NULL Then MenuScene.Visible = True For Each i As ToolStripItem In MenuScene.Items If i.Name = "cmdSelectAll" Then i.Visible = True ElseIf i.Name = "cmdDeselectAll" Then i.Visible = True ElseIf i.Name = "sepSel1" Then i.Visible = True ElseIf i.Name = "cmdWinSelect" Then i.Visible = True ElseIf i.Name = "cmdSelectPart" Then i.Visible = True ElseIf i.Name = "cmdSelectLayer" Then i.Visible = True Else i.Visible = False End If Next ' per selezione punti ElseIf m_nStatus = ST.GETDIST Or m_nStatus = ST.GETDIST2 Or m_nStatus = ST.SELPOINT Then MenuScene.Visible = True ' se drag abilitato If m_bDragOn Then For Each i As ToolStripItem In MenuScene.Items Select Case i.Name Case "cmdSketchPoint" i.Visible = True DirectCast(i, ToolStripMenuItem).Checked = (m_nSnapType = SP.PT_SKETCH) Case "cmdGridPoint" i.Visible = True DirectCast(i, ToolStripMenuItem).Checked = (m_nSnapType = SP.PT_GRID) Case "cmdEndPoint" i.Visible = True DirectCast(i, ToolStripMenuItem).Checked = (m_nSnapType = SP.PT_END) Case "cmdMidPoint" i.Visible = True DirectCast(i, ToolStripMenuItem).Checked = (m_nSnapType = SP.PT_MID) Case "cmdCenterPoint" i.Visible = True DirectCast(i, ToolStripMenuItem).Checked = (m_nSnapType = SP.CENTER) Case "cmdNearPoint" i.Visible = True DirectCast(i, ToolStripMenuItem).Checked = (m_nSnapType = SP.PT_NEAR) Case "cmdIntersectionPoint" i.Visible = True DirectCast(i, ToolStripMenuItem).Checked = (m_nSnapType = SP.PT_INTERS) Case "cmdTangentPoint" If m_bTangentPointOn Then i.Visible = True DirectCast(i, ToolStripMenuItem).Checked = (m_nSnapType = SP.PT_TANGENT) Else i.Visible = False End If Case "cmdPerpendicularPoint" If m_bPerpendicularPointOn Then i.Visible = True DirectCast(i, ToolStripMenuItem).Checked = (m_nSnapType = SP.PT_PERPENDICULAR) Else i.Visible = False End If Case "cmdMinDistPoint" 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 "cmdStopDrag" i.Visible = True 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.Visible = True Else i.Visible = False End If Next End If ' 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 EgtSelectAll(True) EgtDraw() ElseIf e.ClickedItem.Name = "cmdDeselectAll" Then EgtDeselectAll() EgtDraw() 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 ' Riabilitazione drag sospeso ElseIf e.ClickedItem.Name = "cmdRestartDrag" Then EgtResetGeoLine() m_bDragOn = True ' Scelta tipo punto snap ElseIf e.ClickedItem.Name = "cmdSketchPoint" Then m_nSnapType = SP.PT_SKETCH RaiseEvent OnChangedSnapPointType(Me, m_nSnapType) ElseIf e.ClickedItem.Name = "cmdGridPoint" Then m_nSnapType = SP.PT_GRID RaiseEvent OnChangedSnapPointType(Me, m_nSnapType) ElseIf e.ClickedItem.Name = "cmdEndPoint" Then m_nSnapType = SP.PT_END RaiseEvent OnChangedSnapPointType(Me, m_nSnapType) ElseIf e.ClickedItem.Name = "cmdMidPoint" Then m_nSnapType = SP.PT_MID RaiseEvent OnChangedSnapPointType(Me, m_nSnapType) ElseIf e.ClickedItem.Name = "cmdCenterPoint" Then m_nSnapType = SP.CENTER RaiseEvent OnChangedSnapPointType(Me, m_nSnapType) ElseIf e.ClickedItem.Name = "cmdNearPoint" Then m_nSnapType = SP.PT_NEAR RaiseEvent OnChangedSnapPointType(Me, m_nSnapType) ElseIf e.ClickedItem.Name = "cmdIntersectionPoint" Then m_nSnapType = SP.PT_INTERS RaiseEvent OnChangedSnapPointType(Me, m_nSnapType) ElseIf e.ClickedItem.Name = "cmdTangentPoint" Then m_nSnapType = SP.PT_TANGENT RaiseEvent OnChangedSnapPointType(Me, m_nSnapType) ElseIf e.ClickedItem.Name = "cmdPerpendicularPoint" Then m_nSnapType = SP.PT_PERPENDICULAR RaiseEvent OnChangedSnapPointType(Me, m_nSnapType) ElseIf e.ClickedItem.Name = "cmdMinDistPoint" Then m_nSnapType = SP.PT_MINDIST RaiseEvent OnChangedSnapPointType(Me, m_nSnapType) ' Sospensione drag ElseIf e.ClickedItem.Name = "cmdStopDrag" Then m_bDragOn = False End If End Sub '---- Status management ------------- Private Function IsRestorableCurrStatus() As Boolean Select Case m_nStatus Case ST.NULL, ST.ANALYZE, ST.SELPART, ST.SELLAYER, 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 Or m_nOldStatus = ST.SELPART Or m_nOldStatus = ST.SELLAYER 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 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) EgtResetWinRect(False) ' reset entità non selezionabili EgtUnselectableClearAll() ' imposto lo stato m_nStatus = ST.NULL m_nOldStatus = ST.NULL ' disabilito scelta punto tangente, perpendicolare e minima distanza DisableTangentPoint() DisablePerpendicularPoint() DisableMinDistPoint() ' 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.NULL m_nOldStatus = ST.NULL End If End Sub Public Sub ResetStatusGetDistance() If m_nStatus = ST.GETDIST Or m_nStatus = ST.GETDIST2 Then m_nStatus = ST.NULL m_nOldStatus = ST.NULL 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 '---- 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(Optional bSelectable As Boolean = False) As Boolean m_nDragGroup = EgtCreateGroup(GDB_ID.ROOT) If m_nDragGroup = GDB_ID.NULL Then Return False End If EgtSetLevel(m_nDragGroup, GDB_LV.TEMP) EgtSetMark(m_nDragGroup) If Not bSelectable Then EgtUnselectableAdd(m_nDragGroup) End If Return True End Function Public Function EraseDragGroup() As Boolean EgtErase(m_nDragGroup) EgtUnselectableRemove(m_nDragGroup) m_nDragGroup = GDB_ID.NULL Return True End Function Public Function AddToDragGroup(ByVal nId As Integer) As Boolean ' copio entità Dim nNewId As Integer = EgtCopyGlob(nId, m_nDragGroup, GDB_POS.SON) If nNewId = GDB_ID.NULL Then Return False End If ' 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()) Return True End Function Public Function GetDragGroup() As Integer Return m_nDragGroup End Function '---- Main Buttons ---- Public Function NewProject(Optional ByVal bCreatePart As Boolean = False) As Boolean Dim bOk As Boolean = EgtNewFile() If bOk And bCreatePart Then ' inserisco un nuovo gruppo (piece) sotto la radice Dim nIdNewPart As Integer = EgtCreateGroup(GDB_ID.ROOT) ' inserisco un nuovo gruppo (layer) sotto quello appena creato Dim nIdNewLayer As Integer = EgtCreateGroup(nIdNewPart) End If EgtZoom(ZM.ALL) ' Gestione risultato RaiseEvent OnNewProject(Me, bOk) Return bOk End Function Public Function OpenProject(Optional ByVal sDir As String = "", Optional ByVal bWithDlg As Boolean = True) As Boolean Dim sFile As String = sDir ' Scelta file con dialogo If bWithDlg Then Dim OpenFileDialog As New OpenFileDialog OpenFileDialog.Title = "Open" OpenFileDialog.Filter = "New geometry EgalTech(*.nge)|*.nge" & "|New font EgalTech(*.nfe)|*.nfe" & "|All Files (*.*)|*.*" OpenFileDialog.FilterIndex = 1 OpenFileDialog.InitialDirectory = sDir If OpenFileDialog.ShowDialog <> Windows.Forms.DialogResult.OK Then Return True End If sFile = OpenFileDialog.FileName End If 'Prima del caricamento RaiseEvent OnOpeningProject(Me) 'Caricamento del progetto Cursor = Cursors.WaitCursor Dim bOk As Boolean = EgtOpenFile(sFile) EgtZoom(ZM.ALL) Cursor = Cursors.Default 'Gestione risultato RaiseEvent OnOpenProject(Me, sFile, bOk) Return bOk End Function Public Function SaveProject(Optional ByVal sFile As String = "") As Boolean If String.IsNullOrWhiteSpace(sFile) Or EgtGetFileType(sFile) <> FT.NGE Then Return SaveAsProject(sFile) Else 'Prima del salvataggio RaiseEvent OnSavingProject(Me, sFile) 'Salvataggio del progetto Cursor = Cursors.WaitCursor Dim bOk As Boolean = EgtSaveFile(sFile, NGE.CMPTEXT) Cursor = Cursors.Default 'Gestione risultato RaiseEvent OnSavedProject(Me, bOk) Return bOk End If End Function Public Function SaveAsProject(Optional ByVal sFile As String = "") As Boolean 'Eventuale sistemazione estensione sFile = Path.ChangeExtension(sFile, "nge") 'Assegnazione nome file con dialogo Dim SaveFileDialog As New SaveFileDialog SaveFileDialog.Title = "Save" SaveFileDialog.Filter = "New geometry EgalTech(*.nge)|*.nge" SaveFileDialog.FileName = sFile SaveFileDialog.InitialDirectory = Path.GetDirectoryName(sFile) If SaveFileDialog.ShowDialog <> Windows.Forms.DialogResult.OK Then Return True End If 'Prima del salvataggio RaiseEvent OnSavingProject(Me, SaveFileDialog.FileName) 'Salvataggio del progetto Cursor = Cursors.WaitCursor Dim bOk As Boolean = EgtSaveFile(SaveFileDialog.FileName, NGE.CMPTEXT) Cursor = Cursors.Default 'Gestione risultato RaiseEvent OnSavedProject(Me, bOk) Return bOk End Function Public Function ImportProject(Optional ByVal sDir As String = "", Optional ByVal bWithDlg As Boolean = True) As Boolean Dim sFile As String = sDir 'Scelta file con dialogo If bWithDlg Then Dim OpenFileDialog As New OpenFileDialog OpenFileDialog.Title = "Import" OpenFileDialog.Filter = "Drawing Exchange Fmt(*.dxf)|*.dxf" & "|Stereolithography (*.stl)|*.stl" & "|Part program ISO (*.cnc)|*.cnc" & "|All Files (*.*)|*.*" OpenFileDialog.FilterIndex = 4 OpenFileDialog.InitialDirectory = sDir If OpenFileDialog.ShowDialog <> Windows.Forms.DialogResult.OK Then Return True End If sFile = OpenFileDialog.FileName End If 'Riconoscimento tipo file Dim nFileType As Integer = EgtGetFileType(sFile) Dim bOkType = (nFileType = FT.DXF Or nFileType = FT.STL Or nFileType = FT.CNC) 'Prima del caricamento RaiseEvent OnImportingProject(Me, bOkType) If Not bOkType Then Return False End If 'Pulizia GeomDB Cursor = Cursors.WaitCursor Dim bOk As Boolean = EgtNewFile() 'Importazione If nFileType = FT.DXF Then bOk = bOk And EgtImportDxf(sFile) ElseIf nFileType = FT.STL Then bOk = bOk And EgtImportStl(sFile) ElseIf nFileType = FT.CNC Then bOk = bOk And EgtImportCnc(sFile) End If EgtZoom(ZM.ALL) Cursor = Cursors.Default 'Gestione risultato RaiseEvent OnImportedProject(Me, sFile, bOk) Return bOk End Function Public Function ExportProject(Optional ByVal sFile As String = "") As Boolean 'Assegnazione nome file con dialogo Dim SaveFileDialog As New SaveFileDialog SaveFileDialog.Title = "Export" SaveFileDialog.Filter = "Drawing Exchange Fmt(*.dxf)|*.dxf" & "|Stereolithography (*.stl)|*.stl" & "|All Files (*.*)|*.*" SaveFileDialog.FilterIndex = 3 SaveFileDialog.FileName = sFile If SaveFileDialog.ShowDialog <> Windows.Forms.DialogResult.OK Then Return True End If 'Riconoscimento tipo file Dim nFileType As Integer = EgtGetFileType(SaveFileDialog.FileName) If nFileType <> FT.DXF And nFileType <> FT.STL Then MessageBox.Show("File type unknown", "Error", MessageBoxButtons.OK, MessageBoxIcon.Error) Return False End If 'Prima dell'esportazione RaiseEvent OnExportingProject(Me, SaveFileDialog.FileName) 'Esportazione del progetto Cursor = Cursors.WaitCursor Dim bOk As Boolean = False If nFileType = FT.DXF Then bOk = EgtExportDxf(GDB_ID.ROOT, SaveFileDialog.FileName) ElseIf nFileType = FT.STL Then bOk = EgtExportStl(GDB_ID.ROOT, SaveFileDialog.FileName) End If Cursor = Cursors.Default 'Gestione risultato RaiseEvent OnExportedProject(Me, bOk) Return bOk End Function Public Function Exec(Optional ByVal sDir As String = "", Optional ByVal bWithDlg As Boolean = True) As Boolean Dim sFile As String = sDir 'Scelta file con dialogo If bWithDlg Then Dim OpenFileDialog As New OpenFileDialog OpenFileDialog.Title = "Exec Script" OpenFileDialog.Filter = "Lua commands(*.lua)|*.lua" & "|Test commands(*.tsc)|*.tsc" & "|All Files (*.*)|*.*" OpenFileDialog.FilterIndex = 1 OpenFileDialog.InitialDirectory = sDir If OpenFileDialog.ShowDialog <> Windows.Forms.DialogResult.OK Then Return True End If sFile = OpenFileDialog.FileName End If 'Ne verifico il tipo Dim sExt As String = UCase(Path.GetExtension(sFile)) If (sExt <> ".LUA" And sExt <> ".TSC") Then MessageBox.Show("Script type unknow", "Error", MessageBoxButtons.OK, MessageBoxIcon.Error) Return False End If 'Prima dell'esecuzione RaiseEvent OnExecutingScript(Me, sFile) 'Esecuzione Cursor = Cursors.WaitCursor Dim bOk As Boolean = False If (sExt = ".LUA") Then bOk = EgtLuaExecFile(sFile) Else bOk = EgtTscExecFile(sFile) End If EgtZoom(ZM.ALL) Cursor = Cursors.Default 'Gestione risultato Dim sError As String = String.Empty If Not bOk Then If (sExt = ".LUA") Then EgtLuaGetLastError(sError) Else sError = "Error executing script" End If End If RaiseEvent OnExecutedScript(Me, bOk, sError) Return bOk 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