Files
TestEIn/Form1.vb
T
Dario Sassi 6a3cec0037 TestEIn 1.5j7 :
- nuova gestione con Controller
- aggiunti comandi di disegno.
2014-11-05 17:35:26 +00:00

1046 lines
40 KiB
VB.net

Imports System.Runtime.InteropServices
Imports System.Text
Imports System.Math
Imports System.IO
Imports System.Globalization
Imports TestEIn.EgtInterface
Imports TestEIn.GenInterface
Imports TestEIn.Controller
Public Class Form1
Private m_sIniFile As String = String.Empty
Private WithEvents m_Controller As New Controller
'-------------------------------- Form ------------------------------------------------------------
Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
' installo aggiornamento interfaccia
AddHandler System.Windows.Forms.Application.Idle, AddressOf Application_Idle
'Title
EmitTitle()
'Impostazione path Ini file
m_sIniFile = Application.StartupPath & "\TestEIn.ini"
'Inizializzazione generale di EgtInterface
EgtInit(0, Application.StartupPath & "\TestEngine.log")
'imposto chiave di protezione
Dim sKey As String = String.Empty
GetPrivateProfileString("General", "Key", "", sKey, m_sIniFile)
EgtSetKey(sKey)
'imposto dir font Nfe e font default
Dim sNfeDir As String = String.Empty
GetPrivateProfileString("GeomDB", "NfeFontDir", "", sNfeDir, m_sIniFile)
Dim sDefFont As String = String.Empty
GetPrivateProfileString("GeomDB", "DefaultFont", "", sDefFont, m_sIniFile)
EgtSetFont(sNfeDir, sDefFont)
' imposto colore di default
Dim DefColor As New Color3d(0, 0, 0)
GetPrivateProfileColor("GeomDB", "DefaultColor", DefColor, m_sIniFile)
Scene1.SetDefaultMaterial(DefColor)
' imposto colori sfondo
Dim BackTopColor As New Color3d(192, 192, 192)
GetPrivateProfileColor("Scene", "BackTop", BackTopColor, m_sIniFile)
Dim BackBotColor As New Color3d(192, 192, 192)
GetPrivateProfileColor("Scene", "BackBottom", BackBotColor, m_sIniFile)
Scene1.SetViewBackground(BackTopColor, BackBotColor)
' imposto colore di evidenziazione
Dim MarkColor As New Color3d(255, 255, 0)
GetPrivateProfileColor("Scene", "Mark", MarkColor, m_sIniFile)
Scene1.SetMarkMaterial(MarkColor)
' imposto tipo e colore del rettangolo di zoom
Dim bOutline As Boolean = True
Dim ZwColor As New Color3d(0, 0, 0)
GetPrivateProfileZoomWin("Scene", "ZoomWin", bOutline, ZwColor, m_sIniFile)
Scene1.SetZoomWinAttribs(bOutline, ZwColor)
' imposto colore della linea di distanza
Dim DstLnColor As New Color3d(255, 0, 0)
GetPrivateProfileColor("Scene", "DistLine", DstLnColor, m_sIniFile)
Scene1.SetDistLineMaterial(DstLnColor)
' imposto parametri OpenGL
Dim nDriver As Integer = GetPrivateProfileInt("OpenGL", "Driver", 3, m_sIniFile)
Dim b2Buff As Boolean = (GetPrivateProfileInt("OpenGL", "DoubleBuffer", 1, m_sIniFile) <> 0)
Dim nColorBits As Integer = GetPrivateProfileInt("OpenGL", "ColorBits", 32, m_sIniFile)
Dim nDepthBits As Integer = GetPrivateProfileInt("OpenGL", "DepthBits", 32, m_sIniFile)
Scene1.SetViewAttributes(nDriver, b2Buff, nColorBits, nDepthBits)
' inizializzo scena
Scene1.Init()
' imposto i dati della griglia
Dim bShowGrid As Boolean = (GetPrivateProfileInt("Grid", "ShowGrid", 1, m_sIniFile) <> 0)
Dim bShowFrame As Boolean = (GetPrivateProfileInt("Grid", "ShowFrame", 1, m_sIniFile) <> 0)
Dim dSnapStep As Double = GetPrivateProfileDouble("Grid", "SnapStep", 10, m_sIniFile)
Dim nMinLineSStep As Integer = GetPrivateProfileInt("Grid", "MinLineSStep", 1, m_sIniFile)
Dim nMajLineSStep As Integer = GetPrivateProfileInt("Grid", "MajLineSStep", 10, m_sIniFile)
Dim nExtSStep As Integer = GetPrivateProfileInt("Grid", "ExtSStep", 50, m_sIniFile)
Dim MinLnColor As New Color3d(160, 160, 160)
GetPrivateProfileColor("Grid", "MinLnColor", MinLnColor, m_sIniFile)
Dim MajLnColor As New Color3d(160, 160, 160)
GetPrivateProfileColor("Grid", "MajLnColor", MajLnColor, m_sIniFile)
EgtSetGridShow(bShowGrid, bShowFrame)
EgtSetGridFrame(Frame3d.GLOB)
EgtSetGridGeo(dSnapStep, nMinLineSStep, nMajLineSStep, nExtSStep)
EgtSetGridColor(MinLnColor, MajLnColor)
' modo di visualizzazione
Dim nShowMode As Integer = GetPrivateProfileInt("Scene", "ShowMode", SM.SHADING, m_sIniFile)
If nShowMode = SM.WIREFRAME Then
rbtWireFrame.Checked = True
ElseIf nShowMode = SM.HIDDENLINE Then
rbtHiddenLine.Checked = True
Else
rbtShading.Checked = True
End If
' visualizzazione direzione curve
Dim nShowCurveDir As Integer = GetPrivateProfileInt("Scene", "CurveDir", 0, m_sIniFile)
chkCurveDir.Checked = (nShowCurveDir <> 0)
' ObjTree non selezionato
m_nObjTreeOldId = GDB_ID.NULL
' aggiungo voce per about box nel menù di sistema
Dim hSysMenu As IntPtr = GetSystemMenu(Handle, False)
If hSysMenu <> IntPtr.Zero Then
AppendMenu(hSysMenu, MF_SEPARATOR, 0, "")
AppendMenu(hSysMenu, MF_STRING, IDM_ABOUTBOX, "About TestEIn...")
End If
'Posizione e dimensioni del Form
If ModifierKeys <> Keys.Shift Then
Dim nFlag As Integer
Dim nLeft As Integer
Dim nTop As Integer
Dim nWidth As Integer
Dim nHeight As Integer
GetPrivateProfileWinPos("General", "WinPlace", nFlag, nLeft, nTop, nWidth, nHeight, m_sIniFile)
Me.StartPosition = System.Windows.Forms.FormStartPosition.Manual
Me.Location = New Point(nLeft, nTop)
Me.Size = New Size(nWidth, nHeight)
WindowState = IIf(nFlag = 1, FormWindowState.Maximized, FormWindowState.Normal)
End If
' Impostazioni controller
m_Controller.SetScene(Scene1)
' Recupero eventuali parametri da linea di comando
Dim bOpen As Boolean = False
For Each s As String In My.Application.CommandLineArgs
If Not String.IsNullOrWhiteSpace(s) Then
Dim nFileType As Integer = EgtGetFileType(s)
Select Case nFileType
Case FT.NGE, FT.NFE
Scene1.OpenProject(s, False)
bOpen = True
Case FT.DXF, FT.STL, FT.CNC
Scene1.ImportProject(s, False)
bOpen = True
Case FT.TSC, FT.LUA
Scene1.Exec(s, False)
bOpen = True
End Select
Exit For
End If
Next
If Not bOpen Then
Scene1.NewProject(True)
End If
End Sub
Private Sub Form1_FormClosing(sender As System.Object, e As FormClosingEventArgs) Handles MyBase.FormClosing
' gestisco eventuale file corrente modificato
If Not m_Controller.ManageModified() Then
e.Cancel = True
Return
End If
' Salvo modo di visualizzazione
WritePrivateProfileString("Scene", "ShowMode", EgtGetShowMode(), m_sIniFile)
' Salvo stato visualizzazione direzione curve
WritePrivateProfileString("Scene", "CurveDir", IIf(EgtGetShowCurveDirection(), 1, 0), m_sIniFile)
' Salvo posizione Form
Dim nFlag As Integer = IIf(Me.WindowState = FormWindowState.Maximized, 1, 0)
WritePrivateProfileWinPos("General", "WinPlace", nFlag, Me.Left, Me.Top, Me.Width, Me.Height, m_sIniFile)
' Terminazione generale di EgtInterface
EgtExit()
End Sub
Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
MyBase.WndProc(m)
If m.Msg = WM_SYSCOMMAND Then
If m.WParam.ToInt32 = IDM_ABOUTBOX Then
AboutBox1.ShowDialog()
End If
End If
End Sub
'-------------------------------- Events management ----------------------------------------------
Private Sub OnCursorPos(ByVal sender As Object, ByVal sCursorPos As String) Handles Scene1.OnCursorPos
ToolStripStatusCursorPos.Text = sCursorPos
End Sub
Private Sub OnMouseSelected(ByVal sender As Object, ByVal nId As Integer, ByVal bLast As Boolean) Handles Scene1.OnMouseSelected
If EgtIsSelectedObj(nId) Then
EgtDeselectObj(nId)
Else
EgtSelectObj(nId)
End If
If bLast Then
EgtDraw()
End If
End Sub
Private Sub OnMouseAnalyzed(ByVal sender As Object, ByVal nId As Integer) Handles Scene1.OnMouseAnalyzed
SelectIdInObjTree(nId)
End Sub
Private Sub OnShowDistance(ByVal sender As Object, ByVal sDistance As String) Handles Scene1.OnShowDistance
ToolStripStatusOutput.Text = sDistance
End Sub
Private Sub OnNewProject(ByVal sender As Object) Handles Scene1.OnNewProject
m_Controller.ResetCurrFile()
m_Controller.ResetModified()
m_Controller.ExecuteCommand(CMD.RESETCURRPARTLAYER)
EmitTitle()
EmitCurrPartLayer()
LoadObjTree()
End Sub
Private Sub OnOpeningProject(ByVal sender As Object) Handles Scene1.OnOpeningProject
ClearObjTree()
End Sub
Private Sub OnOpenProject(ByVal sender As Object, ByVal sFile As String) Handles Scene1.OnOpenProject
m_Controller.SetCurrFile(sFile)
m_Controller.ResetModified()
m_Controller.ExecuteCommand(CMD.RESETCURRPARTLAYER)
EmitTitle()
EmitCurrPartLayer()
LoadObjTree()
WritePrivateProfileString("General", "LastNgeDir", Path.GetDirectoryName(sFile), m_sIniFile)
End Sub
Private Sub OnSavingProject(ByVal sender As Object, ByVal sFile As String) Handles Scene1.OnSavingProject
m_Controller.SetCurrFile(sFile)
EmitTitle()
WritePrivateProfileString("General", "LastNgeDir", Path.GetDirectoryName(sFile), m_sIniFile)
End Sub
Private Sub OnSavedProject(ByVal sender As Object) Handles Scene1.OnSavedProject
m_Controller.ResetModified()
End Sub
Private Sub OnImportingProject(ByVal sender As Object) Handles Scene1.OnImportingProject
ClearObjTree()
End Sub
Private Sub OnImportedProject(ByVal sender As Object, ByVal sFile As String) Handles Scene1.OnImportedProject
m_Controller.SetCurrFile(sFile)
m_Controller.SetModified()
m_Controller.ExecuteCommand(CMD.RESETCURRPARTLAYER)
EmitTitle()
EmitCurrPartLayer()
LoadObjTree()
WritePrivateProfileString("General", "LastImpDir", Path.GetDirectoryName(sFile), m_sIniFile)
End Sub
Private Sub OnExportingProject(ByVal sender As Object, ByVal sFile As String) Handles Scene1.OnExportingProject
WritePrivateProfileString("General", "LastExpDir", Path.GetDirectoryName(sFile), m_sIniFile)
End Sub
Private Sub OnExportedProject(ByVal sender As Object) Handles Scene1.OnExportedProject
End Sub
Private Sub OnExecutingScript(ByVal sender As Object, ByVal sFile As String) Handles Scene1.OnExecutingScript
WritePrivateProfileString("General", "LastLuaDir", Path.GetDirectoryName(sFile), m_sIniFile)
ClearObjTree()
End Sub
Private Sub OnExecutedScript(ByVal sender As Object) Handles Scene1.OnExecutedScript
m_Controller.SetModified()
LoadObjTree()
End Sub
Private Sub OnMouseSelectedPoint(ByVal sender As Object, ByVal PtP As Point3d) Handles Scene1.OnMouseSelectedPoint
m_Controller.SetLastPoint3d(PtP)
If (ModifierKeys And Keys.Control) <> Keys.Control Then
m_Controller.GoToNextStatus()
Else
' eseguo ultimo drag
m_Controller.SetLastPoint3d(PtP)
m_Controller.ExecuteDrag()
' passo in modalità input da box
Scene1.DisableDrag()
SetInputBoxPoint3d(PtP)
End If
End Sub
Private Sub OnMouseMoveSelPoint(ByVal sender As Object, ByVal PtP As Point3d) Handles Scene1.OnMouseMoveSelPoint
m_Controller.SetLastPoint3d(PtP)
m_Controller.ExecuteDrag()
End Sub
Private Sub OnSetInputBox(ByVal sTitle As String, ByVal sLabel As String, ByVal nType As IBT) Handles m_Controller.SetInputBox
SetInputBox(sTitle, sLabel, nType)
End Sub
Private Sub OnUpdateUI(ByVal sender) Handles m_Controller.UpdateUI
ResetInputBox()
ToolStripStatusOutput.Text = ""
LoadObjTree()
End Sub
'-------------------------------- Buttons --------------------------------------------------------
Private Sub btnNew_Click(sender As System.Object, e As System.EventArgs) Handles btnNew.Click
' gestisco eventuale file corrente modificato
If Not m_Controller.ManageModified() Then
Return
End If
' eseguo
Scene1.NewProject(True)
End Sub
Private Sub btnOpen_Click(sender As System.Object, e As System.EventArgs) Handles btnOpen.Click
' gestisco eventuale file corrente modificato
If Not m_Controller.ManageModified() Then
Return
End If
' eseguo
Dim sDir As String = String.Empty
GetPrivateProfileString("General", "LastNgeDir", "", sDir, m_sIniFile)
Scene1.OpenProject(sDir)
End Sub
Private Sub btnSave_Click(sender As System.Object, e As System.EventArgs) Handles btnSave.Click
Scene1.SaveProject(m_Controller.GetCurrFile())
End Sub
Private Sub btnSaveAs_Click(sender As System.Object, e As System.EventArgs) Handles btnSaveAs.Click
Scene1.SaveAsProject(m_Controller.GetCurrFile())
End Sub
Private Sub btnImport_Click(sender As System.Object, e As System.EventArgs) Handles btnImport.Click
' gestisco eventuale file corrente modificato
If Not m_Controller.ManageModified() Then
Return
End If
' eseguo
Dim sDir As String = String.Empty
GetPrivateProfileString("General", "LastImpDir", "", sDir, m_sIniFile)
Scene1.ImportProject(sDir)
End Sub
Private Sub btnExport_Click(sender As System.Object, e As System.EventArgs) Handles btnExport.Click
Scene1.ExportProject(Path.ChangeExtension(m_Controller.GetCurrFile(), "dxf"))
End Sub
Private Sub btnExec_Click(sender As System.Object, e As System.EventArgs) Handles btnExec.Click
Dim sDir As String = String.Empty
GetPrivateProfileString("General", "LastLuaDir", "", sDir, m_sIniFile)
Scene1.Exec(sDir)
End Sub
Private Sub rbtWireFrame_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles rbtWireFrame.CheckedChanged
Scene1.WireFrame()
End Sub
Private Sub rbtHiddenLine_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles rbtHiddenLine.CheckedChanged
Scene1.HiddenLine()
End Sub
Private Sub rbtShading_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles rbtShading.CheckedChanged
Scene1.Shading()
End Sub
Private Sub chkCurveDir_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles chkCurveDir.CheckedChanged
EgtSetShowCurveDirection(chkCurveDir.Checked)
End Sub
Private Sub chkAnalyze_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles chkAnalyze.CheckedChanged
If chkAnalyze.Checked Then
chkGetDist.Checked = False
Scene1.SetStatusAnalyze()
Else
Scene1.ResetStatusAnalyze()
SelectIdInObjTree(GDB_ID.NULL)
End If
End Sub
Private Sub chkGetDist_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles chkGetDist.CheckedChanged
If chkGetDist.Checked Then
chkAnalyze.Checked = False
Scene1.SetStatusGetDistance()
ToolStripStatusOutput.Text = " "
Else
Scene1.ResetStatusGetDistance()
ToolStripStatusOutput.Text = " "
End If
End Sub
Private Sub btnZoomAll_Click(sender As System.Object, e As System.EventArgs) Handles btnZoomAll.Click
Scene1.ZoomAll()
End Sub
Private Sub btnZoomIn_Click(sender As System.Object, e As System.EventArgs) Handles btnZoomIn.Click
Scene1.ZoomIn()
End Sub
Private Sub btnZoomOut_Click(sender As System.Object, e As System.EventArgs) Handles btnZoomOut.Click
Scene1.ZoomOut()
End Sub
Private Sub btnTop_Click(sender As System.Object, e As System.EventArgs) Handles btnTop.Click
Scene1.TopView()
End Sub
Private Sub btnFront_Click(sender As System.Object, e As System.EventArgs) Handles btnFront.Click
Scene1.FrontView()
End Sub
Private Sub btnLeft_Click(sender As System.Object, e As System.EventArgs) Handles btnLeft.Click
Scene1.LeftView()
End Sub
Private Sub btnBack_Click(sender As System.Object, e As System.EventArgs) Handles btnBack.Click
Scene1.BackView()
End Sub
Private Sub btnRight_Click(sender As System.Object, e As System.EventArgs) Handles btnRight.Click
Scene1.RightView()
End Sub
Private Sub btnIsoSW_Click(sender As System.Object, e As System.EventArgs) Handles btnIsoSW.Click
Scene1.IsoViewSW()
End Sub
Private Sub btnIsoSE_Click(sender As System.Object, e As System.EventArgs) Handles btnIsoSE.Click
Scene1.IsoViewSE()
End Sub
Private Sub btnIsoNE_Click(sender As System.Object, e As System.EventArgs) Handles btnIsoNE.Click
Scene1.IsoViewNE()
End Sub
Private Sub btnIsoNW_Click(sender As System.Object, e As System.EventArgs) Handles btnIsoNW.Click
Scene1.IsoViewNW()
End Sub
' --------------------- Update UI -------------------------------
Private Sub Application_Idle(ByVal sender As Object, ByVal e As EventArgs)
' Gestione abilitazione bottoni
Dim bLayerOk As Boolean = (m_Controller.GetCurrLayer() <> GDB_ID.NULL)
Dim bSelOk As Boolean = (EgtGetFirstSelectedObj() <> GDB_ID.NULL)
' Draw
btnPoint.Enabled = bLayerOk
btnLine2P.Enabled = bLayerOk
btnCircleCR.Enabled = bLayerOk
btnArcCSE.Enabled = bLayerOk
btnArc3P.Enabled = bLayerOk
' Construct
btnPlane.Enabled = bLayerOk And bSelOk
btnExtrude.Enabled = bLayerOk And bSelOk
btnRevolve.Enabled = bLayerOk And bSelOk
' Edit
btnDelete.Enabled = bSelOk
btnChangeColor.Enabled = bSelOk
btnInvertCurve.Enabled = bSelOk
btnJoinCurve.Enabled = bLayerOk And bSelOk
btnSplitCurve.Enabled = bSelOk
' Transform
btnCopy.Enabled = bSelOk
btnMove.Enabled = bSelOk
btnRotate.Enabled = bSelOk
btnMirror.Enabled = bSelOk
End Sub
' --------------------- Commands --------------------------------
Private Sub btnPoint_Click(sender As System.Object, e As System.EventArgs) Handles btnPoint.Click
m_Controller.ExecuteCommand(CMD.POINT)
End Sub
Private Sub btnLine2P_Click(sender As System.Object, e As System.EventArgs) Handles btnLine2P.Click
m_Controller.ExecuteCommand(CMD.LINE2P)
End Sub
Private Sub btnCircleCR_Click(sender As System.Object, e As System.EventArgs) Handles btnCircleCR.Click
m_Controller.ExecuteCommand(CMD.CIRCLECR)
End Sub
Private Sub btnArcCSE_Click(sender As System.Object, e As System.EventArgs) Handles btnArcCSE.Click
m_Controller.ExecuteCommand(CMD.ARCCSE)
End Sub
Private Sub btnArc3P_Click(sender As System.Object, e As System.EventArgs) Handles btnArc3P.Click
m_Controller.ExecuteCommand(CMD.ARC3P)
End Sub
Private Sub btnPlane_Click(sender As System.Object, e As System.EventArgs) Handles btnPlane.Click
m_Controller.ExecuteCommand(CMD.PLANE)
End Sub
Private Sub btnExtrude_Click(sender As System.Object, e As System.EventArgs) Handles btnExtrude.Click
m_Controller.ExecuteCommand(CMD.EXTRUDE)
End Sub
Private Sub btnRevolve_Click(sender As System.Object, e As System.EventArgs) Handles btnRevolve.Click
m_Controller.ExecuteCommand(CMD.REVOLVE)
End Sub
Private Sub btnDelete_Click(sender As System.Object, e As System.EventArgs) Handles btnDelete.Click
m_Controller.ExecuteCommand(CMD.DELETE)
End Sub
Private Sub btnChangeColor_Click(sender As System.Object, e As System.EventArgs) Handles btnChangeColor.Click
If (ModifierKeys And Keys.Shift) <> Keys.Shift Then
m_Controller.ExecuteCommand(CMD.CHANGECOLOR)
Else
m_Controller.ExecuteCommand(CMD.RESETCOLOR)
End If
End Sub
Private Sub btnInvertCurve_Click(sender As System.Object, e As System.EventArgs) Handles btnInvertCurve.Click
m_Controller.ExecuteCommand(CMD.INVERTCRVSURF)
End Sub
Private Sub btnJoinCurve_Click(sender As System.Object, e As System.EventArgs) Handles btnJoinCurve.Click
m_Controller.ExecuteCommand(CMD.JOINCURVE)
End Sub
Private Sub btnSplitCurve_Click(sender As System.Object, e As System.EventArgs) Handles btnSplitCurve.Click
m_Controller.ExecuteCommand(CMD.SPLITCURVE)
End Sub
Private Sub btnMove_Click(sender As System.Object, e As System.EventArgs) Handles btnMove.Click
m_Controller.ExecuteCommand(CMD.MOVE)
End Sub
Private Sub btnCopy_Click(sender As System.Object, e As System.EventArgs) Handles btnCopy.Click
m_Controller.ExecuteCommand(CMD.COPY)
End Sub
Private Sub btnRotate_Click(sender As System.Object, e As System.EventArgs) Handles btnRotate.Click
If (ModifierKeys And Keys.Shift) <> Keys.Shift Then
m_Controller.ExecuteCommand(CMD.ROTATE)
Else
m_Controller.ExecuteCommand(CMD.ROTATE3D)
End If
End Sub
Private Sub btnMirror_Click(sender As System.Object, e As System.EventArgs) Handles btnMirror.Click
m_Controller.ExecuteCommand(CMD.MIRROR)
End Sub
' ----------------- Test Commands -------------------
Private Sub XbtnRotP90_Click(sender As System.Object, e As System.EventArgs) Handles XbtnRotP90.Click
XRotate(90)
' aggiorno visualizzazione
Scene1.ZoomAll()
UpdateObjInObjTree(m_nObjTreeOldId)
End Sub
Private Sub XbtnRotM90_Click(sender As System.Object, e As System.EventArgs) Handles XbtnRotM90.Click
XRotate(-90)
' aggiorno visualizzazione
Scene1.ZoomAll()
UpdateObjInObjTree(m_nObjTreeOldId)
End Sub
Private Sub XRotate(ByVal dAngRotDeg As Double)
' indice del primo gruppo sotto la radice
Dim nId As Integer = EgtGetFirstInGroup(GDB_ID.ROOT)
' recupero il box del gruppo in globale
Dim PtMinPre As New Point3d
Dim PtMaxPre As New Point3d
EgtGetBBoxGlob(nId, BBF.IGNORE_TEXT + BBF.EXACT, PtMinPre, PtMaxPre)
' ruoto attorno al punto minimo
EgtRotateGlob(nId, PtMinPre, EgtGetGridVersZ(), dAngRotDeg)
' calcolo nuovo box in globale
Dim PtMinPost As New Point3d
Dim PtMaxPost As New Point3d
EgtGetBBoxGlob(nId, BBF.IGNORE_TEXT + BBF.EXACT, PtMinPost, PtMaxPost)
' eseguo traslazione per riavere lo stesso punto minimo
Dim VtMove As Vector3d = PtMinPre - PtMinPost
EgtMoveGlob(nId, VtMove)
End Sub
Private Sub XbtnMirror_Click(sender As System.Object, e As System.EventArgs) Handles XbtnMirror.Click
' indice del primo gruppo sotto la radice
Dim nId As Integer = EgtGetFirstInGroup(GDB_ID.ROOT)
' recupero il box del gruppo in globale
Dim PtMin As New Point3d
Dim PtMax As New Point3d
EgtGetBBoxGlob(nId, BBF.IGNORE_TEXT + BBF.EXACT, PtMin, PtMax)
Dim PtCen As Point3d = Point3d.Media(PtMin, PtMax)
' mirror rispetto a Y centrato nel box
EgtMirrorGlob(nId, PtCen, Vector3d.X_AX)
' sistemo gli eventuali testi
XUnMirrorTexts(nId)
' aggiorno visualizzazione
Scene1.ZoomAll()
UpdateObjInObjTree(m_nObjTreeOldId)
End Sub
Private Sub XUnMirrorTexts(ByVal nGroupId As Integer)
Dim nId As Integer = EgtGetFirstInGroup(nGroupId)
While nId <> GDB_ID.NULL
'recupero il tipo di oggetto
Dim nType As Integer = EgtGetType(nId)
'se gruppo
If nType = TY.GROUP Then
XUnMirrorTexts(nId)
' se testo
ElseIf nType = TY.EXT_TEXT Then
EgtMirrorText(nId, True)
End If
' passo al successivo
nId = EgtGetNext(nId)
End While
End Sub
'-------------------------------- KeyDown --------------------------------------------------------
Private Sub Form1_KeyDown(ByVal sender As System.Object, ByVal e As KeyEventArgs) Handles MyBase.KeyDown
' Con ESC esco dall'azione corrente
If e.KeyData = Keys.Escape Then
' reset Azione corrente
m_Controller.ResetStatus()
' reset Analisi e Distanza
chkAnalyze.Checked = False
chkGetDist.Checked = False
' pulisco output
ToolStripStatusOutput.Text = ""
ResetInputBox()
End If
End Sub
Private Sub Scene1_KeyDown(ByVal sender As System.Object, ByVal e As KeyEventArgs) Handles Scene1.KeyDown
' Con DEL eseguo cancellazione delle entità selezionate
If e.KeyData = Keys.Delete Then
m_Controller.ExecuteCommand(CMD.DELETE)
' con SPAZIO ripeto l'ultimo comando
ElseIf e.KeyData = Keys.Space Then
m_Controller.RepeatLastCommand()
End If
End Sub
' --------------------- Input Box -------------------------------
Private m_bInput As Boolean = False
Private m_nInpType As IBT = IBT.TY_NULL
Public Sub SetInputBox(ByRef sTitle As String, ByRef sLabel As String, ByVal nType As IBT)
InputBox.Show()
InputBox.Text = sTitle
InputLabel.Show()
InputLabel.Text = sLabel
InputText.Show()
m_bInput = True
m_nInpType = nType
InputText.Focus()
End Sub
Public Sub ResetInputBox()
InputBox.Hide()
InputBox.Text = ""
InputLabel.Hide()
InputLabel.Text = ""
InputText.Hide()
InputText.Text = ""
m_nInpType = IBT.TY_NULL
m_bInput = False
End Sub
Private Function SetInputBoxDouble(ByVal dVal As Double) As Boolean
Dim sText As New StringBuilder
sText.Append(dVal.ToString("F3", CultureInfo.InvariantCulture))
InputText.Text = sText.ToString()
Return True
End Function
Private Function SetInputBoxPoint3d(ByVal PtVal As Point3d) As Boolean
Dim sText As New StringBuilder
sText.Append(PtVal.x.ToString("F3", CultureInfo.InvariantCulture))
sText.Append(",")
sText.Append(PtVal.y.ToString("F3", CultureInfo.InvariantCulture))
sText.Append(",")
sText.Append(PtVal.z.ToString("F3", CultureInfo.InvariantCulture))
InputText.Text = sText.ToString()
Return True
End Function
Private Function GetInputBoxDouble(ByRef dVal As Double) As Boolean
Return Double.TryParse(InputText.Text, NumberStyles.Float, CultureInfo.InvariantCulture, dVal)
End Function
Private Function GetInputBoxPoint3d(ByRef PtVal As Point3d) As Boolean
Dim sItems() As String = InputText.Text.Split(",".ToCharArray)
Dim bOk As Boolean = False
PtVal = Point3d.ORIG
If sItems.Count() >= 1 Then
bOk = Double.TryParse(sItems(0), NumberStyles.Float, CultureInfo.InvariantCulture, PtVal.x)
If sItems.Count() >= 2 Then
bOk = Double.TryParse(sItems(1), NumberStyles.Float, CultureInfo.InvariantCulture, PtVal.y) And bOk
If sItems.Count() >= 3 Then
bOk = Double.TryParse(sItems(2), NumberStyles.Float, CultureInfo.InvariantCulture, PtVal.z) And bOk
End If
End If
End If
Return bOk
End Function
Private Function InputBoxTextToLast() As Boolean
Select Case m_nInpType
Case IBT.TY_DOUBLE
Dim dVal As Double
If GetInputBoxDouble(dVal) Then
m_Controller.SetLastDouble(dVal)
Return True
End If
Case IBT.TY_POINT3D
Dim ptP As Point3d
If GetInputBoxPoint3d(ptP) Then
m_Controller.SetLastPoint3d(ptP)
Return True
End If
End Select
Return False
End Function
Private Sub InputText_KeyDown(ByVal sender As System.Object, ByVal e As KeyEventArgs) Handles InputText.KeyDown
' Con SHIFT aggiorno la grafica con i dati correnti
If (e.KeyData And Keys.Shift) = Keys.Shift Then
InputBoxTextToLast()
Scene1.DisableDrag()
EgtResetGeoLine()
m_Controller.ExecuteDrag()
' Con RETURN devo eseguire lo stato corrente
ElseIf e.KeyData = Keys.Return Then
InputBoxTextToLast()
m_Controller.GoToNextStatus()
End If
End Sub
'-------------------------------- Command Box ----------------------------------------------------
Private Sub tboxCmd_KeyDown(sender As System.Object, e As System.Windows.Forms.KeyEventArgs) Handles tboxCmd.KeyDown
If (e.KeyCode = Keys.Enter) Then
Dim nLine As Integer = tboxCmd.GetLineFromCharIndex(tboxCmd.GetFirstCharIndexOfCurrentLine)
Dim sCmd As String = tboxCmd.Lines(nLine).ToString
If Not String.IsNullOrEmpty(sCmd) Then
' ripristino stato oggetto marcato
Dim nIdOld As Integer = RevertOldIdInObjTree()
' eseguo comando
If EgtTscExecLine(sCmd) Then
Scene1.Invalidate()
ToolStripStatusOnR.Text = " "
Else
ToolStripStatusOnR.Text = "Error executing command"
End If
' ricarico albero degli oggetti
LoadObjTree()
SelectIdInObjTree(nIdOld)
End If
End If
End Sub
'-------------------------------- Current Piece/Layer --------------------------------------------
Private Sub btnNewPart_Click(sender As System.Object, e As System.EventArgs) Handles btnNewPart.Click
m_Controller.ExecuteCommand(CMD.NEWPART)
' aggiorno visualizzazione
EmitCurrPartLayer()
LoadObjTree()
End Sub
Private Sub btnNewLayer_Click(sender As System.Object, e As System.EventArgs) Handles btnNewLayer.Click
m_Controller.ExecuteCommand(CMD.NEWLAYER)
' aggiorno visualizzazione
EmitCurrPartLayer()
LoadObjTree()
End Sub
Private Sub btnColor_Click(sender As System.Object, e As System.EventArgs) Handles btnColor.Click
m_Controller.ExecuteCommand(CMD.LAYERCOLOR)
' aggiorno visualizzazione
EmitCurrPartLayer()
End Sub
Private Sub EmitCurrPartLayer()
Dim sText As String = " "
Dim colObj As Color3d
EgtGetColor(GDB_ID.ROOT, colObj)
Dim nCurrPart As Integer = m_Controller.GetCurrPart()
If nCurrPart <> GDB_ID.NULL Then
sText = "Part " + nCurrPart.ToString()
EgtGetCalcColor(nCurrPart, colObj)
Dim nCurrLayer As Integer = m_Controller.GetCurrLayer()
If nCurrLayer <> GDB_ID.NULL And EgtExistsObj(nCurrLayer) Then
sText += " --> Layer " + nCurrLayer.ToString()
EgtGetCalcColor(nCurrLayer, colObj)
End If
End If
txtPartLay.Text = sText
colObj.A = 100
txtColor.BackColor = colObj.ToColor()
End Sub
'-------------------------------- Tree View ------------------------------------------------------
Private m_nObjTreeOldId As Integer = GDB_ID.NULL
Private m_bMark As Boolean = True
Private Sub ObjTreeTickEvent(source As Object, e As EventArgs) Handles ObjTreeTimer.Tick
If m_nObjTreeOldId <> GDB_ID.NULL Then
EgtResetMark(m_nObjTreeOldId)
EgtDraw()
End If
ObjTreeTimer.Stop()
End Sub
Public Sub LoadObjTree()
Dim nOldId As Integer = ClearObjTree()
TreeView1.BeginUpdate()
AddGroupInObjTree(GDB_ID.ROOT, 0, TreeView1.Nodes)
TreeView1.EndUpdate()
If nOldId <> GDB_ID.NULL Then
m_bMark = False
SelectIdInObjTree(nOldId)
m_bMark = True
End If
End Sub
Private Function ClearObjTree() As Integer
Dim nOldId As Integer = RevertOldIdInObjTree()
TreeView1.Nodes.Clear()
Return nOldId
End Function
Private Sub AddGroupInObjTree(ByVal nGroupId As Integer, ByVal nLev As Integer, ByRef PrevNodColl As TreeNodeCollection)
Dim CurrNodColl As TreeNodeCollection
If nGroupId = GDB_ID.ROOT Then
CurrNodColl = PrevNodColl
Else
Dim sName As String = String.Empty
Dim sText As String = String.Empty
If EgtGetName(nGroupId, sName) Then
If nLev = 1 Then
sText = sName + " (Part " + nGroupId.ToString + ")"
ElseIf nLev = 2 Then
sText = sName + " (Layer " + nGroupId.ToString + ")"
Else
sText = sName + " (Group " + nGroupId.ToString + ")"
End If
Else
If nLev = 1 Then
sText = "Part " + nGroupId.ToString
ElseIf nLev = 2 Then
sText = "Layer " + nGroupId.ToString
Else
sText = "Group " + nGroupId.ToString
End If
End If
Dim nImage As Integer = TypeToImageInObjTree(TY.GROUP, nLev)
CurrNodColl = PrevNodColl.Add(nGroupId.ToString, sText, nImage, nImage).Nodes
End If
Dim nObjs As Integer = EgtGetGroupObjs(nGroupId)
If (nObjs > 20000) Then
CurrNodColl.Add("-1", "Too many entities")
Return
End If
Dim nId As Integer = EgtGetFirstInGroup(nGroupId)
While nId <> GDB_ID.NULL
'recupero il tipo di nodo
Dim nType As Integer = EgtGetType(nId)
'se gruppo
If nType = TY.GROUP Then
AddGroupInObjTree(nId, nLev + 1, CurrNodColl)
'se oggetto geometrico
ElseIf nType >= TY.GEO_VECTOR Then
Dim sTitle As String = String.Empty
EgtGetTitle(nId, sTitle)
Dim sName As String = String.Empty
Dim sText As String = String.Empty
If EgtGetName(nId, sName) Then
sText = sName + " (" + sTitle + " " + nId.ToString + ")"
Else
sText = sTitle + " " + nId.ToString
End If
Dim nImage As Integer = TypeToImageInObjTree(nType, nLev)
CurrNodColl.Add(nId.ToString, sText, nImage, nImage)
End If
'passo al successivo
nId = EgtGetNext(nId)
End While
End Sub
Private Function TypeToImageInObjTree(ByVal nType As Integer, ByVal nLev As Integer) As Integer
Select Case nType
Case TY.GROUP
If nLev = 1 Then
Return 3
ElseIf nLev = 2 Then
Return 4
Else
Return 2
End If
Case TY.GEO_VECTOR
Return 5
Case TY.GEO_POINT
Return 6
Case TY.GEO_FRAME
Return 7
Case TY.CRV_LINE
Return 8
Case TY.CRV_ARC
Return 9
Case TY.CRV_BEZ
Return 10
Case TY.CRV_COMPO
Return 11
Case TY.SRF_MESH
Return 12
Case TY.EXT_TEXT
Return 13
End Select
Return 1
End Function
Private Sub ObjTree_AfterSelect(ByVal sender As Object, ByVal e As TreeViewEventArgs) Handles TreeView1.AfterSelect
' recupero l'Id del nuovo oggetto selezionato
Dim nId As Integer
If Not Int32.TryParse(e.Node.Name, nId) Then
Return
End If
UpdateObjInObjTree(nId)
End Sub
Private Sub ObjTree_MouseUp(ByVal sender As Object, e As MouseEventArgs) Handles TreeView1.MouseUp
If m_nObjTreeOldId <> GDB_ID.NULL Then
' evidenzio
EgtSetMark(m_nObjTreeOldId)
EgtDraw()
' lancio timer per successiva de-evidenziazione
ObjTreeTimer.Stop()
ObjTreeTimer.Start()
End If
End Sub
Private Sub ObjTree_MouseDoubleClick(ByVal sender As Object, e As MouseEventArgs) Handles TreeView1.MouseDoubleClick
If m_nObjTreeOldId <> GDB_ID.NULL Then
' recupero il padre
Dim nIdParent As Integer = EgtGetParent(m_nObjTreeOldId)
If nIdParent = GDB_ID.NULL Then
Return
' se Part
ElseIf nIdParent = GDB_ID.ROOT Then
' cerco il primo Layer del Part
Dim nId As Integer = EgtGetFirstGroupInGroup(m_nObjTreeOldId)
m_Controller.SetLastIntegers(m_nObjTreeOldId, nId)
m_Controller.ExecuteCommand(CMD.SETCURRPARTLAYER)
EmitCurrPartLayer()
' se Layer
ElseIf EgtGetParent(nIdParent) = GDB_ID.ROOT Then
m_Controller.SetLastIntegers(nIdParent, m_nObjTreeOldId)
m_Controller.ExecuteCommand(CMD.SETCURRPARTLAYER)
EmitCurrPartLayer()
End If
End If
End Sub
Private Sub ObjTree_KeyDown(ByVal sender As System.Object, ByVal e As KeyEventArgs) Handles TreeView1.KeyDown
' Con DEL eseguo cancellazione del pezzo o del layer selezionati
If e.KeyData = Keys.Delete Then
m_Controller.SetLastIntegers(m_nObjTreeOldId, 0)
m_Controller.ExecuteCommand(CMD.DELETEPARTLAYER)
EmitCurrPartLayer()
LoadObjTree()
End If
End Sub
Private Sub UpdateObjInObjTree(ByVal nId As Integer)
' ripristino eventuale vecchio oggetto selezionato
RevertOldIdInObjTree()
' recupero il tipo del nuovo oggetto
Dim nType As Integer = EgtGetType(nId)
' stampa dei dati del nuovo oggetto
Dim sDump As String = String.Empty
If nType = TY.NONE Then
tBoxInfo.Text = String.Empty
ElseIf nType = TY.GROUP Then
If EgtGroupDump(nId, sDump) Then
tBoxInfo.Text = sDump
Else
tBoxInfo.Text = String.Empty
End If
Else
If EgtGeoObjDump(nId, sDump) Then
tBoxInfo.Text = sDump
Else
tBoxInfo.Text = String.Empty
End If
End If
If Not m_bMark Then
m_nObjTreeOldId = nId
Return
End If
' permetto in ogni caso la visualizzazione dell'oggetto e lo evidenzio
Dim nOldMode As Integer = GDB_MD.STD
EgtGetMode(nId, nOldMode)
Dim nMode As Integer = IIf((nOldMode = GDB_MD.HIDDEN), GDB_MD.STD, nOldMode)
EgtSetMode(nId, nMode)
Dim nOldStatus As Integer = GDB_ST.ON_
EgtGetStatus(nId, nOldStatus)
Dim nStat As Integer = IIf((nOldStatus = GDB_ST.OFF), GDB_ST.ON_, nOldStatus)
EgtSetStatus(nId, nStat)
EgtSetMark(nId)
m_nObjTreeOldId = nId
' imposto il ridisegno della scena
EgtDraw()
' lancio timer per successiva de-evidenziazione
ObjTreeTimer.Stop()
ObjTreeTimer.Start()
End Sub
Private Function RevertOldIdInObjTree() As Integer
' salvo il vecchio Id
Dim nOldId As Integer = m_nObjTreeOldId
' se non nullo...
If EgtExistsObj(m_nObjTreeOldId) Then
' ripristino il modo e lo stato precedente dell'oggetto e lo smarco
EgtRevertMode(m_nObjTreeOldId)
EgtRevertStatus(m_nObjTreeOldId)
EgtResetMark(m_nObjTreeOldId)
' annullo oggetto da ripristinare
m_nObjTreeOldId = GDB_ID.NULL
End If
Return nOldId
End Function
Private Function SelectIdInObjTree(ByVal nId As Integer) As Boolean
Dim tNode() As TreeNode = TreeView1.Nodes.Find(nId.ToString, True)
If tNode.Length > 0 Then
TreeView1.SelectedNode = tNode(0)
TreeView1.SelectedNode.Expand()
Return True
Else
Return False
End If
End Function
'-------------------------------- Program Title --------------------------------------------------
Private Sub EmitTitle()
' nome file
Dim sTitle As String = m_Controller.GetCurrFile()
If String.IsNullOrEmpty(sTitle) Then
sTitle = "New"
End If
' indicazione di modificato
If m_Controller.GetModified() Then
sTitle += "*"
End If
' dati del prodotto
sTitle += " - EgalTech TestEIn"
' emissione del titolo
Me.Text = sTitle
End Sub
End Class