'---------------------------------------------------------------------------- ' EgalTech 2014-2015 '---------------------------------------------------------------------------- ' File : Controller.vb Data : 27.01.15 Versione : 1.6a6 ' Contenuto : Classe Controller (parte di MVC). ' ' ' ' Modifiche : 04.11.14 DS Creazione modulo. ' ' '---------------------------------------------------------------------------- Imports Microsoft.VisualBasic Imports System.Globalization Imports TestEIn.EgtInterface Imports System.Text Public Class Controller ' Events Public Event OnNewProject(sender As Object, bOk As Boolean) Public Event OnOpeningProject(sender As Object) Public Event OnOpenProject(sender As Object, sFile As String, bOk As Boolean) Public Event OnInsertedProject(sender As Object, sFile As String, bOk As Boolean) Public Event OnSavingProject(sender As Object, sFile As String) Public Event OnSavedProject(sender As Object, sFile As String, bOk As Boolean) Public Event OnSavingObject(sender As Object, sFile As String) Public Event OnSavedObject(sender As Object, sFile As String, bOk As Boolean) Public Event OnImportingProject(sender As Object, nType As Integer, ByRef nFlag As Integer) Public Event OnImportedProject(sender As Object, sFile As String, bOk As Boolean) Public Event OnExportingProject(sender As Object) Public Event OnExportedProject(sender As Object, sFile As String, bOk As Boolean) Public Event OnExecutingScript(sender As Object) Public Event OnExecutedScript(sender As Object, sFile As String, bOk As Boolean, sError As String) Public Event PrepareInputBox(sTitle As String, sLabel As String, sCheckLabel As String, bShowCombo As Boolean, bShowBtn As Boolean) Public Event SetInputBoxText(sText As String) Public Event SetInputBoxCheck(bCheck As Boolean) Public Event AddInputBoxCombo(sText As String, bSelected As Boolean) Public Event UpdateUI(sender As Object, bReloadUI As Boolean) Public Event OutputInfo(sender As Object, sText As String) ' Documento e Vista Private m_Scene As Scene Public Sub SetScene(ByRef scene As Scene) m_Scene = scene End Sub ' Comandi e Stati Public Enum CMD As Integer NULL = 0 EXECLINE GRID GRID_ELEVATION GRID_ORIGIN GRID_ROTATE GRID_ROTATE3D GRID_3P GRID_PERPCURVE GRID_OBJ NEWPART NEWLAYER SETCURRPARTLAYER RESETCURRPARTLAYER LAYERCOLOR SELECTPARTLAYEROBJ DESELECTPARTLAYEROBJ RELOCATEPARTLAYEROBJ COPYPARTLAYEROBJ SHOW HIDE SETNAME SETINFO POINT VECTOR FRAME LINE2P LINEPDL LINEPVL CIRCLECP CIRCLECD ARCCSE ARC3P ARCPDP ARCPVP FILLET CHAMFER RECTANGLE2P POLYGON POLYGONSIDE TEXT TEXTPLUS REGION PLANE EXTRUDE REVOLVE SCREW SWEPT RULED MERGESURF EXPLODESURF INVERTSURF DELETE CHANGELAYER CHANGELAYERGLOB CHANGECOLOR RESETCOLOR CHANGEALPHA INVERTCURVE CHANGESTARTCURVE TRIMEXTENDCURVE BREAKCURVE SPLITCURVE JOINCURVE EXPLODECURVE SETCURVETHICKNESS MOVE ROTATE ROTATE3D MIRROR MIRROR3D SCALE SCALE3D OFFSET SELECTGROUP MODIFYTEXT EXTRACTSURFLOOPS EXTRACTSURFFACETLOOPS ADDSURF SUBTRACTSURF INTERSECTSURF End Enum Public Enum GRID_TYPE As Integer NONE = 0 TOP FRONT RIGHT BACK LEFT BOTTOM VIEW End Enum Private m_nLastCmd As CMD = CMD.NULL Private m_nStep As Integer = 0 Private m_bContinue As Boolean = False Private m_nContinueId As Integer = GDB_ID.NULL Private m_ptP1 As Point3d Private m_sepP1 As SEP Private m_nIdP1 As Integer Private m_ptP2 As Point3d Private m_sepP2 As SEP Private m_nIdP2 As Integer Private m_ptP3 As Point3d Private m_ptLast As Point3d Private m_sepLast As SEP Private m_vtLast As Vector3d = Vector3d.X_AX() Private m_nIdLast As Integer = GDB_ID.NULL Private m_dPrev As Double = 0 Private m_dAux As Double = 0 Private m_dLast As Double = 0 Private m_d3Last() As Double = {0, 0, 0} Private m_d3Prev() As Double = {0, 0, 0} Private m_nLast As Integer = 0 Private m_sLast As String = String.Empty Private m_bLast As Boolean = False Private m_bPnt3dVsDbl As Boolean = False Private m_ptCont As Point3d ' punto finale di entità precedente (per continuazione) Private m_vtCont As Vector3d = Vector3d.X_AX() ' direzione finale di entità precedente (per continuazione) Private m_dLastLen As Double = If(EgtUiUnitsAreMM(), 100, 101.6) ' ultima lunghezza per linea Private m_dLastDiam As Double = If(EgtUiUnitsAreMM(), 20, 25.4) ' ultimo diametro per circonferenza Private m_dLastFillet As Double = If(EgtUiUnitsAreMM(), 10, 12.7) ' ultimo raggio per fillet Private m_dLastChamfer As Double = If(EgtUiUnitsAreMM(), 10, 12.7) ' ultima lunghezza per smusso Private m_dLastTextH As Double = If(EgtUiUnitsAreMM(), 10, 12.7) ' ultima altezza per testo Private m_bLastCapEndsCheck As Boolean = False ' ultimo valore di check cap in estrusione e swept Private m_dLastExtrude As Double = If(EgtUiUnitsAreMM(), 20, 25.4) ' ultimo valore di estrusione per superficie Private m_dLastExtend As Double = If(EgtUiUnitsAreMM(), 50, 50.8) ' ultimo valore di allungamento Private m_bLastRuledCheck As Boolean = False ' ultimo valore di check mindist in ruled Private m_bLastBooleanCheck As Boolean = False ' ultimo valore di check cancella originali in booleane Private m_bLastTransfCheck As Boolean = False ' ultimo valore di check copia nelle trasformazioni Private m_bLastOffsetCheck As Boolean = True ' ultimo valore di check copia in offset Private m_dLastOffset As Double = If(EgtUiUnitsAreMM(), 10, 12.7) ' ultimo valore di offset ' Tolleranza di disegno delle superfici Private m_dEpsStm As Double = EPS_STM Public Sub SetSurfTmTolerance(dEpsStm As Double) m_dEpsStm = Math.Max(dEpsStm, EPS_SMALL) End Sub ' Input Private Enum IBT As Integer TY_NULL = 0 TY_STRING TY_INTEGER TY_DOUBLE TY_DIRECTION TY_LENGTH TY_SPECIALDOUBLE TY_3DOUBLE TY_POINT3D TY_VECTOR3D TY_DOUBLE_OR_POINT3d End Enum Private m_nInpType As IBT = IBT.TY_NULL ' Import Private m_dDxfScale As Double = 1 Private m_dStlScale As Double = 1 Private m_dImgScale As Double = 1 ' Image export Private m_nImgWidth As Integer = 400 Private m_nImgHeight As Integer = 300 ' Costanti Private LEN_STD As Double = 100 Private EXTEND_ADD As Double = 10 Private EXTEND_BIG_ADD As Double = 200 ' Metodi Public Function NewProject(Optional bCreatePart As Boolean = False) As Boolean ' gestisco eventuale file corrente modificato If Not ManageModified() Then Return False ' reset controller e scena ResetStatus(False) ' eseguo Cursor.Current = Cursors.WaitCursor EnableCommandLog() 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) ' se ok, aggiorno pezzo e layer correnti If nIdNewPart <> GDB_ID.NULL And nIdNewLayer <> GDB_ID.NULL Then EgtSetCurrPartLayer(nIdNewPart, nIdNewLayer) End If ' reset flag di modificato EgtResetModified() End If DisableCommandLog() ' Aggiornamento RaiseEvent UpdateUI(Me, True) Cursor.Current = Cursors.Default ' Gestione risultato RaiseEvent OnNewProject(Me, bOk) Return bOk End Function Public Function OpenProject(Optional sDir As String = "", Optional bWithDlg As Boolean = True) As Boolean ' gestisco eventuale file corrente modificato If Not ManageModified() Then Return False ' reset controller e scena ResetStatus(False) ' eseguo Dim sFile As String = sDir ' Scelta file con dialogo If bWithDlg Then Dim OpenFileDialog As New OpenFileDialog With { .Title = "Open", .Filter = "New geometry EgalTech(*.nge)|*.nge" & "|New font EgalTech(*.nfe)|*.nfe" & "|All Files (*.*)|*.*", .FilterIndex = 1, .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.Current = Cursors.WaitCursor EnableCommandLog() Dim bOk As Boolean = EgtOpenFile(sFile) DisableCommandLog() ' Aggiornamento RaiseEvent UpdateUI(Me, True) Cursor.Current = Cursors.Default ' Gestione risultato RaiseEvent OnOpenProject(Me, sFile, bOk) Return bOk End Function Public Function InsertProject(Optional sDir As String = "", Optional bWithDlg As Boolean = True) As Boolean Dim sFile As String = sDir ' Reset controller e scena ResetStatus() ' Scelta file con dialogo If bWithDlg Then Dim OpenFileDialog As New OpenFileDialog With { .Title = "Insert", .Filter = "New geometry EgalTech(*.nge)|*.nge" & "|Drawing Exchange Fmt(*.dxf)|*.dxf" & "|Stereolithography (*.stl)|*.stl" & "|Images (*.png;*.jpg;*.jpeg;*.bmp)|*.png;*.jpg;*.jpeg;*.bmp" & "|New font EgalTech(*.nfe)|*.nfe" & "|All Files (*.*)|*.*", .FilterIndex = 1, .InitialDirectory = sDir } If OpenFileDialog.ShowDialog <> Windows.Forms.DialogResult.OK Then Return True End If sFile = OpenFileDialog.FileName End If 'Inserimento del progetto Dim bOk As Boolean = False Cursor.Current = Cursors.WaitCursor EnableCommandLog() Dim nFileType As Integer = EgtGetFileType(sFile) If nFileType = FT.DXF Then bOk = EgtImportDxf(sFile, m_dDxfScale) ElseIf nFileType = FT.STL Then bOk = EgtImportStl(sFile, m_dStlScale) ElseIf nFileType = FT.IMG Then bOk = ImportPicture(sFile, m_dImgScale) Else bOk = EgtInsertFile(sFile) End If If GetCurrLayer() = GDB_ID.NULL Then EgtResetCurrPartLayer() DisableCommandLog() ' Aggiornamento RaiseEvent UpdateUI(Me, True) Cursor.Current = Cursors.Default ' Gestione risultato RaiseEvent OnInsertedProject(Me, sFile, bOk) Return bOk End Function Public Function SaveProject(Optional nType As NGE = NGE.CMPTEXT) As Boolean Dim sCurrFile As String = GetCurrFile() If String.IsNullOrWhiteSpace(sCurrFile) Or EgtGetFileType(sCurrFile) <> FT.NGE Then Return SaveAsProject(sCurrFile, nType) Else ' Reset controller e scena ResetStatus() ' Prima del salvataggio RaiseEvent OnSavingProject(Me, sCurrFile) ' Salvataggio del progetto Cursor.Current = Cursors.WaitCursor EnableCommandLog() Dim bOk As Boolean = EgtSaveFile(sCurrFile, nType) DisableCommandLog() ' Aggiorno RaiseEvent UpdateUI(Me, False) Cursor.Current = Cursors.Default ' Gestione risultato RaiseEvent OnSavedProject(Me, sCurrFile, bOk) Return bOk End If End Function Public Function SaveAsProject(Optional sFile As String = "", Optional nType As NGE = NGE.CMPTEXT) As Boolean ' Reset controller e scena ResetStatus() ' Se nome vuoto, assegno "New" If String.IsNullOrWhiteSpace(sFile) Then sFile = "New.nge" ' Eventuale sistemazione estensione sFile = IO.Path.ChangeExtension(sFile, "nge") ' Assegnazione nome file con dialogo Dim SaveFileDialog As New SaveFileDialog With { .Title = "Save", .Filter = "New geometry EgalTech(*.nge)|*.nge", .FileName = sFile, .InitialDirectory = IO.Path.GetDirectoryName(sFile) } If SaveFileDialog.ShowDialog <> Windows.Forms.DialogResult.OK Then Return True Dim sFileName As String = SaveFileDialog.FileName ' Prima del salvataggio RaiseEvent OnSavingProject(Me, sFileName) ' Salvataggio del progetto Cursor.Current = Cursors.WaitCursor EnableCommandLog() Dim bOk As Boolean = EgtSaveFile(sFileName, nType) DisableCommandLog() ' Aggiorno RaiseEvent UpdateUI(Me, False) Cursor.Current = Cursors.Default ' Gestione risultato RaiseEvent OnSavedProject(Me, sFileName, bOk) Return bOk End Function Public Function SaveObject(nId As Integer, Optional sDir As String = "", Optional nType As NGE = NGE.CMPTEXT) As Boolean ' Reset controller e scena ResetStatus() ' Creo nome di default Dim sName As String = String.Empty If Not EgtGetName(nId, sName) Then Dim nObjType As Integer = EgtGetType(nId) If nObjType = GDB_TY.GROUP Then If EgtIsPart(nId) Then sName = "Part" & nId.ToString() ElseIf EgtIsLayer(nId) Then sName = "Layer" & nId.ToString() Else sName = "Group" & nId.ToString() End If ElseIf nObjType <> GDB_TY.NONE Then Dim sTitle As String = String.Empty EgtGetTitle(nId, sTitle) sName = sTitle & nId.ToString() Else sName = "Unknown" & nId.ToString() End If End If ' Sistemo path Dim sFile As String If String.IsNullOrWhiteSpace(sDir) Then sFile = sName Else sFile = sDir.TrimEnd("\") & "\" & sName End If ' Assegnazione nome file con dialogo Dim SaveFileDialog As New SaveFileDialog With { .Title = "Save Object", .Filter = "New geometry EgalTech(*.nge)|*.nge", .FileName = sFile, .InitialDirectory = sDir.TrimEnd("\") } If SaveFileDialog.ShowDialog <> Windows.Forms.DialogResult.OK Then Return True End If Dim sFileName As String = SaveFileDialog.FileName ' Prima del salvataggio RaiseEvent OnSavingObject(Me, sFileName) ' Salvataggio dell'oggetto con la sua ascendenza Cursor.Current = Cursors.WaitCursor EnableCommandLog() Dim bOk As Boolean = EgtSaveObjToFile(nId, sFileName, nType) DisableCommandLog() ' Aggiorno RaiseEvent UpdateUI(Me, False) Cursor.Current = Cursors.Default ' Gestione risultato RaiseEvent OnSavedObject(Me, sFileName, bOk) Return bOk End Function Public Function ImportProject(Optional sDir As String = "", Optional bWithDlg As Boolean = True) As Boolean ' Gestisco eventuale file corrente modificato If Not ManageModified() Then Return False ' Reset controller e scena ResetStatus(False) ' Eseguo Dim sFile As String = sDir ' Scelta file con dialogo If bWithDlg Then Dim OpenFileDialog As New OpenFileDialog With { .Title = "Import", .Filter = "Drawing Exchange Fmt(*.dxf)|*.dxf" & "|Stereolithography (*.stl)|*.stl" & "|Building parts (*.btl)|*.btl" & "|Part program ISO (*.cnc;*.xpi;*.mpf)|*.cnc;*.xpi;*.mpf" & "|Point files (*.pnt;*.xyz)|*.pnt;*.xyz" & "|Images (*.png;*.jpg;*.jpeg;*.bmp)|*.png;*.jpg;*.jpeg;*.bmp" & "|Cms file format (*.hed;*.ent;*.ens)|*.hed;*.ent;*.ens" & "|All Files (*.*)|*.*", .FilterIndex = 8, .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.BTL Or nFileType = FT.CNC Or nFileType = FT.CSF Or nFileType = FT.DXF Or nFileType = FT.IMG Or nFileType = FT.PNT Or nFileType = FT.STL) If Not bOkType Then nFileType = FT.NULL ' Prima del caricamento Dim nFlag As Integer = 0 RaiseEvent OnImportingProject(Me, nFileType, nFlag) If Not bOkType Then Return False ' Pulizia GeomDB Cursor.Current = Cursors.WaitCursor ' Importazione EnableCommandLog() Dim bOk As Boolean = EgtNewFile() Select Case nFileType Case FT.BTL bOk = bOk And EgtImportBtl(sFile, nFlag) Case FT.CNC bOk = bOk And EgtImportCnc(sFile, nFlag) Case FT.CSF bOk = bOk And EgtImportCsf(sFile) Case FT.DXF bOk = bOk And EgtImportDxf(sFile, m_dDxfScale) Case FT.IMG bOk = bOk And ImportPicture(sFile, m_dImgScale) Case FT.PNT bOk = bOk And EgtImportPnt(sFile, nFlag) Case FT.STL bOk = bOk And EgtImportStl(sFile, m_dStlScale) End Select EgtResetCurrPartLayer() DisableCommandLog() ' Aggiornamento RaiseEvent UpdateUI(Me, True) Cursor.Current = Cursors.Default ' Gestione risultato RaiseEvent OnImportedProject(Me, sFile, bOk) Return bOk End Function Public Sub SetScaleForDxfImport(dScale As Double) m_dDxfScale = dScale End Sub Public Sub SetScaleForStlImport(dScale As Double) m_dStlScale = dScale End Sub Public Sub SetScaleForImageImport(dScale As Double) m_dImgScale = dScale End Sub Private Function ImportPicture(sFile As String, dScaleFactor As Double) As Boolean ' Creo pezzo e layer Dim nLayId As Integer = EgtCreateGroup(EgtCreateGroup(GDB_ID.ROOT)) If nLayId = GDB_ID.NULL Then Return False ' Recupero dimensioni immagine Dim nPixelX, nPixelY As Integer If Not EgtGetImagePixels(sFile, nPixelX, nPixelY) Then Return False ' Inserisco immagine Dim sName As String = "Pic" + (nLayId + 1).ToString() Return EgtAddPicture(nLayId, sName, sFile, dScaleFactor * nPixelX, dScaleFactor * nPixelY) <> GDB_ID.NULL End Function Public Function ExportProject(Optional sFile As String = "") As Boolean ' Reset controller e scena ResetStatus() 'Assegnazione nome file con dialogo Dim SaveFileDialog As New SaveFileDialog With { .Title = "Export", .Filter = "Drawing Exchange Fmt(*.dxf)|*.dxf" & "|Stereolithography (*.stl)|*.stl" & "|Svg (*.svg)|*.svg" & "|Images (*.png;*.jpg;*.jpeg;*.bmp)|*.png;*.jpg;*.jpeg;*.bmp" & "|All Files (*.*)|*.*", .FilterIndex = 5, .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 And nFileType <> FT.IMG And nFileType <> FT.SVG Then MessageBox.Show("File type unknown", "Error", MessageBoxButtons.OK, MessageBoxIcon.Error) Return False End If Dim sFileName As String = SaveFileDialog.FileName 'Prima dell'esportazione RaiseEvent OnExportingProject(Me) 'Esportazione del progetto Cursor.Current = Cursors.WaitCursor EnableCommandLog() Dim bOk As Boolean = False If nFileType = FT.DXF Then bOk = EgtExportDxf(GDB_ID.ROOT, sFileName) ElseIf nFileType = FT.STL Then bOk = EgtExportStl(GDB_ID.ROOT, sFileName) ElseIf nFileType = FT.IMG Then bOk = EgtGetImage(EgtGetShowMode(), New Color3d(255, 255, 255), New Color3d(255, 255, 255), m_nImgWidth, m_nImgHeight, sFileName) ElseIf nFileType = FT.SVG Then bOk = EgtExportSvg(GDB_ID.ROOT, sFileName) End If DisableCommandLog() 'Aggiornamento RaiseEvent UpdateUI(Me, False) Cursor.Current = Cursors.Default 'Gestione risultato RaiseEvent OnExportedProject(Me, sFileName, bOk) Return bOk End Function Public Sub SetDefaultForImageExport(nWidth As Integer, nHeight As Integer) m_nImgWidth = nWidth m_nImgHeight = nHeight End Sub Public Function Exec(Optional sDir As String = "", Optional bWithDlg As Boolean = True) As Boolean Dim sFile As String = sDir 'Scelta file con dialogo If bWithDlg Then Dim OpenFileDialog As New OpenFileDialog With { .Title = "Exec Script", .Filter = "Lua commands(*.lua)|*.lua" & "|Test commands(*.tsc)|*.tsc" & "|All Files (*.*)|*.*", .FilterIndex = 1, .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(IO.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) 'Esecuzione Cursor.Current = Cursors.WaitCursor EnableCommandLog() Dim bOk As Boolean = False If sExt = ".LUA" Then bOk = EgtLuaExecFile(sFile) Else bOk = EgtTscExecFile(sFile) End If DisableCommandLog() ' Aggiornamento RaiseEvent UpdateUI(Me, True) Cursor.Current = 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, sFile, bOk, sError) Return bOk End Function Public Sub MouseSetObjFilterForSelect(bZeroDim As Boolean, bCurve As Boolean, bSurf As Boolean, bVolume As Boolean, bExtra As Boolean) EnableCommandLog() EgtSetObjFilterForSelect(bZeroDim, bCurve, bSurf, bVolume, bExtra) DisableCommandLog() End Sub Public Sub MouseSelectedAll(Optional bOnlyVisible As Boolean = True) ' eseguo la selezione ed aggiorno EnableCommandLog() EgtSelectAll(bOnlyVisible) DisableCommandLog() EgtDraw() End Sub Public Sub MouseDeselectedAll() ' eseguo la selezione ed aggiorno EnableCommandLog() EgtDeselectAll() DisableCommandLog() EgtDraw() End Sub Public Sub MouseSelectedObj(nId As Integer, bLast As Boolean) EnableCommandLog() If EgtIsSelectedObj(nId) Then EgtDeselectObj(nId) Else EgtSelectObj(nId) End If DisableCommandLog() If bLast Then EgtDraw() End If End Sub Public Sub MouseSelectedPart(nId As Integer) ' recupero il pezzo Dim nPartId = EgtGetParent(EgtGetParent(nId)) If EgtGetParent(nPartId) <> GDB_ID.ROOT Then Return ' recupero stato Dim nStat As Integer = GDB_ST.ON_ EgtGetStatus(nId, nStat) ' eseguo selezione o deselezione ed aggiorno EnableCommandLog() If nStat <> GDB_ST.SEL Then EgtSelectPartObjs(nPartId) Else EgtDeselectPartObjs(nPartId) End If DisableCommandLog() EgtDraw() End Sub Public Sub MouseSelectedLayer(nId As Integer) ' recupero il layer Dim nLayerId = EgtGetParent(nId) If EgtGetParent(EgtGetParent(nLayerId)) <> GDB_ID.ROOT Then Return ' recupero stato Dim nStat As Integer = GDB_ST.ON_ EgtGetStatus(nId, nStat) ' eseguo selezione o deselezione ed aggiorno EnableCommandLog() If nStat <> GDB_ST.SEL Then EgtSelectLayerObjs(nLayerId) Else EgtDeselectLayerObjs(nLayerId) End If DisableCommandLog() EgtDraw() End Sub Public Sub MouseSelectedPath(nId As Integer, bHaltOnFork As Boolean) ' verifico sia parte di un layer Dim nPartId = EgtGetParent(EgtGetParent(nId)) If Not (EgtIsPart(nPartId) OrElse EgtGetRawPartFromPart(nPartId) <> GDB_ID.NULL) Then Return End If ' eseguo la selezione ed aggiorno EnableCommandLog() EgtSelectPathObjs(nId, bHaltOnFork) DisableCommandLog() EgtDraw() End Sub Public Sub MouseSelectedPoint(PtP As Point3d, nSep As SEP, nId As Integer, bDone As Boolean) SetDataFromSelPoint(PtP, nSep, nId) ' avanzo di un passo If bDone Then ProcessStatus() ' eseguo ultimo drag e passo in modalità input da box Else m_Scene.DisableDrag() ExecuteDrag() Select Case m_nInpType Case IBT.TY_POINT3D SetInputBoxPoint3d(m_ptLast) Case IBT.TY_VECTOR3D SetInputBoxVector3d(m_vtLast) Case IBT.TY_DIRECTION SetInputBoxDouble(m_dLast) Case IBT.TY_LENGTH, IBT.TY_SPECIALDOUBLE SetInputBoxDouble(m_dLast, True) Case IBT.TY_DOUBLE_OR_POINT3d SetInputBoxDouble(m_dLast) End Select End If End Sub Public Sub MouseMoveInSelectionPoint(PtP As Point3d) SetDataFromSelPoint(PtP, SEP.PT_STD, GDB_ID.NULL) ' eseguo drag ExecuteDrag() End Sub Private Sub SetDataFromSelPoint(PtP As Point3d, nSep As SEP, nId As Integer) ' recupero il punto e le sue info ausiliarie m_ptLast = PtP m_sepLast = nSep m_nIdLast = nId ' se usato per tipi speciali Select Case m_nInpType Case IBT.TY_VECTOR3D m_vtLast = m_ptLast - m_ptP1 Case IBT.TY_DIRECTION m_dLast = GridAngFromGlobDir(m_ptLast - m_ptP1) m_dAux = GridLenFromGlobLen(m_ptLast - m_ptP1) Case IBT.TY_LENGTH m_dLast = (m_ptLast - m_ptP1) * m_vtLast Case IBT.TY_SPECIALDOUBLE ExecuteSpecialData() Case IBT.TY_DOUBLE_OR_POINT3d m_bPnt3dVsDbl = True End Select End Sub Public Sub Done(sText As String) ' recupero il dato InputTextToLast(sText) ' avanzo di un passo ProcessStatus() End Sub Public Sub Show(sText As String) ' recupero il dato InputTextToLast(sText) ' disabilito drag da mouse m_Scene.DisableDrag() EgtResetGeoLine() EgtResetGeoTria() ' aggiorno drag ExecuteDrag() End Sub Private Sub SetInputBoxString(sText As String) RaiseEvent SetInputBoxText(sText) End Sub Private Sub SetInputBoxInteger(nVal As Integer) Dim sText As String = nVal.ToString() RaiseEvent SetInputBoxText(sText) End Sub Private Function DoubleToString(dVal As Double, nNumDec As UInteger) As String Dim sFormat As String = "F" + nNumDec.ToString() Dim sVal As String = dVal.ToString(sFormat, CultureInfo.InvariantCulture) If nNumDec > 0 Then Return sVal.TrimEnd("0".ToCharArray()).TrimEnd(".".ToCharArray()) Else Return sVal End If End Function Private Sub SetInputBoxDouble(dVal As Double, Optional bUiScale As Boolean = False) Dim dTmp As Double = If(bUiScale, EgtToUiUnits(dVal), dVal) Dim sText As String = DoubleToString(dTmp, 4) RaiseEvent SetInputBoxText(sText) End Sub Private Sub SetInputBox3Double(d3Val() As Double) ' verifico ci siano almeno 3 elementi nell'array If d3Val.Length < 3 Then Return End If ' visualizzo (senza scalare per UI perchè non sono punti o vettori) Dim sText As New StringBuilder(128) sText.Append(DoubleToString(d3Val(0), 4)) sText.Append(",") sText.Append(DoubleToString(d3Val(1), 4)) sText.Append(",") sText.Append(DoubleToString(d3Val(2), 4)) RaiseEvent SetInputBoxText(sText.ToString()) End Sub Private Sub SetInputBoxPoint3d(ptVal As Point3d) ' converto da coordinate globali a griglia ptVal = ptVal.Loc(GDB_ID.GRID) ' visualizzo Dim sText As New StringBuilder(128) sText.Append(DoubleToString(EgtToUiUnits(ptVal.x), 4)) sText.Append(",") sText.Append(DoubleToString(EgtToUiUnits(ptVal.y), 4)) sText.Append(",") sText.Append(DoubleToString(EgtToUiUnits(ptVal.z), 4)) RaiseEvent SetInputBoxText(sText.ToString()) End Sub Private Sub SetInputBoxVector3d(vtVal As Vector3d) ' converto da coordinate globali a griglia vtVal = vtVal.Loc(GDB_ID.GRID) ' visualizzo Dim sText As New StringBuilder(128) sText.Append(DoubleToString(EgtToUiUnits(vtVal.x), 6)) sText.Append(",") sText.Append(DoubleToString(EgtToUiUnits(vtVal.y), 6)) sText.Append(",") sText.Append(DoubleToString(EgtToUiUnits(vtVal.z), 6)) RaiseEvent SetInputBoxText(sText.ToString()) End Sub Private Function InputTextToLast(ByRef sText As String) As Boolean Select Case m_nInpType Case IBT.TY_STRING If Not EgtLuaEvalStringExpr(sText, m_sLast) Then m_sLast = sText End If Return True Case IBT.TY_INTEGER Return TextToInteger(sText, m_nLast) Case IBT.TY_DOUBLE, IBT.TY_DIRECTION Return TextToDouble(sText, m_dLast) Case IBT.TY_LENGTH, IBT.TY_SPECIALDOUBLE Dim dVal As Double If TextToDouble(sText, dVal) Then m_dLast = EgtFromUiUnits(dVal) Return True Else Return False End If Case IBT.TY_3DOUBLE Return TextTo3Double(sText, m_d3Last) Case IBT.TY_POINT3D Dim d3Val(2) As Double If TextTo3Double(sText, d3Val) Then ' converto da unità di misura in UI a unità standard d3Val(0) = EgtFromUiUnits(d3Val(0)) d3Val(1) = EgtFromUiUnits(d3Val(1)) d3Val(2) = EgtFromUiUnits(d3Val(2)) ' converto da riferimento griglia a globale m_ptLast = New Point3d(d3Val(0), d3Val(1), d3Val(2)).Glob(GDB_ID.GRID) Return True End If Case IBT.TY_VECTOR3D Dim d3Val(2) As Double If TextTo3Double(sText, d3Val) Then ' converto da unità di misura in UI a unità standard d3Val(0) = EgtFromUiUnits(d3Val(0)) d3Val(1) = EgtFromUiUnits(d3Val(1)) d3Val(2) = EgtFromUiUnits(d3Val(2)) ' converto da riferimento griglia a globale m_vtLast = New Vector3d(d3Val(0), d3Val(1), d3Val(2)).Glob(GDB_ID.GRID) Return True End If Case IBT.TY_DOUBLE_OR_POINT3d Dim d3Val(2) As Double If TextTo3Double(sText, d3Val) Then m_bPnt3dVsDbl = True ' converto da unità di misura in UI a unità standard d3Val(0) = EgtFromUiUnits(d3Val(0)) d3Val(1) = EgtFromUiUnits(d3Val(1)) d3Val(2) = EgtFromUiUnits(d3Val(2)) ' converto da riferimento griglia a globale m_ptLast = New Point3d(d3Val(0), d3Val(1), d3Val(2)).Glob(GDB_ID.GRID) Return True ElseIf TextToDouble(sText, m_dLast) Then m_bPnt3dVsDbl = False Return True End If End Select Return False End Function Private Function TextToInteger(ByRef sText As String, ByRef nVal As Integer) As Boolean Dim dVal As Double If EgtLuaEvalNumExpr(sText, dVal) Then nVal = CInt(dVal) Return True Else Return False End If End Function Private Function TextToDouble(ByRef sText As String, ByRef dVal As Double) As Boolean Return EgtLuaEvalNumExpr(sText, dVal) End Function Private Function TextTo3Double(ByRef sText As String, ByRef d3Val() As Double) As Boolean ' verifico ci siano almeno 3 elementi nell'array If d3Val.Length < 3 Then Return False End If ' leggo i tre valori Dim sItems() As String = sText.Split(",".ToCharArray) Dim bOk As Boolean = True For i As Integer = 0 To 2 d3Val(i) = 0 If sItems.Length() <= i Then If i = 2 Then d3Val(i) = 0 Else bOk = False End If ElseIf Not EgtLuaEvalNumExpr(sItems(i), d3Val(i)) Then bOk = False End If Next Return bOk End Function Public Sub SetLastPoint3d(ByRef ptP As Point3d) m_ptLast = ptP End Sub Public Sub SetLastVector3d(ByRef vtV As Vector3d) m_vtCont = vtV End Sub Public Sub SetLastDouble(dVal As Double) m_dLast = dVal End Sub Public Sub SetLast3Double(d3Val() As Double) If d3Val.Length >= 1 Then m_d3Last(0) = d3Val(0) If d3Val.Length >= 2 Then m_d3Last(1) = d3Val(1) If d3Val.Length >= 3 Then m_d3Last(2) = d3Val(2) End If End If End If End Sub Public Sub SetLastInteger(nVal As Integer) m_nLast = nVal If m_nLastCmd = CMD.TEXTPLUS Or m_nLastCmd = CMD.OFFSET Then ' aggiorno drag al cambio di font ExecuteDrag() End If End Sub Public Sub SetLastString(ByRef sVal As String) m_sLast = sVal End Sub Public Sub SetLastBoolean(bVal As Boolean) m_bLast = bVal If m_nLastCmd = CMD.TEXTPLUS Or m_nLastCmd = CMD.POLYGON Or m_nLastCmd = CMD.EXTRUDE Or m_nLastCmd = CMD.REVOLVE Or m_nLastCmd = CMD.SETCURVETHICKNESS Then ' aggiorno drag al cambio di italic ExecuteDrag() End If End Sub Public Sub SetPointFromSelection(nId As Integer, PtP As Point3d, nAux As Integer) If EgtIsSelectedObj(nId) Then EgtSetSelInfo( nId, nAux, ptP) End If End Sub Public Sub ResetStatus(Optional bRedraw As Boolean = True) m_nStep = 0 m_bContinue = False m_nContinueId = GDB_ID.NULL m_sepP1 = SEP.PT_STD m_sepP2 = SEP.PT_STD m_sepLast = SEP.PT_STD m_Scene.ResetStatus(bRedraw) End Sub Public Sub SetContinue() m_bContinue = True m_nContinueId = GDB_ID.NULL End Sub Public Function GetContinue() As Boolean Return m_bContinue End Function Public Function GetContinueId() As Integer Return m_nContinueId End Function Public Function RepeatLastCommand() As Boolean Return ExecuteCommand(m_nLastCmd) End Function Public Function ExecuteCommand(nCmd As CMD) As Boolean ' Posso partire solo con stato libero If m_nStep <> 0 Then Return False ' Reset eventuali analisi e distanza in corso m_Scene.ResetStatusAnalyze() m_Scene.ResetStatusGetDistance() ' Se non è linea 2P reset punti speciali (tg, perp e mindist) If (nCmd <> CMD.LINE2P) Then m_Scene.DisableTangentPoint() m_Scene.DisablePerpendicularPoint() m_Scene.DisableMinDistPoint() End If ' Salvo ed eseguo il comando m_nLastCmd = nCmd Return ProcessStatus() End Function Private Function ProcessStatus() As Boolean Select Case m_nLastCmd ' Exec Line Case CMD.EXECLINE Return ProcessExecLine() ' Grid Case CMD.GRID Return ProcessGrid() ' Grid origin Case CMD.GRID_ELEVATION Return ProcessGridElevation() Case CMD.GRID_ORIGIN Return ProcessGridOrigin() ' rotazione Griglia/Cplane Case CMD.GRID_ROTATE Return ProcessGridRotate() ' rotazione 3d Griglia/Cplane Case CMD.GRID_ROTATE3D Return ProcessGridRotate3D() ' Griglia/Cplane dati 3 punti Case CMD.GRID_3P Return ProcessGrid3P() ' Griglia/Cplane perpendicolare a curva Case CMD.GRID_PERPCURVE Return ProcessGridPerpObj() ' Griglia/Cplane da oggetto geometrico Case CMD.GRID_OBJ Return ProcessGridObj() ' Nuovo Pezzo Case CMD.NEWPART Return ProcessNewPart() ' Nuovo Layer Case CMD.NEWLAYER Return ProcessNewLayer() ' Imposto pezzo e layer correnti Case CMD.SETCURRPARTLAYER Return ProcessSetCurrPartLayer() ' Cancello pezzo e layer correnti Case CMD.RESETCURRPARTLAYER Return ProcessResetCurrPartLayer() ' Imposto colore del layer Case CMD.LAYERCOLOR Return ProcessLayerColor() ' Seleziono Pezzo/Layer/Oggetto Case CMD.SELECTPARTLAYEROBJ Return ProcessSelectPartLayerObj() ' Deseleziono Pezzo/Layer/Oggetto Case CMD.DESELECTPARTLAYEROBJ Return ProcessDeselectPartLayerObj() ' Riloco Pezzo/Layer/Oggetto Case CMD.RELOCATEPARTLAYEROBJ Return ProcessRelocatePartLayerObj() ' Copio Pezzo/Layer/Oggetto Case CMD.COPYPARTLAYEROBJ Return ProcessCopyPartLayerObj() ' Visualizza Case CMD.SHOW Return ProcessShow() ' Nascondi Case CMD.HIDE Return ProcessHide() ' Name Case CMD.SETNAME Return ProcessSetName() ' Info Case CMD.SETINFO Return ProcessSetInfo() ' Point Case CMD.POINT Return ProcessPoint() ' Vector Case CMD.VECTOR Return ProcessVector() ' Frame Case CMD.FRAME Return ProcessFrame() ' Line2P Case CMD.LINE2P Return ProcessLine2P() ' LinePDL Case CMD.LINEPDL Return ProcessLinePDL() ' LinePVL Case CMD.LINEPVL Return ProcessLinePVL() ' CircleCP Case CMD.CIRCLECP Return ProcessCircleCP() ' CircleCD Case CMD.CIRCLECD Return ProcessCircleCD() ' ArcCSE Case CMD.ARCCSE Return ProcessArcCSE() ' Arc3P Case CMD.ARC3P Return ProcessArc3P() ' ArcPDP Case CMD.ARCPDP Return ProcessArcPDP() ' ArcPVP Case CMD.ARCPVP Return ProcessArcPVP() ' Fillet Case CMD.FILLET Return ProcessFillet() ' Chamfer Case CMD.CHAMFER Return ProcessChamfer() ' Rectangle 2P Case CMD.RECTANGLE2P Return ProcessRectangle2P() ' Polygon Case CMD.POLYGON Return ProcessPolygon() ' Polygon Side Case CMD.POLYGONSIDE Return ProcessPolygonSide() ' Text Case CMD.TEXT Return ProcessText() ' Text Plus Case CMD.TEXTPLUS Return ProcessTextPlus() ' Region Case CMD.REGION Return ProcessRegion() ' Plane Case CMD.PLANE Return ProcessPlane() ' Extrude Case CMD.EXTRUDE Return ProcessExtrude() ' Revolve Case CMD.REVOLVE Return ProcessRevolve() ' Revolve Plus Case CMD.SCREW Return ProcessScrew() ' Swept Case CMD.SWEPT Return ProcessSwept() ' Ruled Case CMD.RULED Return ProcessRuled() ' Merge Surfaces Case CMD.MERGESURF Return ProcessMergeSurf() ' Explode Surfaces Case CMD.EXPLODESURF Return ProcessExplodeSurf() ' Invert Surface Case CMD.INVERTSURF Return ProcessInvertSurf() ' Extract Surf Loops Case CMD.EXTRACTSURFLOOPS Return ProcessExtractSurfLoops() ' Extract Facet Loops Case CMD.EXTRACTSURFFACETLOOPS Return ProcessExtractSurfFacetLoops() ' Add Surface Case CMD.ADDSURF Return ProcessAddSurf() ' Subtract Surface Case CMD.SUBTRACTSURF Return ProcessSubtractSurf() ' Intersect Surface Case CMD.INTERSECTSURF Return ProcessIntersectSurf() ' Delete Case CMD.DELETE Return ProcessDelete() ' Change Layer Case CMD.CHANGELAYER Return ProcessChangeLayer(False) ' Change Layer Glob Case CMD.CHANGELAYERGLOB Return ProcessChangeLayer(True) ' Change Color Case CMD.CHANGECOLOR Return ProcessChangeColor() ' Reset Color Case CMD.RESETCOLOR Return ProcessResetColor() ' Change Alpha Case CMD.CHANGEALPHA Return ProcessChangeAlpha() ' Invert Curve Case CMD.INVERTCURVE Return ProcessInvertCurve() ' Extend Curve Case CMD.TRIMEXTENDCURVE Return ProcessExtendCurve() ' Break Curve Case CMD.BREAKCURVE Return ProcessBreakCurve() ' Split Curve in N parts Case CMD.SPLITCURVE Return ProcessSplitCurve() ' Join Curve Case CMD.JOINCURVE Return ProcessJoinCurve() ' Separate Curve Case CMD.EXPLODECURVE Return ProcessExplodeCurve() ' Change Start Closed Curve Case CMD.CHANGESTARTCURVE Return ProcessChangeStartCurve() ' Set Curve Thickness Case CMD.SETCURVETHICKNESS Return ProcessSetCurveThickness() ' Modify Text Case CMD.MODIFYTEXT Return ModifyText() ' Move Case CMD.MOVE Return ProcessMove() ' Rotate Case CMD.ROTATE Return ProcessRotate() ' Rotate 3d Case CMD.ROTATE3D Return ProcessRotate3D() ' Mirror Case CMD.MIRROR Return ProcessMirror() ' Mirror 3d Case CMD.MIRROR3D Return ProcessMirror3D() ' Scale Case CMD.SCALE Return ProcessScale() ' Scale 3d Case CMD.SCALE3D Return ProcessScale3D() ' Offset Case CMD.OFFSET Return ProcessOffset() ' Selezione gruppo case CMD.SELECTGROUP Return ProcessSelectGroup() End Select Return False End Function Private Function ExecuteDrag() As Boolean Dim bOk As Boolean = True ' Eseguo drag EgtDisableModified() Select Case m_nLastCmd Case CMD.GRID_ROTATE DragGridRotate() Case CMD.GRID_ROTATE3D DragGridRotate3D() Case CMD.COPYPARTLAYEROBJ DragCopyPartLayerObj() Case CMD.POINT DragPoint() Case CMD.VECTOR DragVector() Case CMD.FRAME DragFrame() Case CMD.LINE2P DragLine2P() Case CMD.LINEPDL DragLinePDL() Case CMD.LINEPVL DragLinePVL() Case CMD.CIRCLECP DragCircleCP() Case CMD.CIRCLECD DragCircleCD() Case CMD.ARCCSE DragArcCSE() Case CMD.ARC3P DragArc3P() Case CMD.ARCPDP DragArcPDP() Case CMD.ARCPVP DragArcPVP() Case CMD.FILLET DragFillet() Case CMD.CHAMFER DragChamfer() Case CMD.RECTANGLE2P DragRectangle2P() Case CMD.POLYGON DragPolygon() Case CMD.POLYGONSIDE DragPolygonSide() Case CMD.TEXT DragText() Case CMD.TEXTPLUS DragTextPlus() Case CMD.EXTRUDE DragExtrude() Case CMD.REVOLVE DragRevolve() Case CMD.SCREW DragScrew() Case CMD.SWEPT DragSwept() Case CMD.RULED DragRuled() Case CMD.TRIMEXTENDCURVE DragExtendCurve() Case CMD.SETCURVETHICKNESS DragSetCurveThickness() Case CMD.MODIFYTEXT DragModifyText() Case CMD.MOVE DragMove() Case CMD.ROTATE DragRotate() Case CMD.ROTATE3D DragRotate3D() Case CMD.MIRROR DragMirror() Case CMD.MIRROR3D DragMirror3D() Case CMD.SCALE DragScale() Case CMD.SCALE3D DragScale3D() Case CMD.OFFSET DragOffset() Case Else bOk = False End Select EgtEnableModified() Return bOk End Function Private Function ExecuteSpecialData() As Boolean Select Case m_nLastCmd ' Trim/Extend di curva Case CMD.TRIMEXTENDCURVE ExecuteSpecialDataExtendCurve() ' Offset di curva Case CMD.OFFSET ExecuteSpecialDataOffset() End Select Return False End Function Private Function ProcessExecLine() As Boolean If m_nStep <> 0 Then Return False End If EnableCommandLog() Dim bOk As Boolean = EgtLuaExecLine(m_sLast) DisableCommandLog() ' Aggiornamento RaiseEvent UpdateUI(Me, True) EgtDraw() Return bOk End Function Private Function ProcessGrid() As Boolean If m_nStep <> 0 Then Return False End If Dim frNew As New Frame3d Select Case m_nLast Case GRID_TYPE.TOP frNew.Setup(Point3d.ORIG, Vector3d.X_AX, Vector3d.Y_AX, Vector3d.Z_AX) Case GRID_TYPE.FRONT frNew.Setup(Point3d.ORIG, Vector3d.X_AX, Vector3d.Z_AX, -Vector3d.Y_AX) Case GRID_TYPE.RIGHT frNew.Setup(Point3d.ORIG, Vector3d.Y_AX, Vector3d.Z_AX, Vector3d.X_AX) Case GRID_TYPE.BACK frNew.Setup(Point3d.ORIG, -Vector3d.X_AX, Vector3d.Z_AX, Vector3d.Y_AX) Case GRID_TYPE.LEFT frNew.Setup(Point3d.ORIG, -Vector3d.Y_AX, Vector3d.Z_AX, -Vector3d.X_AX) Case GRID_TYPE.BOTTOM frNew.Setup(Point3d.ORIG, -Vector3d.X_AX, Vector3d.Y_AX, -Vector3d.Z_AX) Case GRID_TYPE.VIEW Dim dAngVertDeg As Double Dim dAngHorizDeg As Double EgtGetGenericView(dAngVertDeg, dAngHorizDeg) Dim vtDir As Vector3d = Vector3d.FromSpherical(1, dAngVertDeg, dAngHorizDeg) frNew.Setup(Point3d.ORIG, vtDir) Case Else Return False End Select EnableCommandLog() EgtSetGridFrame(frNew) DisableCommandLog() EgtDraw() Return True End Function Private Function ProcessGridElevation() As Boolean Select Case m_nStep Case 0 ' non serve il gruppo di drag m_Scene.SetStatusSelPoint() ' imposto stato a lunghezza per elevazione griglia m_nStep = 1 ' abilito dialogo m_Scene.SetStatusNull() RaiseEvent PrepareInputBox("GRID", "Insert Elevation", "", False, False) m_nInpType = IBT.TY_LENGTH m_dLast = 0 SetInputBoxDouble(m_dLast, True) Case 1 ' recupero il piano di griglia corrente Dim frCurr As New Frame3d(EgtGetGridFrame()) ' cambio l'elevazione dell'origine frCurr.Move(EgtGetGridVersZ() * m_dLast) ' imposto nuova griglia EnableCommandLog() EgtSetGridFrame(frCurr) DisableCommandLog() ' reset stato scena m_Scene.ResetStatus() ' aggiorno stato m_nStep = 0 RaiseEvent UpdateUI(Me, False) Case Else m_nStep = 0 Return False End Select Return True End Function Private Function ProcessGridOrigin() As Boolean Select Case m_nStep Case 0 ' non serve il gruppo di drag m_Scene.SetStatusSelPoint() ' imposto stato a primo punto per origine griglia m_nStep = 1 ' abilito dialogo RaiseEvent PrepareInputBox("GRID", "Insert Origin", "", False, False) m_nInpType = IBT.TY_POINT3D Case 1 ' recupero il piano di griglia corrente Dim frCurr As New Frame3d(EgtGetGridFrame()) ' ne modifico l'origine frCurr.Move(m_ptLast - frCurr.Orig()) ' imposto nuova griglia EnableCommandLog() EgtSetGridFrame(frCurr) DisableCommandLog() ' reset stato scena m_Scene.ResetStatus() ' aggiorno stato m_nStep = 0 RaiseEvent UpdateUI(Me, False) Case Else m_nStep = 0 Return False End Select Return True End Function Private Function ProcessGridRotate() As Boolean Select Case m_nStep Case 0 ' non serve il gruppo di drag m_Scene.SetStatusSelPoint() ' imposto stato a primo punto per rotazione griglia m_nStep = 1 ' abilito dialogo RaiseEvent PrepareInputBox("GRID ROTATE", "Insert Center", "", False, False) m_nInpType = IBT.TY_POINT3D Case 1 m_ptP1 = m_ptLast m_ptP2 = m_ptP1 m_nStep = 2 RaiseEvent PrepareInputBox("GRID ROTATE", "Insert Base Point", "", False, False) m_nInpType = IBT.TY_POINT3D Case 2 m_ptP2 = m_ptLast m_nStep = 3 RaiseEvent PrepareInputBox("GRID ROTATE", "Insert Rotation Point", "", False, False) m_nInpType = IBT.TY_POINT3D Case 3 ' calcolo parametri di rotazione Dim dAngRotDeg As Double = 0 Dim bDet As Boolean = True EgtGetVectorRotation((m_ptP2 - m_ptP1), (m_ptLast - m_ptP1), EgtGetGridVersZ(), dAngRotDeg, bDet) ' eseguo rotazione Dim frCurr As New Frame3d(EgtGetGridFrame()) frCurr.Rotate(m_ptP1, EgtGetGridVersZ(), dAngRotDeg) EnableCommandLog() EgtSetGridFrame(frCurr) DisableCommandLog() ' reset m_Scene.ResetStatus() m_nStep = 0 RaiseEvent UpdateUI(Me, False) Case Else m_nStep = 0 Return False End Select Return True End Function Private Sub DragGridRotate() If m_nStep = 2 Then EgtSetGeoLine(m_ptP1, m_ptLast) EgtDraw() ElseIf m_nStep = 3 Then EgtSetGeoLine(m_ptP1, m_ptLast) EgtDraw() End If End Sub Private Function ProcessGridRotate3D() As Boolean Select Case m_nStep Case 0 ' non serve il gruppo di drag m_Scene.SetStatusSelPoint() ' imposto stato a primo punto per rotazione griglia m_nStep = 1 ' abilito dialogo RaiseEvent PrepareInputBox("GRID ROTATE 3D", "Insert First Point on Axis", "", False, False) m_nInpType = IBT.TY_POINT3D Case 1 m_ptP1 = m_ptLast m_ptP2 = m_ptP1 m_nStep = 2 RaiseEvent PrepareInputBox("GRID ROTATE 3D", "Insert Second Point on Axis", "", False, False) m_nInpType = IBT.TY_POINT3D Case 2 m_ptP2 = m_ptLast m_nStep = 3 m_Scene.SetStatusNull() RaiseEvent PrepareInputBox("GRID ROTATE 3D", "Insert angle", "", False, False) m_nInpType = IBT.TY_DOUBLE Case 3 ' eseguo rotazione Dim VtAx As Vector3d = m_ptP2 - m_ptP1 Dim frCurr As New Frame3d(EgtGetGridFrame()) frCurr.Rotate(m_ptP1, VtAx, m_dLast) EnableCommandLog() EgtSetGridFrame(frCurr) DisableCommandLog() ' reset m_Scene.ResetStatus() m_nStep = 0 RaiseEvent UpdateUI(Me, False) Case Else m_nStep = 0 Return False End Select Return True End Function Private Sub DragGridRotate3D() If m_nStep = 2 Then EgtSetGeoLine(m_ptP1, m_ptLast) EgtDraw() ElseIf m_nStep = 3 Then EgtSetGeoLine(m_ptP1, m_ptP2) EgtDraw() End If End Sub Private Function ProcessGrid3P() As Boolean Select Case m_nStep Case 0 ' non serve il gruppo di drag m_Scene.SetStatusSelPoint() ' imposto stato a primo punto per rotazione griglia m_nStep = 1 ' abilito dialogo RaiseEvent PrepareInputBox("GRID 3 POINTS", "Insert Origin", "", False, False) m_nInpType = IBT.TY_POINT3D Case 1 m_ptP1 = m_ptLast m_ptP2 = m_ptP1 m_nStep = 2 RaiseEvent PrepareInputBox("GRID 3 POINTS", "Insert Point on X Axis", "", False, False) m_nInpType = IBT.TY_POINT3D Case 2 m_ptP2 = m_ptLast m_nStep = 3 RaiseEvent PrepareInputBox("GRID 3 POINTS", "Insert Point Near Y Axis", "", False, False) m_nInpType = IBT.TY_POINT3D Case 3 ' calcolo griglia per 3 punti Dim frCurr As New Frame3d If Not frCurr.Setup(m_ptP1, m_ptP2, m_ptLast) Then m_Scene.ResetStatus() m_nStep = 0 Return False End If EnableCommandLog() EgtSetGridFrame(frCurr) DisableCommandLog() ' reset m_Scene.ResetStatus() m_nStep = 0 RaiseEvent UpdateUI(Me, False) Case Else m_nStep = 0 Return False End Select Return True End Function Private Function ProcessGridPerpObj() As Boolean Select Case m_nStep Case 0 ' non serve il gruppo di drag m_Scene.SetStatusSelPoint(True) ' imposto stato a primo punto per rotazione griglia m_nStep = 1 ' abilito dialogo RaiseEvent PrepareInputBox("GRID PERP OBJECT", "Insert Origin", "", False, False) m_nInpType = IBT.TY_POINT3D Case 1 ' calcolo griglia dato punto e versore Z Dim frCurr As New Frame3d If Not frCurr.Setup(m_ptLast, m_vtCont) Then m_Scene.ResetStatus() m_nStep = 0 Return False End If EnableCommandLog() EgtSetGridFrame(frCurr) DisableCommandLog() ' reset m_Scene.ResetStatus() m_nStep = 0 RaiseEvent UpdateUI(Me, False) Case Else m_nStep = 0 Return False End Select Return True End Function Private Function ProcessGridObj() As Boolean If m_nStep <> 0 Then Return False End If Dim nId As Integer = EgtGetLastSelectedObj() Select Case EgtGetType(nId) Case GDB_TY.GROUP Dim frNew As New Frame3d If Not EgtFrame(nId, GDB_ID.ROOT, frNew) Then Return False EnableCommandLog() EgtSetGridFrame(frNew) DisableCommandLog() Case GDB_TY.GEO_POINT Dim ptOrig As Point3d If Not EgtStartPoint(nId, GDB_ID.ROOT, ptOrig) Then Return False Dim frNew As Frame3d = EgtGetGridFrame() frNew.ChangeOrigin(ptOrig) EnableCommandLog() EgtSetGridFrame(frNew) DisableCommandLog() Case GDB_TY.GEO_FRAME Dim frNew As New Frame3d If Not EgtFrame(nId, GDB_ID.ROOT, frNew) Then Return False EnableCommandLog() EgtSetGridFrame(frNew) DisableCommandLog() Case GDB_TY.CRV_LINE, GDB_TY.CRV_ARC, GDB_TY.CRV_BEZ, GDB_TY.CRV_COMPO Dim vtZ As Vector3d If Not EgtCurveExtrusion(nId, vtZ) OrElse vtZ.IsSmall() Then If Not EgtArcNormVersor(nId, vtZ) Then vtZ = Vector3d.Z_AX End If Dim ptOrig As Point3d EgtCentroid(nId, ptOrig) Dim frNew As New Frame3d frNew.Setup(ptOrig.Glob(nId), vtZ.Glob(nId)) EnableCommandLog() EgtSetGridFrame(frNew) DisableCommandLog() Case GDB_TY.SRF_MESH Dim nLastId, nLastSub As Integer Dim ptLastSel As Point3d EgtGetLastSelInfo( nLastId, nLastSub, ptLastSel) Dim nF As Integer = EgtSurfTmFacetFromTria(nId, nLastSub) If nF >= 0 Then Dim ptOrig As Point3d Dim vtZ As Vector3d If EgtSurfTmFacetCenter(nId, nF, ptOrig, vtZ) Then Dim frNew As New Frame3d frNew.Setup(ptOrig.Glob(nId), vtZ.Glob(nId)) EnableCommandLog() EgtSetGridFrame(frNew) DisableCommandLog() End If End If Case GDB_TY.SRF_FRGN Dim ptOrig As Point3d Dim vtZ As Vector3d If EgtCenterPoint(nId, ptOrig) AndAlso EgtSurfFrNormVersor(nId, vtZ) Then Dim frNew As New Frame3d frNew.Setup(ptOrig.Glob(nId), vtZ.Glob(nId)) EnableCommandLog() EgtSetGridFrame(frNew) DisableCommandLog() End If Case GDB_TY.EXT_TEXT Dim vtX As Vector3d Dim vtZ As Vector3d If EgtStartVector(nId, vtX) And EgtTextNormVersor(nId, vtZ) Then Dim vtY As Vector3d = vtZ ^ vtX Dim ptOrig As Point3d EgtStartPoint(nId, ptOrig) Dim frNew As New Frame3d frNew.Setup(ptOrig.Glob(nId), vtX.Glob(nId), vtY.Glob(nId), vtZ.Glob(nId)) EnableCommandLog() EgtSetGridFrame(frNew) DisableCommandLog() End If End Select EgtDeselectAll() EgtDraw() Return True End Function Private Function ProcessNewPart() As Boolean If m_nStep <> 0 Then Return False End If EnableCommandLog() ' inserisco un nuovo gruppo (part) 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, Frame3d.GLOB(), GDB_RT.GRID) ' se ok, salvo nuova situazione If nIdNewPart <> GDB_ID.NULL And nIdNewLayer <> GDB_ID.NULL Then EgtSetCurrPartLayer(nIdNewPart, nIdNewLayer) End If DisableCommandLog() RaiseEvent UpdateUI(Me, True) Return True End Function Private Function ProcessNewLayer() As Boolean If m_nStep <> 0 Then Return False End If EnableCommandLog() ' inserisco un nuovo gruppo (layer) sotto il pezzo corrente Dim nIdNewLayer As Integer = EgtCreateGroup(EgtGetCurrPart(), Frame3d.GLOB(), GDB_RT.GRID) ' se ok, salvo nuova situazione If nIdNewLayer <> GDB_ID.NULL Then EgtSetCurrPartLayer(EgtGetCurrPart(), nIdNewLayer) End If DisableCommandLog() RaiseEvent UpdateUI(Me, True) Return True End Function Private Function ProcessSetCurrPartLayer() As Boolean If m_nStep <> 0 Then Return False End If ' se non è un gruppo ne cerco il padre Dim nId As Integer = m_nLast While EgtGetType(nId) <> GDB_TY.GROUP nId = EgtGetParent(nId) If nId = GDB_ID.NULL Then Return False End If End While ' recupero il padre EgtEnableCommandLogger() Dim nParentId As Integer = EgtGetParent(nId) If nParentId = GDB_ID.NULL Then Return False ' se Part ElseIf nParentId = GDB_ID.ROOT Then ' cerco il primo Layer visibile del Part 'Dim nIdLayer As Integer = EgtGetFirstLayer(nId, True) 'EgtSetCurrPartLayer(nId, nIdLayer) EgtSetCurrPartLayer(nId, GDB_ID.NULL) ' se Layer ElseIf EgtGetParent(nParentId) = GDB_ID.ROOT Then EgtSetCurrPartLayer(nParentId, nId) End If EgtDisableCommandLogger() RaiseEvent UpdateUI(Me, False) Return True End Function Private Function ProcessResetCurrPartLayer() As Boolean If m_nStep <> 0 Then Return False End If EgtEnableCommandLogger() EgtResetCurrPartLayer() EgtDisableCommandLogger() Return True End Function Private Function ProcessLayerColor() As Boolean If m_nStep <> 0 Then Return False Dim nCurrId As Integer If EgtGetCurrPart() <> GDB_ID.NULL Then nCurrId = EgtGetCurrPart() If EgtGetCurrLayer() <> GDB_ID.NULL Then nCurrId = EgtGetCurrLayer() End If Else Return False End If Dim colObj As Color3d EgtGetCalcColor(nCurrId, colObj) If SelectColor(colObj, colObj) Then EnableCommandLog() EgtSetColor(nCurrId, colObj) DisableCommandLog() RaiseEvent UpdateUI(Me, False) EgtDraw() End If Return True End Function Private Function ProcessSelectGroup() As Boolean If m_nStep <> 0 Then Return False ' Lo seleziono EnableCommandLog() Dim bOk As Boolean = EgtSelectObj(m_nLast) DisableCommandLog() If Not bOk Then Return False ' Aggiorno visualizzazione RaiseEvent UpdateUI(Me, False) EgtDraw() Return True End Function Private Function ProcessSelectPartLayerObj() As Boolean If m_nStep <> 0 Then Return False End If ' se gruppo If EgtGetType(m_nLast) = GDB_TY.GROUP Then ' se pezzo If EgtGetParent(m_nLast) = GDB_ID.ROOT Then ' seleziono tutti gli oggetti del pezzo EnableCommandLog() Dim bOk As Boolean = EgtSelectPartObjs(m_nLast) DisableCommandLog() If Not bOk Then Return False End If ' se layer ElseIf EgtGetParent(EgtGetParent(m_nLast)) = GDB_ID.ROOT Then ' seleziono tutti gli oggetti del layer EnableCommandLog() Dim bOk As Boolean = EgtSelectLayerObjs(m_nLast) DisableCommandLog() If Not bOk Then Return False End If ' altrimenti errore Else Return False End If ' altrimenti entità Else ' la seleziono EnableCommandLog() Dim bOk As Boolean = EgtSelectObj(m_nLast) DisableCommandLog() If Not bOk Then Return False End If End If RaiseEvent UpdateUI(Me, False) EgtDraw() Return True End Function Private Function ProcessDeselectPartLayerObj() As Boolean If m_nStep <> 0 Then Return False End If ' se gruppo If EgtGetType(m_nLast) = GDB_TY.GROUP Then ' se pezzo If EgtGetParent(m_nLast) = GDB_ID.ROOT Then ' deseleziono tutti gli oggetti del pezzo EnableCommandLog() Dim bOk As Boolean = EgtDeselectPartObjs(m_nLast) DisableCommandLog() If Not bOk Then Return False End If ' se layer ElseIf EgtGetParent(EgtGetParent(m_nLast)) = GDB_ID.ROOT Then ' deseleziono tutti gli oggetti del layer EnableCommandLog() Dim bOk As Boolean = EgtDeselectLayerObjs(m_nLast) DisableCommandLog() If Not bOk Then Return False End If ' altrimenti errore Else Return False End If ' altrimenti entità Else ' la deseleziono EnableCommandLog() Dim bOk As Boolean = EgtDeselectObj(m_nLast) DisableCommandLog() If Not bOk Then Return False End If End If RaiseEvent UpdateUI(Me, False) EgtDraw() Return True End Function Private Function ProcessRelocatePartLayerObj() As Boolean If m_nStep <> 0 Then Return False End If Dim nRefId As Integer = GDB_ID.NULL Dim nPos As GDB_POS = GDB_POS.LAST_SON ' se gruppo If EgtGetType(m_nLast) = GDB_TY.GROUP Then ' se pezzo If EgtGetParent(m_nLast) = GDB_ID.ROOT Then ' il riferimento è dopo l'ultimo sotto la radice nRefId = EgtGetLastInGroup(GDB_ID.ROOT) nPos = GDB_POS.AFTER ' se layer ElseIf EgtGetParent(EgtGetParent(m_nLast)) = GDB_ID.ROOT Then Dim nCurrPartId = EgtGetCurrPart() ' il riferimento è il pezzo corrente nRefId = nCurrPartId ' se il pezzo sorgente è il corrente If EgtGetParent(m_nLast) = nCurrPartId Then ' il riferimento è dopo l'ultimo sotto il pezzo nRefId = EgtGetLastInGroup(nCurrPartId) nPos = GDB_POS.AFTER End If ' altrimenti errore Else Return False End If ' altrimenti entità Else Dim nCurrLayerId As Integer = EgtGetCurrLayer() ' il riferimento è il layer corrente nRefId = nCurrLayerId ' se il layer sorgente è il corrente If EgtGetParent(m_nLast) = nCurrLayerId Then ' il riferimento è dopo l'ultimo sotto il layer nRefId = EgtGetLastInGroup(nCurrLayerId) nPos = GDB_POS.AFTER End If End If EnableCommandLog() EgtRelocateGlob(m_nLast, nRefId, nPos) DisableCommandLog() RaiseEvent UpdateUI(Me, True) EgtDraw() Return True End Function Private Function DoCopyPartLayerObj(nId As Integer) As Integer Dim nNewId As Integer = GDB_ID.NULL ' se pezzo If EgtIsPart(m_nLast) Then nNewId = EgtCopyGlob(m_nLast, GDB_ID.ROOT) ' se layer ElseIf EgtIsLayer(m_nLast) Then nNewId = EgtCopyGlob(m_nLast, EgtGetCurrPart()) ' se entità ElseIf EgtGetType(m_nLast) <> GDB_TY.GROUP Then nNewId = EgtCopyGlob(m_nLast, EgtGetCurrLayer()) End If Return nNewId End Function Private Function ProcessCopyPartLayerObj() As Boolean Select Case m_nStep Case 0 EnableCommandLog() EgtDeselectAll() DisableCommandLog() Dim bOk As Boolean = True ' se pezzo If EgtIsPart(m_nLast) Then ' seleziono tutti gli oggetti del pezzo bOk = EgtSelectPartObjs(m_nLast) ' se layer ElseIf EgtIsLayer(m_nLast) Then ' seleziono tutti gli oggetti del layer bOk = EgtSelectLayerObjs(m_nLast) ' altrimenti entità ElseIf EgtGetType(m_nLast) <> GDB_TY.GROUP Then ' la seleziono bOk = EgtSelectObj(m_nLast) End If ' in caso di errore, esco If Not bOk Then Return False End If ' se non ci sono oggetti selezionati copio ed esco subito If EgtGetSelectedObjCount() = 0 Then EnableCommandLog() Dim nNewId = DoCopyPartLayerObj(m_nLast) DisableCommandLog() RaiseEvent UpdateUI(Me, True) Return True End If ' preparo per il drag If Not PrepareTransform() Then Return False End If m_Scene.SetStatusSelPoint() m_nStep = 1 ' abilito dialogo "COPY", "Insert Base Point" RaiseEvent PrepareInputBox(EgtMsg(2401), EgtMsg(2403), "", False, False) m_nInpType = IBT.TY_POINT3D Case 1 m_ptP1 = m_ptLast m_nStep = 2 m_Scene.EnableDrag() ' abilito dialogo "COPY", "Insert Target Point" RaiseEvent PrepareInputBox(EgtMsg(2401), EgtMsg(2404), "", False, True) m_nInpType = IBT.TY_POINT3D Case 2 m_Scene.ResetStatus(False) EgtDeselectAll() EnableCommandLog() ' eseguo copia Dim nNewId = DoCopyPartLayerObj(m_nLast) ' eseguo movimento EgtMove(nNewId, (m_ptLast - m_ptP1).Loc(GDB_ID.GRID), GDB_RT.GRID) DisableCommandLog() EgtDraw() ' aggiorno stato m_nStep = 0 RaiseEvent UpdateUI(Me, True) Case Else m_nStep = 0 Return False End Select Return True End Function Private Sub DragCopyPartLayerObj() If m_nStep = 2 Then ' ripristino lo stato iniziale EgtChangeGroupFrame(m_Scene.GetDragGroup(), Frame3d.GLOB) ' eseguo tutto il movimento EgtMove(m_Scene.GetDragGroup(), (m_ptLast - m_ptP1), GDB_RT.GLOB) EgtSetGeoLine(m_ptP1, m_ptLast) EgtDraw() End If End Sub Private Function ProcessShow() As Boolean If m_nStep <> 0 Then Return False End If If m_nLast <> GDB_ID.NULL Then Dim nStat As GDB_ST = GDB_ST.ON_ EgtGetStatus(m_nLast, nStat) If nStat = GDB_ST.OFF Then EnableCommandLog() EgtSetStatus(m_nLast, GDB_ST.ON_) DisableCommandLog() RaiseEvent UpdateUI(Me, False) EgtDraw() End If End If Return True End Function Private Function ProcessHide() As Boolean If m_nStep <> 0 Then Return False End If If m_nLast <> GDB_ID.NULL Then Dim nStat As GDB_ST = GDB_ST.ON_ EgtGetStatus(m_nLast, nStat) If nStat <> GDB_ST.OFF Then ' nascondo EnableCommandLog() EgtSetStatus(m_nLast, GDB_ST.OFF) DisableCommandLog() RaiseEvent UpdateUI(Me, False) EgtDraw() End If End If Return True End Function Private Function ProcessSetName() As Boolean Select Case m_nStep Case 0 ' posso partire solo se esiste una entità riferita If m_nLast = GDB_ID.NULL Then Return False End If ' recupero e imposto eventuale nome già assegnato m_sLast = String.Empty EgtGetName(m_nLast, m_sLast) ' imposto stato a prima stringa per nome m_nStep = 1 ' abilito dialogo RaiseEvent PrepareInputBox("NAME", "Insert Name", "", False, False) m_nInpType = IBT.TY_STRING SetInputBoxString(m_sLast) Case 1 ' assegno o rimuovo il nome EnableCommandLog() If Not String.IsNullOrWhiteSpace(m_sLast) Then EgtSetName(m_nLast, m_sLast) Else EgtRemoveName(m_nLast) End If DisableCommandLog() ' reset stato scena m_Scene.ResetStatus() ' aggiorno stato m_nStep = 0 RaiseEvent UpdateUI(Me, True) Case Else m_nStep = 0 Return False End Select Return True End Function Private Function ProcessSetInfo() As Boolean Select Case m_nStep Case 0 ' posso partire solo se esiste una entità riferita If m_nLast = GDB_ID.NULL Then Return False End If ' imposto stato a prima stringa per info m_nStep = 1 ' abilito dialogo RaiseEvent PrepareInputBox("INFO", "Insert Info (Key=Val)", "", False, False) m_nInpType = IBT.TY_STRING Case 1 ' divido la stringa in chiave e valore Dim sItems() As String = m_sLast.Split("=".ToCharArray) If sItems.Count() = 2 Then ' assegno o rimuovo l'info EnableCommandLog() If Not String.IsNullOrWhiteSpace(sItems(1)) Then EgtSetInfo(m_nLast, sItems(0), sItems(1)) Else EgtRemoveInfo(m_nLast, sItems(0)) End If DisableCommandLog() End If ' reset stato scena m_Scene.ResetStatus() ' aggiorno stato m_nStep = 0 RaiseEvent UpdateUI(Me, False) Case Else m_nStep = 0 Return False End Select Return True End Function Private Function ProcessPoint() As Boolean Select Case m_nStep Case 0 ' deve esistere un gruppo corrente e devo poter creare il gruppo di drag If GetCurrLayer() = GDB_ID.NULL Or Not m_Scene.CreateDragGroup() Then Return False End If m_Scene.EnableDrag() ' imposto stato a primo punto per point m_Scene.SetStatusSelPoint() m_nStep = 1 ' abilito dialogo RaiseEvent PrepareInputBox("POINT", "Insert Point", "", False, True) m_nInpType = IBT.TY_POINT3D SetInputBoxPoint3d(m_ptCont) Case 1 ' reset scena m_Scene.ResetStatus(False) ' creo il punto (i dati sono in globale) EnableCommandLog() If EgtCreateGeoPoint(GetCurrLayer(), m_ptLast.Loc(GDB_ID.GRID), GDB_RT.GRID) <> GDB_ID.NULL Then m_ptCont = m_ptLast End If DisableCommandLog() EgtDraw() ' aggiorno stato m_nStep = 0 RaiseEvent UpdateUI(Me, True) Case Else m_nStep = 0 Return False End Select Return True End Function Private Sub DragPoint() ' il gruppo di Drag ha riferimento globale If m_nStep = 1 Then ' svuoto il gruppo di drag EgtEmptyGroup(m_Scene.GetDragGroup()) ' creo il punto EgtCreateGeoPoint(m_Scene.GetDragGroup(), m_ptLast, GDB_RT.GLOB) EgtDraw() End If End Sub Private Function ProcessVector() As Boolean Select Case m_nStep Case 0 ' deve esistere un gruppo corrente e devo poter creare il gruppo di drag If GetCurrLayer() = GDB_ID.NULL Or Not m_Scene.CreateDragGroup() Then Return False End If m_Scene.EnableDrag() ' imposto stato a primo punto per vector m_Scene.SetStatusSelPoint(True) m_nStep = 1 ' abilito dialogo RaiseEvent PrepareInputBox("VECTOR", "Insert Start Point", "", False, True) m_nInpType = IBT.TY_POINT3D SetInputBoxPoint3d(m_ptCont) Case 1 m_ptP1 = m_ptLast m_vtLast = 10 * m_vtCont m_nStep = 2 m_Scene.DisableDrag() RaiseEvent PrepareInputBox("VECTOR", "Insert Vector ", "", False, True) m_nInpType = IBT.TY_VECTOR3D SetInputBoxVector3d(m_vtLast) EgtDisableModified() DragVector() EgtEnableModified() Case 2 ' reset scena m_Scene.ResetStatus(False) ' creo il vettore (i dati sono in globale) EnableCommandLog() If EgtCreateGeoVector(GetCurrLayer(), m_vtLast.Loc(GDB_ID.GRID), m_ptP1.Loc(GDB_ID.GRID), GDB_RT.GRID) <> GDB_ID.NULL Then m_ptCont = m_ptP1 m_vtCont = m_vtLast m_vtCont.Normalize() End If DisableCommandLog() EgtDraw() ' aggiorno stato m_nStep = 0 RaiseEvent UpdateUI(Me, True) Case Else m_nStep = 0 Return False End Select Return True End Function Private Sub DragVector() ' il gruppo di Drag ha riferimento globale If m_nStep = 2 Then ' svuoto il gruppo di drag EgtEmptyGroup(m_Scene.GetDragGroup()) ' creo il vettore EgtCreateGeoVector(m_Scene.GetDragGroup(), m_vtLast, m_ptP1, GDB_RT.GLOB) EgtDraw() End If End Sub Private Function ProcessFrame() As Boolean Select Case m_nStep Case 0 ' deve esistere un gruppo corrente e devo poter creare il gruppo di drag If GetCurrLayer() = GDB_ID.NULL Or Not m_Scene.CreateDragGroup() Then Return False End If m_Scene.EnableDrag() ' imposto stato a primo punto per point m_Scene.SetStatusSelPoint() m_nStep = 1 ' abilito dialogo RaiseEvent PrepareInputBox("FRAME", "Insert Origin", "", False, True) m_nInpType = IBT.TY_POINT3D SetInputBoxPoint3d(m_ptCont) Case 1 ' reset scena m_Scene.ResetStatus(False) ' creo il frame allineato con grid (i dati sono in globale) EnableCommandLog() If EgtCreateGeoFrame(GetCurrLayer(), New Frame3d(m_ptLast.Loc(GDB_ID.GRID)), GDB_RT.GRID) <> GDB_ID.NULL Then m_ptCont = m_ptLast End If DisableCommandLog() EgtDraw() ' aggiorno stato m_nStep = 0 RaiseEvent UpdateUI(Me, True) Case Else m_nStep = 0 Return False End Select Return True End Function Private Sub DragFrame() ' il gruppo di Drag ha riferimento globale If m_nStep = 1 Then ' svuoto il gruppo di drag EgtEmptyGroup(m_Scene.GetDragGroup()) ' creo il frame Dim frNew As Frame3d = EgtGetGridFrame() frNew.ChangeOrigin(m_ptLast) EgtCreateGeoFrame(m_Scene.GetDragGroup(), frNew, GDB_RT.GLOB) EgtDraw() End If End Sub Private Function ProcessLine2P() As Boolean Select Case m_nStep Case 0 ' deve esistere un gruppo corrente e devo poter creare il gruppo di drag If GetCurrLayer() = GDB_ID.NULL Or Not m_Scene.CreateDragGroup() Then Return False End If ' imposto stato a primo punto per Line2P m_Scene.SetStatusSelPoint() m_nStep = 1 ' abilito dialogo RaiseEvent PrepareInputBox("LINE 2P", "Insert Start Point", "", False, False) m_nInpType = IBT.TY_POINT3D SetInputBoxPoint3d(m_ptCont) m_Scene.EnableTangentPoint() m_Scene.EnablePerpendicularPoint() m_Scene.EnableMinDistPoint() Case 1 m_ptP1 = m_ptLast m_sepP1 = m_sepLast m_nIdP1 = m_nIdLast m_ptCont = m_ptLast m_nStep = 2 m_Scene.EnableDrag() RaiseEvent PrepareInputBox("LINE 2P", "Insert End Point ", "", False, True) m_nInpType = IBT.TY_POINT3D SetInputBoxPoint3d(m_ptLast) Select Case m_sepP1 Case SEP.PT_TG, SEP.PT_PERP m_Scene.DisableMinDistPoint() Case SEP.PT_MINDIST m_Scene.DisableTangentPoint() m_Scene.DisablePerpendicularPoint() m_Scene.DisableMinDistPoint() End Select Case 2 ' reset scena m_Scene.ResetStatus(False) ' creo la linea (i punti sono in globale) EnableCommandLog() Dim nId As Integer = EgtCreateLineEx(GetCurrLayer(), m_ptP1.Loc(GDB_ID.GRID), m_sepP1, m_nIdP1, m_ptLast.Loc(GDB_ID.GRID), m_sepLast, m_nIdLast, GDB_RT.GRID) ' se richiesta curva composita e creazione riuscita If m_bContinue And nId <> GDB_ID.NULL Then If m_nContinueId = GDB_ID.NULL Then m_nContinueId = EgtCreateCurveCompo(GetCurrLayer(), nId, True) nId = m_nContinueId Else If EgtAddCurveCompoCurve(m_nContinueId, nId, True) Then nId = m_nContinueId Else nId = GDB_ID.NULL End If End If End If DisableCommandLog() If nId <> GDB_ID.NULL Then m_ptCont = m_ptLast m_vtCont = (m_ptLast - m_ptP1) m_vtCont.Normalize() End If EgtDraw() ' aggiorno stato RaiseEvent UpdateUI(Me, True) ' se continuazione e creazione riuscita, vedo di continuare ... If m_bContinue And nId <> GDB_ID.NULL Then ContinueLine2P() Else m_nStep = 0 End If Case Else m_nStep = 0 Return False End Select Return True End Function Private Sub DragLine2P() ' il gruppo di Drag ha riferimento globale If m_nStep = 2 Then ' recupero possibile entità già nel gruppo di drag Dim nId As Integer = EgtGetFirstInGroup(m_Scene.GetDragGroup()) ' se punti entrambi già definiti If m_sepP1 = SEP.PT_STD And m_sepLast = SEP.PT_STD Then If nId = GDB_ID.NULL Then EgtCreateLine(m_Scene.GetDragGroup(), m_ptP1, m_ptLast, GDB_RT.GLOB) Else EgtModifyCurveEndPoint(nId, m_ptLast, GDB_RT.GLOB) End If ' altrimenti, uno dei punti tangente o normale Else EgtErase(nId) EgtCreateLineEx(m_Scene.GetDragGroup(), m_ptP1, m_sepP1, m_nIdP1, m_ptLast, m_sepLast, m_nIdLast, GDB_RT.GLOB) End If EgtDraw() End If End Sub Public Sub ContinueLine2P() ' verifico di essere in modalità continua If Not m_bContinue Then Return End If ' pulisco m_Scene.ResetStatus(False) ' imposto per stato 1 di linea 2P m_nLastCmd = CMD.LINE2P m_nStep = 1 m_Scene.CreateDragGroup() m_Scene.SetStatusSelPoint() m_ptLast = m_ptCont m_sepLast = SEP.PT_STD m_nIdLast = GDB_ID.NULL ' processo stato 1 per essere sul 2 ProcessLine2P() End Sub Private Function ProcessLinePDL() As Boolean Select Case m_nStep Case 0 ' deve esistere un gruppo corrente e devo poter creare il gruppo di drag If GetCurrLayer() = GDB_ID.NULL Or Not m_Scene.CreateDragGroup() Then Return False End If ' imposto stato a primo punto per Line2P m_Scene.SetStatusSelPoint(True) m_nStep = 1 ' abilito dialogo RaiseEvent PrepareInputBox("LINE PDL", "Insert Start Point", "", False, False) m_nInpType = IBT.TY_POINT3D SetInputBoxPoint3d(m_ptCont) Case 1 m_ptP1 = m_ptLast m_vtLast = m_vtCont m_dAux = m_dLastLen ' posso prendere punto per definire direzione, ma non prendo direzione notevole m_Scene.SetStatusSelPoint(False) m_nStep = 2 m_Scene.DisableDrag() RaiseEvent PrepareInputBox("LINE PDL", "Insert Direction", "", False, True) m_nInpType = IBT.TY_DIRECTION m_dLast = GridAngFromGlobDir(m_vtLast) SetInputBoxDouble(m_dLast) EgtDisableModified() DragLinePDL() EgtEnableModified() Case 2 m_dPrev = m_dLast m_vtLast = GlobDirFromGridAng(m_dPrev) m_dLast = m_dAux m_nStep = 3 m_Scene.DisableDrag() EgtUnselectableRemove(m_Scene.GetDragGroup()) RaiseEvent PrepareInputBox("LINE PDL", "Insert Length", "", False, True) m_nInpType = IBT.TY_LENGTH SetInputBoxDouble(m_dLast, True) EgtDisableModified() DragLinePDL() EgtEnableModified() Case 3 ' reset scena m_Scene.ResetStatus(False) ' creo la linea (i punti sono in globale) EnableCommandLog() Dim nId As Integer = EgtCreateLinePDL(GetCurrLayer(), m_ptP1.Loc(GDB_ID.GRID), m_dPrev, m_dLast, GDB_RT.GRID) DisableCommandLog() If nId <> GDB_ID.NULL Then m_vtCont = m_vtLast m_ptCont = m_ptP1 + m_vtCont * m_dLast End If EgtDraw() ' aggiorno stato m_dLastLen = m_dLast m_nStep = 0 RaiseEvent UpdateUI(Me, True) Case Else m_nStep = 0 Return False End Select Return True End Function Private Sub DragLinePDL() If m_nStep = 2 Then ' inserimento direzione ' durante la creazione di oggetti il gruppo di Drag ha riferimento globale Dim nId As Integer = EgtGetFirstInGroup(m_Scene.GetDragGroup()) If nId = GDB_ID.NULL Then ' creo la linea di direzione EgtCreateLinePDL(m_Scene.GetDragGroup(), m_ptP1.Loc(GDB_ID.GRID), m_dLast, m_dAux, GDB_RT.GRID) Else Dim ptP2 As Point3d = m_ptP1.Loc(GDB_ID.GRID) + Vector3d.FromPolar(1, m_dLast) * m_dAux EgtModifyCurveEndPoint(nId, ptP2, GDB_RT.GRID) End If EgtDraw() ElseIf m_nStep = 3 Then ' inserimento lunghezza ' durante la creazione di oggetti il gruppo di Drag ha riferimento globale Dim nId As Integer = EgtGetFirstInGroup(m_Scene.GetDragGroup()) If nId = GDB_ID.NULL Then ' creo la linea di direzione EgtCreateLinePDL(m_Scene.GetDragGroup(), m_ptP1.Loc(GDB_ID.GRID), m_dPrev, m_dLast, GDB_RT.GRID) Else Dim ptP2 As Point3d = m_ptP1.Loc(GDB_ID.GRID) + Vector3d.FromPolar(1, m_dPrev) * m_dLast EgtModifyCurveEndPoint(nId, ptP2, GDB_RT.GRID) End If EgtDraw() End If End Sub Private Function ProcessLinePVL() As Boolean Select Case m_nStep Case 0 ' deve esistere un gruppo corrente e devo poter creare il gruppo di drag If GetCurrLayer() = GDB_ID.NULL Or Not m_Scene.CreateDragGroup() Then Return False End If ' imposto stato a primo punto per Line2P m_Scene.SetStatusSelPoint(True) m_nStep = 1 ' abilito dialogo RaiseEvent PrepareInputBox("LINE PVL", "Insert Start Point", "", False, False) m_nInpType = IBT.TY_POINT3D SetInputBoxPoint3d(m_ptCont) Case 1 m_ptP1 = m_ptLast m_vtLast = m_vtCont m_dAux = m_dLastLen ' posso prendere punto per definire direzione, ma non prendo direzione notevole m_Scene.SetStatusSelPoint(False) m_nStep = 2 m_Scene.DisableDrag() RaiseEvent PrepareInputBox("LINE PVL", "Insert Direction Vector", "", False, True) m_nInpType = IBT.TY_VECTOR3D SetInputBoxVector3d(m_vtLast) EgtDisableModified() DragLinePVL() EgtEnableModified() Case 2 m_dLast = m_dAux m_nStep = 3 m_Scene.DisableDrag() EgtUnselectableRemove(m_Scene.GetDragGroup()) RaiseEvent PrepareInputBox("LINE PVL", "Insert Length", "", False, True) m_nInpType = IBT.TY_LENGTH SetInputBoxDouble(m_dLast, True) EgtDisableModified() DragLinePVL() EgtEnableModified() Case 3 ' reset scena m_Scene.ResetStatus(False) ' creo la linea (i punti sono in globale) EnableCommandLog() Dim nId As Integer = EgtCreateLinePVL(GetCurrLayer(), m_ptP1.Loc(GDB_ID.GRID), m_vtLast.Loc(GDB_ID.GRID), m_dLast, GDB_RT.GRID) DisableCommandLog() If nId <> GDB_ID.NULL Then m_vtCont = m_vtLast m_vtCont.Normalize() m_ptCont = m_ptP1 + m_vtCont * m_dLast End If EgtDraw() ' aggiorno stato m_dLastLen = m_dLast m_nStep = 0 RaiseEvent UpdateUI(Me, True) Case Else m_nStep = 0 Return False End Select Return True End Function Private Sub DragLinePVL() If m_nStep = 2 Then ' inserimento direzione ' durante la creazione di oggetti il gruppo di Drag ha riferimento globale Dim nId As Integer = EgtGetFirstInGroup(m_Scene.GetDragGroup()) If nId = GDB_ID.NULL Then ' creo la linea di direzione EgtCreateLinePVL(m_Scene.GetDragGroup(), m_ptP1, m_vtLast, m_dAux, GDB_RT.GLOB) Else m_vtLast.Normalize() Dim ptP2 As Point3d = m_ptP1 + m_vtLast * m_dAux EgtModifyCurveEndPoint(nId, ptP2, GDB_RT.GLOB) End If EgtDraw() ElseIf m_nStep = 3 Then ' inserimento lunghezza ' durante la creazione di oggetti il gruppo di Drag ha riferimento globale Dim nId As Integer = EgtGetFirstInGroup(m_Scene.GetDragGroup()) If nId = GDB_ID.NULL Then ' creo la linea di direzione EgtCreateLinePVL(m_Scene.GetDragGroup(), m_ptP1, m_vtLast, m_dLast, GDB_RT.GLOB) Else m_vtLast.Normalize() Dim ptP2 As Point3d = m_ptP1 + m_vtLast * m_dLast EgtModifyCurveEndPoint(nId, ptP2) End If EgtDraw() End If End Sub Private Function ProcessCircleCP() As Boolean Select Case m_nStep Case 0 ' deve esistere un gruppo corrente e devo poter creare il gruppo di drag If GetCurrLayer() = GDB_ID.NULL Or Not m_Scene.CreateDragGroup() Then Return False End If m_Scene.SetStatusSelPoint() ' imposto stato a primo punto per CircleCR m_nStep = 1 ' abilito dialogo RaiseEvent PrepareInputBox("CIRCLE CP", "Insert Center", "", False, False) m_nInpType = IBT.TY_POINT3D Case 1 m_ptP1 = m_ptLast m_nStep = 2 m_Scene.EnableDrag() RaiseEvent PrepareInputBox("CIRCLE CP", "Insert Point", "", False, True) m_nInpType = IBT.TY_POINT3D m_Scene.EnableTangentPoint() Case 2 ' reset scena m_Scene.ResetStatus(False) ' creo la circonferenza (i punti sono in globale) EnableCommandLog() Dim nId As Integer = EgtCreateCircleCPEx(GetCurrLayer(), m_ptP1.Loc(GDB_ID.GRID), m_ptLast.Loc(GDB_ID.GRID), m_sepLast, m_nIdLast, GDB_RT.GRID) DisableCommandLog() EgtDraw() ' aggiorno stato m_nStep = 0 RaiseEvent UpdateUI(Me, True) Case Else m_nStep = 0 Return False End Select Return True End Function Private Sub DragCircleCP() If m_nStep = 2 Then ' durante la creazione di oggetti il gruppo di Drag ha riferimento globale Dim nId As Integer = EgtGetFirstInGroup(m_Scene.GetDragGroup()) If nId = GDB_ID.NULL Then EgtCreateCircleCP(m_Scene.GetDragGroup(), m_ptP1.Loc(GDB_ID.GRID), m_ptLast.Loc(GDB_ID.GRID), GDB_RT.GRID) Else EgtModifyCircleCP(nId, m_ptLast.Loc(GDB_ID.GRID), GDB_RT.GRID) End If EgtDraw() End If End Sub Private Function ProcessCircleCD() As Boolean Select Case m_nStep Case 0 ' deve esistere un gruppo corrente e devo poter creare il gruppo di drag If GetCurrLayer() = GDB_ID.NULL Or Not m_Scene.CreateDragGroup() Then Return False End If m_Scene.SetStatusSelPoint() ' imposto stato a primo punto per CircleCR m_nStep = 1 ' abilito dialogo RaiseEvent PrepareInputBox("CIRCLE CD", "Insert Center", "", False, False) m_nInpType = IBT.TY_POINT3D Case 1 m_ptP1 = m_ptLast m_nStep = 2 m_Scene.SetStatusNull() m_Scene.DisableDrag() RaiseEvent PrepareInputBox("CIRCLE CD", "Insert Diameter", "", False, True) m_nInpType = IBT.TY_LENGTH m_dLast = m_dLastDiam SetInputBoxDouble(m_dLast, True) EgtDisableModified() DragCircleCD() EgtEnableModified() Case 2 ' reset scena m_Scene.ResetStatus(False) ' creo la circonferenza (i punti sono in globale) EnableCommandLog() Dim nId As Integer = EgtCreateCircle(GetCurrLayer(), m_ptP1.Loc(GDB_ID.GRID), 0.5 * m_dLast, GDB_RT.GRID) DisableCommandLog() EgtDraw() ' aggiorno stato m_dLastDiam = m_dLast m_nStep = 0 RaiseEvent UpdateUI(Me, True) Case Else m_nStep = 0 Return False End Select Return True End Function Private Sub DragCircleCD() If m_nStep = 2 Then ' durante la creazione di oggetti il gruppo di Drag ha riferimento globale Dim nId As Integer = EgtGetFirstInGroup(m_Scene.GetDragGroup()) If nId = GDB_ID.NULL Then EgtCreateCircle(m_Scene.GetDragGroup(), m_ptP1.Loc(GDB_ID.GRID), 0.5 * m_dLast, GDB_RT.GRID) Else EgtModifyArcRadius(nId, 0.5 * m_dLast) End If EgtDraw() End If End Sub Private Function ProcessArcCSE() As Boolean Select Case m_nStep Case 0 ' deve esistere un gruppo corrente e devo poter creare il gruppo di drag If GetCurrLayer() = GDB_ID.NULL Or Not m_Scene.CreateDragGroup() Then Return False End If ' imposto stato a primo punto per ArcCSE m_Scene.SetStatusSelPoint() m_nStep = 1 ' abilito dialogo RaiseEvent PrepareInputBox("ARC CSE", "Insert Center", "", False, False) m_nInpType = IBT.TY_POINT3D Case 1 m_ptP1 = m_ptLast m_nStep = 2 m_Scene.EnableDrag() RaiseEvent PrepareInputBox("ARC CSE", "Insert Start Point", "", False, True) m_nInpType = IBT.TY_POINT3D m_Scene.EnableTangentPoint() Case 2 m_ptP2 = m_ptLast m_sepP2 = m_sepLast m_nIdP2 = m_nIdLast m_nStep = 3 m_Scene.EnableDrag() RaiseEvent PrepareInputBox("ARC CSE", "Insert Point Near End", "", False, True) m_nInpType = IBT.TY_POINT3D m_Scene.DisableTangentPoint() Case 3 ' reset scena m_Scene.ResetStatus(False) ' creo l'arco (i punti sono in globale) EnableCommandLog() Dim nId = EgtCreateArcC2PEx(GetCurrLayer(), m_ptP1.Loc(GDB_ID.GRID), m_ptP2.Loc(GDB_ID.GRID), m_sepP2, m_nIdP2, m_ptLast.Loc(GDB_ID.GRID), GDB_RT.GRID) DisableCommandLog() If nId <> GDB_ID.NULL Then Dim PtP As Point3d EgtEndPoint(nId, PtP) m_ptCont = PtP.Glob(GetCurrLayer()) Dim VtV As Vector3d EgtEndVector(nId, VtV) m_vtCont = VtV.Glob(GetCurrLayer()) End If EgtDraw() ' aggiorno stato m_nStep = 0 RaiseEvent UpdateUI(Me, True) Case Else m_nStep = 0 Return False End Select Return True End Function Private Sub DragArcCSE() If m_nStep = 2 Then EgtSetGeoLine(m_ptP1, m_ptLast) EgtDraw() ElseIf m_nStep = 3 Then EgtSetGeoLine(m_ptP1, m_ptLast) ' durante la creazione di oggetti il gruppo di Drag ha riferimento globale Dim nId As Integer = EgtGetFirstInGroup(m_Scene.GetDragGroup()) If EgtGetType(nId) <> GDB_TY.CRV_ARC Then EgtErase(nId) nId = GDB_ID.NULL End If If nId = GDB_ID.NULL Then EgtCreateArcC2PEx(m_Scene.GetDragGroup(), m_ptP1.Loc(GDB_ID.GRID), m_ptP2.Loc(GDB_ID.GRID), m_sepP2, m_nIdP2, m_ptLast.Loc(GDB_ID.GRID), GDB_RT.GRID) Else EgtModifyArcC2P(nId, m_ptLast.Loc(GDB_ID.GRID), GDB_RT.GRID) End If EgtDraw() End If End Sub Private Function ProcessArc3P() As Boolean Select Case m_nStep Case 0 ' deve esistere un gruppo corrente e devo poter creare il gruppo di drag If GetCurrLayer() = GDB_ID.NULL Or Not m_Scene.CreateDragGroup() Then Return False End If ' imposto stato a primo punto per Arc3P m_Scene.SetStatusSelPoint() m_nStep = 1 ' abilito dialogo RaiseEvent PrepareInputBox("ARC 3P", "Insert Start Point", "", False, False) m_nInpType = IBT.TY_POINT3D SetInputBoxPoint3d(m_ptCont) Case 1 m_ptP1 = m_ptLast m_nStep = 2 m_Scene.EnableDrag() RaiseEvent PrepareInputBox("ARC 3P", "Insert End Point", "", False, True) m_nInpType = IBT.TY_POINT3D Case 2 m_ptP2 = m_ptLast m_nStep = 3 m_Scene.EnableDrag() RaiseEvent PrepareInputBox("ARC 3P", "Insert Mid Point", "", False, True) m_nInpType = IBT.TY_POINT3D Case 3 ' reset scena m_Scene.ResetStatus(False) ' creo l'arco (i punti sono in globale) EnableCommandLog() Dim nId = EgtCreateArc3P(GetCurrLayer(), m_ptP1.Loc(GDB_ID.GRID), m_ptLast.Loc(GDB_ID.GRID), m_ptP2.Loc(GDB_ID.GRID), GDB_RT.GRID) DisableCommandLog() If nId <> GDB_ID.NULL Then m_ptCont = m_ptP2 Dim VtV As Vector3d EgtEndVector(nId, VtV) m_vtCont = VtV.Glob(GetCurrLayer()) End If EgtDraw() ' aggiorno stato m_nStep = 0 RaiseEvent UpdateUI(Me, True) Case Else m_nStep = 0 Return False End Select Return True End Function Private Sub DragArc3P() If m_nStep = 2 Then ' durante la creazione di oggetti il gruppo di Drag ha riferimento globale Dim nId As Integer = EgtGetFirstInGroup(m_Scene.GetDragGroup()) If nId = GDB_ID.NULL Then EgtCreateLine(m_Scene.GetDragGroup(), m_ptP1, m_ptLast, GDB_RT.GLOB) Else EgtModifyCurveEndPoint(nId, m_ptLast) End If EgtDraw() ElseIf m_nStep = 3 Then ' durante la creazione di oggetti il gruppo di Drag ha riferimento globale Dim nId As Integer = EgtGetFirstInGroup(m_Scene.GetDragGroup()) If EgtGetType(nId) <> GDB_TY.CRV_ARC Then EgtErase(nId) nId = GDB_ID.NULL End If If nId = GDB_ID.NULL Then ' creazione arco 3P, in alcuni casi crea una retta EgtCreateArc3P(m_Scene.GetDragGroup(), m_ptP1, m_ptLast, m_ptP2, GDB_RT.GLOB) Else ' se modifica arco 3P impossibile, provo con una retta If (Not EgtModifyArc3P(nId, m_ptLast, GDB_RT.GLOB) AndAlso (m_ptLast - m_ptP1) * (m_ptP2 - m_ptLast) > EPS_ZERO) Then EgtErase(nId) EgtCreateLine(m_Scene.GetDragGroup(), m_ptP1, m_ptP2, GDB_RT.GLOB) End If End If EgtDraw() End If End Sub Private Function ProcessArcPDP() As Boolean Select Case m_nStep Case 0 ' deve esistere un gruppo corrente e devo poter creare il gruppo di drag If GetCurrLayer() = GDB_ID.NULL Or Not m_Scene.CreateDragGroup() Then Return False End If ' imposto stato a primo punto per ArcPDP m_Scene.SetStatusSelPoint(True) m_nStep = 1 ' abilito dialogo RaiseEvent PrepareInputBox("ARC PDP", "Insert Start Point", "", False, False) m_nInpType = IBT.TY_POINT3D SetInputBoxPoint3d(m_ptCont) Case 1 m_ptP1 = m_ptLast m_vtLast = m_vtCont m_dAux = LEN_STD m_ptCont = m_ptLast m_Scene.SetStatusSelPoint(False) m_nStep = 2 m_Scene.DisableDrag() RaiseEvent PrepareInputBox("ARC PDP", "Insert Direction", "", False, True) m_nInpType = IBT.TY_DIRECTION m_dLast = GridAngFromGlobDir(m_vtLast) SetInputBoxDouble(m_dLast) EgtDisableModified() DragArcPDP() EgtEnableModified() Case 2 m_nStep = 3 m_Scene.EnableDrag() RaiseEvent PrepareInputBox("ARC PDP", "Insert End Point", "", False, True) m_nInpType = IBT.TY_POINT3D m_Scene.EnableTangentPoint() Case 3 ' reset scena m_Scene.ResetStatus(False) ' creo l'arco (i punti sono in globale) EnableCommandLog() Dim nId = EgtCreateArc2PDEx(GetCurrLayer(), m_ptP1.Loc(GDB_ID.GRID), m_ptLast.Loc(GDB_ID.GRID), m_sepLast, m_nIdLast, m_dLast, GDB_RT.GRID) ' se richiesta curva composita e creazione riuscita If m_bContinue And nId <> GDB_ID.NULL Then If m_nContinueId = GDB_ID.NULL Then m_nContinueId = EgtCreateCurveCompo(GetCurrLayer(), nId, True) nId = m_nContinueId Else If EgtAddCurveCompoCurve(m_nContinueId, nId, True) Then nId = m_nContinueId Else nId = GDB_ID.NULL End If End If End If DisableCommandLog() If nId <> GDB_ID.NULL Then m_ptCont = m_ptLast Dim VtV As Vector3d EgtEndVector(nId, VtV) m_vtCont = VtV.Glob(GetCurrLayer()) End If EgtDraw() ' aggiorno stato RaiseEvent UpdateUI(Me, True) ' se continuazione e creazione riuscita, vedo di continuare ... If m_bContinue And nId <> GDB_ID.NULL Then ContinueArcPDP() Else m_nStep = 0 End If Case Else m_nStep = 0 Return False End Select Return True End Function Private Sub DragArcPDP() If m_nStep = 2 Then ' durante la creazione di oggetti il gruppo di Drag ha riferimento globale Dim nId As Integer = EgtGetFirstInGroup(m_Scene.GetDragGroup()) If nId = GDB_ID.NULL Then ' creo la linea di direzione EgtCreateLinePDL(m_Scene.GetDragGroup(), m_ptP1.Loc(GDB_ID.GRID), m_dLast, m_dAux, GDB_RT.GRID) Else Dim ptP2 As Point3d = m_ptP1 + GlobDirFromGridAng(m_dLast) * m_dAux EgtModifyCurveEndPoint(nId, ptP2.Loc(GDB_ID.GRID), GDB_RT.GRID) End If EgtDraw() ElseIf m_nStep = 3 Then ' durante la creazione di oggetti il gruppo di Drag ha riferimento globale Dim nId As Integer = EgtGetFirstInGroup(m_Scene.GetDragGroup()) If EgtGetType(nId) <> GDB_TY.CRV_ARC Then EgtErase(nId) nId = GDB_ID.NULL End If ' se arco da creare If nId = GDB_ID.NULL Then ' creo l'arco (i punti sono in globale), in alcuni casi particolari crea una retta EgtCreateArc2PD(m_Scene.GetDragGroup(), m_ptP1.Loc(GDB_ID.GRID), m_ptLast.Loc(GDB_ID.GRID), m_dLast, GDB_RT.GRID) ' altrimenti da modificare Else ' determino il versore direzione iniziale Dim vtDirS As Vector3d = GlobDirFromGridAng(m_dLast) ' se modifica arco impossibile, provo con una retta If (Not EgtModifyCurveEndPoint(nId, m_ptLast.Loc(GDB_ID.GRID), GDB_RT.GRID) AndAlso (m_ptLast - m_ptP1) * vtDirS > EPS_ZERO) Then EgtErase(nId) EgtCreateLine(m_Scene.GetDragGroup(), m_ptP1.Loc(GDB_ID.GRID), m_ptLast.Loc(GDB_ID.GRID), GDB_RT.GRID) End If End If EgtDraw() End If End Sub Public Sub ContinueArcPDP() ' verifico di essere in modalità continua If Not m_bContinue Then Return End If ' pulisco m_Scene.ResetStatus(False) ' imposto per stato 1 di arco PDP m_nLastCmd = CMD.ARCPDP m_nStep = 1 m_Scene.CreateDragGroup() m_Scene.SetStatusSelPoint(True) m_ptLast = m_ptCont m_vtLast = m_vtCont ' processo stato 1 per essere sul 2 ProcessArcPDP() End Sub Private Function ProcessArcPVP() As Boolean Select Case m_nStep Case 0 ' deve esistere un gruppo corrente e devo poter creare il gruppo di drag If GetCurrLayer() = GDB_ID.NULL Or Not m_Scene.CreateDragGroup() Then Return False End If ' imposto stato a primo punto per Arc3P m_Scene.SetStatusSelPoint(True) m_nStep = 1 ' abilito dialogo RaiseEvent PrepareInputBox("ARC PVP", "Insert Start Point", "", False, False) m_nInpType = IBT.TY_POINT3D SetInputBoxPoint3d(m_ptCont) Case 1 m_ptP1 = m_ptLast m_vtLast = m_vtCont m_dAux = LEN_STD m_Scene.SetStatusSelPoint(False) m_nStep = 2 m_Scene.DisableDrag() RaiseEvent PrepareInputBox("ARC PVP", "Insert Direction Vector", "", False, True) m_nInpType = IBT.TY_VECTOR3D SetInputBoxVector3d(m_vtLast) EgtDisableModified() DragArcPVP() EgtEnableModified() Case 2 m_nStep = 3 m_Scene.EnableDrag() RaiseEvent PrepareInputBox("ARC PVP", "Insert End Point", "", False, True) m_nInpType = IBT.TY_POINT3D Case 3 ' reset scena m_Scene.ResetStatus(False) ' creo l'arco (i punti sono in globale) EnableCommandLog() Dim nId = EgtCreateArc2PV(GetCurrLayer(), m_ptP1.Loc(GDB_ID.GRID), m_ptLast.Loc(GDB_ID.GRID), m_vtLast.Loc(GDB_ID.GRID), GDB_RT.GRID) DisableCommandLog() If nId <> GDB_ID.NULL Then m_ptCont = m_ptLast Dim VtV As Vector3d EgtEndVector(nId, VtV) m_vtCont = VtV.Glob(GetCurrLayer()) End If EgtDraw() ' aggiorno stato m_nStep = 0 RaiseEvent UpdateUI(Me, True) Case Else m_nStep = 0 Return False End Select Return True End Function Private Sub DragArcPVP() If m_nStep = 2 Then ' durante la creazione di oggetti il gruppo di Drag ha riferimento globale Dim nId As Integer = EgtGetFirstInGroup(m_Scene.GetDragGroup()) If nId = GDB_ID.NULL Then ' creo la linea di direzione EgtCreateLinePVL(m_Scene.GetDragGroup(), m_ptP1.Loc(GDB_ID.GRID), m_vtLast.Loc(GDB_ID.GRID), m_dAux, GDB_RT.GRID) Else m_vtLast.Normalize() Dim ptP2 As Point3d = m_ptP1 + m_vtLast * m_dAux EgtModifyCurveEndPoint(nId, ptP2.Loc(GDB_ID.GRID), GDB_RT.GRID) End If EgtDraw() ElseIf m_nStep = 3 Then ' svuoto il gruppo di drag EgtEmptyGroup(m_Scene.GetDragGroup()) ' creo l'arco (i punti sono in globale), in alcuni casi particolari crea una retta EgtCreateArc2PV(m_Scene.GetDragGroup(), m_ptP1.Loc(GDB_ID.GRID), m_ptLast.Loc(GDB_ID.GRID), m_vtLast.Loc(GDB_ID.GRID), GDB_RT.GRID) EgtDraw() End If End Sub Private Function ProcessFillet() As Boolean Select Case m_nStep Case 0 ' deve esistere un gruppo corrente e devo poter creare il gruppo di drag If GetCurrLayer() = GDB_ID.NULL Or Not m_Scene.CreateDragGroup() Then Return False End If ' imposto stato a raggio per Fillet m_nStep = 1 ' abilito dialogo RaiseEvent PrepareInputBox("FILLET", "Insert Radius", "Trim", False, True) RaiseEvent SetInputBoxCheck(True) m_nInpType = IBT.TY_LENGTH m_dLast = m_dLastFillet SetInputBoxDouble(m_dLast, True) Case 1 ' reset scena m_Scene.ResetStatus(False) ' creo il fillet (i punti sono in globale) Dim nId1, nSub1, nId2, nSub2 As Integer Dim ptSel1, ptSel2 As Point3d EgtGetLastSelInfo( nId2, nSub2, ptSel2) EgtGetPrevSelInfo( nId1, nSub1, ptSel1) EnableCommandLog() EgtCreateCurveFillet(GetCurrLayer(), nId1, ptSel1.Loc(GDB_ID.GRID), nId2, ptSel2.Loc(GDB_ID.GRID), m_dLast, m_bLast, GDB_RT.GRID) DisableCommandLog() EgtDraw() ' aggiorno stato m_dLastFillet = m_dLast m_nStep = 0 RaiseEvent UpdateUI(Me, True) Case Else m_nStep = 0 Return False End Select Return True End Function Private Sub DragFillet() ' il gruppo di Drag ha riferimento globale If m_nStep = 1 Then ' svuoto il gruppo di drag EgtEmptyGroup(m_Scene.GetDragGroup()) ' inserisco le due curve nel gruppo di drag Dim nId1, nSub1, nId2, nSub2 As Integer Dim ptSel1, ptSel2 As Point3d EgtGetLastSelInfo( nId2, nSub2, ptSel2) EgtGetPrevSelInfo( nId1, nSub1, ptSel1) nId2 = m_Scene.AddToDragGroup(nId2) nId1 = m_Scene.AddToDragGroup(nId1) ' creo fillet (il gruppo di Drag ha riferimento globale) EgtCreateCurveFillet(m_Scene.GetDragGroup(), nId1, ptSel1.Loc(GDB_ID.GRID), nId2, ptSel2.Loc(GDB_ID.GRID), m_dLast, m_bLast, GDB_RT.GRID) EgtDraw() End If End Sub Private Function ProcessChamfer() As Boolean Select Case m_nStep Case 0 ' deve esistere un gruppo corrente e devo poter creare il gruppo di drag If GetCurrLayer() = GDB_ID.NULL Or Not m_Scene.CreateDragGroup() Then Return False End If ' imposto stato a raggio per Fillet m_nStep = 1 ' abilito dialogo RaiseEvent PrepareInputBox("CHAMFER", "Insert distance", "Trim", False, True) RaiseEvent SetInputBoxCheck(True) m_nInpType = IBT.TY_LENGTH m_dLast = m_dLastChamfer SetInputBoxDouble(m_dLast, True) Case 1 ' reset scena m_Scene.ResetStatus(False) ' creo il fillet (i punti sono in globale) Dim nId1, nSub1, nId2, nSub2 As Integer Dim ptSel1, ptSel2 As Point3d EgtGetLastSelInfo( nId2, nSub2, ptSel2) EgtGetPrevSelInfo( nId1, nSub1, ptSel1) EnableCommandLog() EgtCreateCurveChamfer(GetCurrLayer(), nId1, ptSel1.Loc(GDB_ID.GRID), nId2, ptSel2.Loc(GDB_ID.GRID), m_dLast, m_bLast, GDB_RT.GRID) DisableCommandLog() EgtDraw() ' aggiorno stato m_dLastChamfer = m_dLast m_nStep = 0 RaiseEvent UpdateUI(Me, True) Case Else m_nStep = 0 Return False End Select Return True End Function Private Sub DragChamfer() ' il gruppo di Drag ha riferimento globale If m_nStep = 1 Then ' svuoto il gruppo di drag EgtEmptyGroup(m_Scene.GetDragGroup()) ' inserisco le due curve nel gruppo di drag Dim nId1, nSub1, nId2, nSub2 As Integer Dim ptSel1, ptSel2 As Point3d EgtGetLastSelInfo( nId2, nSub2, ptSel2) EgtGetPrevSelInfo( nId1, nSub1, ptSel1) nId2 = m_Scene.AddToDragGroup( nId2) nId1 = m_Scene.AddToDragGroup( nId1) ' creo chamfer (il gruppo di Drag ha riferimento globale) EgtCreateCurveChamfer(m_Scene.GetDragGroup(), nId1, ptSel1.Loc(GDB_ID.GRID), nId2, ptSel2.Loc(GDB_ID.GRID), m_dLast, m_bLast, GDB_RT.GRID) EgtDraw() End If End Sub Private Function ProcessRectangle2P() As Boolean Select Case m_nStep Case 0 ' deve esistere un gruppo corrente e devo poter creare il gruppo di drag If GetCurrLayer() = GDB_ID.NULL Or Not m_Scene.CreateDragGroup() Then Return False End If ' imposto stato a primo punto per Rectangle2P m_Scene.SetStatusSelPoint() m_nStep = 1 ' abilito dialogo RaiseEvent PrepareInputBox("RECTANGLE 2P", "Insert Start Point", "", False, False) m_nInpType = IBT.TY_POINT3D SetInputBoxPoint3d(m_ptCont) Case 1 m_ptP1 = m_ptLast m_nStep = 2 RaiseEvent PrepareInputBox("RECTANGLE 2P", "Insert End Point", "", False, True) m_nInpType = IBT.TY_POINT3D SetInputBoxPoint3d(m_ptLast) Case 2 ' reset scena m_Scene.ResetStatus(False) ' creo il rettangolo (i punti sono in globale) EnableCommandLog() Dim nId As Integer = EgtCreateRectangle2P(GetCurrLayer(), m_ptP1.Loc(GDB_ID.GRID), m_ptLast.Loc(GDB_ID.GRID), GDB_RT.GRID) DisableCommandLog() EgtDraw() ' aggiorno stato m_nStep = 0 RaiseEvent UpdateUI(Me, True) Case Else m_nStep = 0 Return False End Select Return True End Function Private Sub DragRectangle2P() ' il gruppo di Drag ha riferimento globale If m_nStep = 2 Then ' recupero possibile entità già nel gruppo di drag Dim nId As Integer = EgtGetFirstInGroup(m_Scene.GetDragGroup()) EgtErase(nId) ' creo il rettangolo (drag è in globale) EgtCreateRectangle2P(m_Scene.GetDragGroup(), m_ptP1.Loc(GDB_ID.GRID), m_ptLast.Loc(GDB_ID.GRID), GDB_RT.GRID) EgtDraw() End If End Sub Private Function ProcessPolygon() As Boolean Select Case m_nStep Case 0 ' deve esistere un gruppo corrente e devo poter creare il gruppo di drag If GetCurrLayer() = GDB_ID.NULL Or Not m_Scene.CreateDragGroup() Then Return False End If ' imposto stato a numero lati per PolygonSide m_nStep = 1 m_Scene.SetStatusNull() ' abilito dialogo RaiseEvent PrepareInputBox("POLYGON", "Insert Side Nbr", "", False, False) m_nInpType = IBT.TY_INTEGER m_nLast = 3 SetInputBoxInteger(m_nLast) Case 1 m_Scene.SetStatusSelPoint() m_nStep = 2 RaiseEvent PrepareInputBox("POLYGON", "Insert Center Point", "Internal Radius", False, False) m_nInpType = IBT.TY_POINT3D SetInputBoxPoint3d(m_ptCont) RaiseEvent SetInputBoxCheck(False) Case 2 m_ptP1 = m_ptLast m_nStep = 3 RaiseEvent PrepareInputBox("POLYGON", "Insert Side Point", "Internal Radius", False, True) m_nInpType = IBT.TY_POINT3D SetInputBoxPoint3d(m_ptLast) Case 3 ' reset scena m_Scene.ResetStatus(False) ' creo il poligono (i punti sono in globale) EnableCommandLog() Dim nId As Integer = GDB_ID.NULL If Not m_bLast Then nId = EgtCreatePolygonFromRadius(GetCurrLayer(), m_nLast, m_ptP1.Loc(GDB_ID.GRID), m_ptLast.Loc(GDB_ID.GRID), GDB_RT.GRID) Else nId = EgtCreatePolygonFromApothem(GetCurrLayer(), m_nLast, m_ptP1.Loc(GDB_ID.GRID), m_ptLast.Loc(GDB_ID.GRID), GDB_RT.GRID) End If DisableCommandLog() EgtDraw() ' aggiorno stato m_nStep = 0 RaiseEvent UpdateUI(Me, True) Case Else m_nStep = 0 Return False End Select Return True End Function Private Sub DragPolygon() ' il gruppo di Drag ha riferimento globale If m_nStep = 3 Then EgtSetGeoLine(m_ptP1, m_ptLast) ' recupero possibile entità già nel gruppo di drag Dim nId As Integer = EgtGetFirstInGroup(m_Scene.GetDragGroup()) EgtErase(nId) ' creo il poligono (drag è in globale) If Not m_bLast Then EgtCreatePolygonFromRadius(m_Scene.GetDragGroup(), m_nLast, m_ptP1.Loc(GDB_ID.GRID), m_ptLast.Loc(GDB_ID.GRID), GDB_RT.GRID) Else EgtCreatePolygonFromApothem(m_Scene.GetDragGroup(), m_nLast, m_ptP1.Loc(GDB_ID.GRID), m_ptLast.Loc(GDB_ID.GRID), GDB_RT.GRID) End If EgtDraw() End If End Sub Private Function ProcessPolygonSide() As Boolean Select Case m_nStep Case 0 ' deve esistere un gruppo corrente e devo poter creare il gruppo di drag If GetCurrLayer() = GDB_ID.NULL Or Not m_Scene.CreateDragGroup() Then Return False End If ' imposto stato a numero lati per PolygonSide m_nStep = 1 m_Scene.SetStatusNull() ' abilito dialogo RaiseEvent PrepareInputBox("POLYGON SIDE", "Insert Side Nbr", "", False, False) m_nInpType = IBT.TY_INTEGER m_nLast = 3 SetInputBoxInteger(m_nLast) Case 1 m_Scene.SetStatusSelPoint() m_nStep = 2 RaiseEvent PrepareInputBox("POLYGON SIDE", "Insert Side Start Point", "", False, False) m_nInpType = IBT.TY_POINT3D SetInputBoxPoint3d(m_ptCont) Case 2 m_ptP1 = m_ptLast m_nStep = 3 RaiseEvent PrepareInputBox("POLYGON SIDE", "Insert Side End Point", "", False, True) m_nInpType = IBT.TY_POINT3D SetInputBoxPoint3d(m_ptLast) Case 3 ' reset scena m_Scene.ResetStatus(False) ' creo il poligono (i punti sono in globale) EnableCommandLog() Dim nId As Integer = EgtCreatePolygonFromSide(GetCurrLayer(), m_nLast, m_ptP1.Loc(GDB_ID.GRID), m_ptLast.Loc(GDB_ID.GRID), GDB_RT.GRID) DisableCommandLog() EgtDraw() ' aggiorno stato m_nStep = 0 RaiseEvent UpdateUI(Me, True) Case Else m_nStep = 0 Return False End Select Return True End Function Private Sub DragPolygonSide() ' il gruppo di Drag ha riferimento globale If m_nStep = 3 Then ' recupero possibile entità già nel gruppo di drag Dim nId As Integer = EgtGetFirstInGroup(m_Scene.GetDragGroup()) EgtErase(nId) ' creo il poligono (drag è in globale) EgtCreatePolygonFromSide(m_Scene.GetDragGroup(), m_nLast, m_ptP1.Loc(GDB_ID.GRID), m_ptLast.Loc(GDB_ID.GRID), GDB_RT.GRID) EgtDraw() End If End Sub Private Function ProcessText() As Boolean Select Case m_nStep Case 0 ' deve esistere un gruppo corrente e devo poter creare il gruppo di drag If GetCurrLayer() = GDB_ID.NULL Or Not m_Scene.CreateDragGroup() Then Return False End If ' imposto stato a primo punto per Text m_Scene.SetStatusSelPoint() m_nStep = 1 ' abilito dialogo RaiseEvent PrepareInputBox("TEXT", "Insert Start Point", "", False, False) m_nInpType = IBT.TY_POINT3D SetInputBoxPoint3d(m_ptCont) Case 1 m_ptP1 = m_ptLast m_nStep = 2 m_Scene.SetStatusNull() RaiseEvent PrepareInputBox("TEXT", "Insert Text", "", False, True) m_nInpType = IBT.TY_STRING m_sLast = String.Empty Case 2 m_nStep = 3 m_Scene.SetStatusNull() RaiseEvent PrepareInputBox("TEXT", "Insert Height", "", False, True) m_nInpType = IBT.TY_LENGTH m_dLast = m_dLastTextH SetInputBoxDouble(m_dLast, True) Case 3 ' reset scena m_Scene.ResetStatus(False) ' creo l'entità testo (i punti sono in globale) EnableCommandLog() Dim nId As Integer = EgtCreateText(GetCurrLayer(), m_ptP1.Loc(GDB_ID.GRID), m_sLast, m_dLast, GDB_RT.GRID) DisableCommandLog() EgtDraw() ' aggiorno stato m_dLastTextH = m_dLast m_nStep = 0 RaiseEvent UpdateUI(Me, True) Case Else m_nStep = 0 Return False End Select Return True End Function Private Sub DragText() ' il gruppo di Drag ha riferimento globale If m_nStep = 2 Then ' recupero possibile entità già nel gruppo di drag Dim nId As Integer = EgtGetFirstInGroup(m_Scene.GetDragGroup()) EgtErase(nId) ' creo il testo (drag è in globale) EgtCreateText(m_Scene.GetDragGroup(), m_ptP1.Loc(GDB_ID.GRID), m_sLast, m_dLastTextH, GDB_RT.GRID) EgtDraw() ElseIf m_nStep = 3 Then ' recupero possibile entità già nel gruppo di drag Dim nId As Integer = EgtGetFirstInGroup(m_Scene.GetDragGroup()) EgtErase(nId) ' creo il testo (drag è in globale) EgtCreateText(m_Scene.GetDragGroup(), m_ptP1.Loc(GDB_ID.GRID), m_sLast, m_dLast, GDB_RT.GRID) EgtDraw() End If End Sub Private Function ProcessTextPlus() As Boolean Select Case m_nStep Case 0 ' deve esistere un gruppo corrente e devo poter creare il gruppo di drag If GetCurrLayer() = GDB_ID.NULL Or Not m_Scene.CreateDragGroup() Then Return False End If ' imposto stato a primo punto per Text Plus m_Scene.SetStatusSelPoint() m_nStep = 1 ' abilito dialogo RaiseEvent PrepareInputBox("TEXT+", "Insert Start Point", "", False, False) m_nInpType = IBT.TY_POINT3D SetInputBoxPoint3d(m_ptCont) Case 1 m_ptP1 = m_ptLast m_nStep = 2 RaiseEvent PrepareInputBox("TEXT+", "Insert Dir Point", "", False, False) m_nInpType = IBT.TY_POINT3D Dim ptTemp As Point3d = m_ptP1 + New Vector3d(10, 0, 0) SetInputBoxPoint3d(ptTemp) Case 2 m_ptP2 = m_ptLast If Point3d.SameApprox(m_ptP1, m_ptP2) Then m_ptP2.x += 10 End If m_nStep = 3 m_Scene.SetStatusNull() RaiseEvent PrepareInputBox("TEXT+", "Insert Text", "", False, True) m_nInpType = IBT.TY_STRING m_sLast = String.Empty Case 3 m_nStep = 4 m_Scene.SetStatusNull() RaiseEvent PrepareInputBox("TEXT+", "Insert Height", "Italic", True, True) m_nInpType = IBT.TY_LENGTH m_dLast = m_dLastTextH SetInputBoxDouble(m_dLast, True) m_bLast = False RaiseEvent SetInputBoxCheck(m_bLast) LoadFonts() Dim sDefaultFont As String = String.Empty EgtGetDefaultFont(sDefaultFont) For i As Integer = 0 To m_sFonts.Count() - 1 Dim bSel = (String.Compare(m_sFonts(i), sDefaultFont, True) = 0) RaiseEvent AddInputBoxCombo(m_sFonts(i), bSel) Next Case 4 ' reset scena m_Scene.ResetStatus(False) ' determino il font Dim sFont As String = String.Empty If m_nLast >= 0 And m_nLast < m_sFonts.Count() Then sFont = m_sFonts(m_nLast) End If ' determino l'angolo di rotazione Dim vtDir As Vector3d = (m_ptP2 - m_ptP1).Loc(GDB_ID.GRID) Dim dLen, dAngVertDeg, dAngRotDeg As Double vtDir.ToSpherical(dLen, dAngVertDeg, dAngRotDeg) ' creo l'entità testo (i punti sono in globale) EnableCommandLog() Dim nId As Integer = EgtCreateTextEx(GetCurrLayer(), m_ptP1.Loc(GDB_ID.GRID), dAngRotDeg, m_sLast, sFont, m_bLast, m_dLast, GDB_RT.GRID) DisableCommandLog() EgtDraw() ' aggiorno stato m_dLastTextH = m_dLast m_nStep = 0 RaiseEvent UpdateUI(Me, True) Case Else m_nStep = 0 Return False End Select Return True End Function Private Sub DragTextPlus() ' il gruppo di Drag ha riferimento globale If m_nStep = 2 Then ' linea di base EgtSetGeoLine(m_ptP1, m_ptLast) ElseIf m_nStep = 3 Then ' linea di base EgtSetGeoLine(m_ptP1, m_ptP2) ' recupero possibile entità già nel gruppo di drag Dim nId As Integer = EgtGetFirstInGroup(m_Scene.GetDragGroup()) EgtErase(nId) ' determino l'angolo di rotazione Dim vtDir As Vector3d = (m_ptP2 - m_ptP1).Loc(GDB_ID.GRID) Dim dLen, dAngVertDeg, dAngRotDeg As Double vtDir.ToSpherical(dLen, dAngVertDeg, dAngRotDeg) ' creo il testo (drag è in globale) EgtCreateTextEx(m_Scene.GetDragGroup(), m_ptP1.Loc(GDB_ID.GRID), dAngRotDeg, m_sLast, "", False, m_dLastTextH, GDB_RT.GRID) EgtDraw() ElseIf m_nStep = 4 Then ' linea di base EgtSetGeoLine(m_ptP1, m_ptP2) ' recupero possibile entità già nel gruppo di drag Dim nId As Integer = EgtGetFirstInGroup(m_Scene.GetDragGroup()) EgtErase(nId) ' determino il font Dim sFont As String = String.Empty If m_nLast >= 0 And m_nLast < m_sFonts.Count() Then sFont = m_sFonts(m_nLast) End If ' determino l'angolo di rotazione Dim vtDir As Vector3d = (m_ptP2 - m_ptP1).Loc(GDB_ID.GRID) Dim dLen, dAngVertDeg, dAngRotDeg As Double vtDir.ToSpherical(dLen, dAngVertDeg, dAngRotDeg) ' creo il testo (drag è in globale) EgtCreateTextEx(m_Scene.GetDragGroup(), m_ptP1.Loc(GDB_ID.GRID), dAngRotDeg, m_sLast, sFont, m_bLast, m_dLast, GDB_RT.GRID) EgtDraw() End If End Sub Private Function ProcessRegion() As Boolean If m_nStep <> 0 Then Return False ' posso partire solo se esiste un gruppo corrente If GetCurrLayer() = GDB_ID.NULL Then Return False ' creo la regione piana (a partire da uno o più contorni selezionati) EnableCommandLog() ' creo vettore di entità selezionate Dim nCrvNum As Integer = 0 Dim nCrvIds(EgtGetSelectedObjCount() - 1) As Integer Dim nId As Integer = EgtGetFirstSelectedObj() While nId <> GDB_ID.NULL Select Case EgtGetType(nId) Case GDB_TY.CRV_LINE, GDB_TY.CRV_ARC, GDB_TY.CRV_BEZ, GDB_TY.CRV_COMPO nCrvIds(nCrvNum) = nId nCrvNum = nCrvNum + 1 End Select nId = EgtGetNextSelectedObj() End While ' creo la superficie EgtCreateSurfFlatRegion(GetCurrLayer(), nCrvIds) DisableCommandLog() ' reset stato scena m_Scene.ResetStatus() ' reset stato m_nStep = 0 RaiseEvent UpdateUI(Me, True) Return True End Function Private Function ProcessPlane() As Boolean If m_nStep <> 0 Then Return False End If ' posso partire solo se esiste un gruppo corrente If GetCurrLayer() = GDB_ID.NULL Then Return False End If ' creo la superficie piana (a partire da un contorno selezionato) EnableCommandLog() If EgtGetSelectedObjCount() = 1 Then EgtCreateSurfTmByFlatContour(GetCurrLayer(), EgtGetLastSelectedObj(), m_dEpsStm) Else ' creo vettore di entità selezionate Dim nCrvNum As Integer = 0 Dim nCrvIds(EgtGetSelectedObjCount() - 1) As Integer Dim nId As Integer = EgtGetFirstSelectedObj() While nId <> GDB_ID.NULL Select Case EgtGetType(nId) Case GDB_TY.CRV_LINE, GDB_TY.CRV_ARC, GDB_TY.CRV_BEZ, GDB_TY.CRV_COMPO nCrvIds(nCrvNum) = nId nCrvNum = nCrvNum + 1 End Select nId = EgtGetNextSelectedObj() End While ' creo la superficie EgtCreateSurfTmByRegion(GetCurrLayer(), nCrvIds, m_dEpsStm) End If DisableCommandLog() ' reset stato scena m_Scene.ResetStatus() ' reset stato m_nStep = 0 RaiseEvent UpdateUI(Me, True) Return True End Function Private Function ProcessExtrude() As Boolean Select Case m_nStep Case 0 ' deve esistere un gruppo corrente e devo poter creare il gruppo di drag If GetCurrLayer() = GDB_ID.NULL Or Not m_Scene.CreateDragGroup() Then Return False End If ' imposto stato a lunghezza di estrusione m_nStep = 1 m_Scene.SetStatusNull() ' abilito dialogo RaiseEvent PrepareInputBox("EXTRUSION", "Insert length", "CapEnds", False, True) RaiseEvent SetInputBoxCheck(m_bLastCapEndsCheck) m_nInpType = IBT.TY_LENGTH m_dLast = If(Math.Abs(m_dLastExtrude) > 10 * EPS_SMALL, m_dLastExtrude, 10 * EPS_SMALL) SetInputBoxDouble(m_dLast, True) EgtDisableModified() DragExtrude() EgtEnableModified() Case 1 ' reset scena m_Scene.ResetStatus(False) ' creo la superficie di estrusione (a partire da uno o più contorni selezionati) Dim VtExtr As Vector3d = Vector3d.Z_AX * m_dLast ' creo vettore di entità selezionate Dim nCrvNum As Integer = 0 Dim nCrvIds(EgtGetSelectedObjCount() - 1) As Integer Dim nId As Integer = EgtGetFirstSelectedObj() While nId <> GDB_ID.NULL Select Case EgtGetType(nId) Case GDB_TY.CRV_LINE, GDB_TY.CRV_ARC, GDB_TY.CRV_BEZ, GDB_TY.CRV_COMPO nCrvIds(nCrvNum) = nId nCrvNum = nCrvNum + 1 End Select nId = EgtGetNextSelectedObj() End While ' eseguo EnableCommandLog() If Not m_bLast Then EgtCreateSurfTmByExtrusion(GetCurrLayer(), nCrvNum, nCrvIds, VtExtr, m_dEpsStm, GDB_RT.GRID) Else EgtCreateSurfTmByRegionExtrusion(GetCurrLayer(), nCrvNum, nCrvIds, VtExtr, m_dEpsStm, GDB_RT.GRID) End If DisableCommandLog() ' aggiorno stato m_bLastCapEndsCheck = m_bLast m_dLastExtrude = m_dLast m_nStep = 0 RaiseEvent UpdateUI(Me, True) Case Else m_nStep = 0 Return False End Select Return True End Function Private Sub DragExtrude() If m_nStep = 1 Then ' cancello eventuale vecchia superficie di estrusione EgtEmptyGroup(m_Scene.GetDragGroup()) ' creo la superficie di estrusione (a partire da uno o più contorni selezionati) Dim VtExtr As Vector3d = EgtGetGridVersZ() * m_dLast Dim nCrvNum As Integer = 0 Dim nCrvIds(EgtGetSelectedObjCount() - 1) As Integer Dim nId As Integer = EgtGetFirstSelectedObj() While nId <> GDB_ID.NULL Select Case EgtGetType(nId) Case GDB_TY.CRV_LINE, GDB_TY.CRV_ARC, GDB_TY.CRV_BEZ, GDB_TY.CRV_COMPO nCrvIds(nCrvNum) = nId nCrvNum = nCrvNum + 1 End Select nId = EgtGetNextSelectedObj() End While ' eseguo If Not m_bLast Then EgtCreateSurfTmByExtrusion(m_Scene.GetDragGroup(), nCrvNum, nCrvIds, VtExtr, EPS_STM_DRAG, GDB_RT.GLOB) Else EgtCreateSurfTmByRegionExtrusion(m_Scene.GetDragGroup(), nCrvNum, nCrvIds, VtExtr, EPS_STM_DRAG, GDB_RT.GLOB) End If EgtDraw() End If End Sub Private Function ProcessRevolve() As Boolean Select Case m_nStep Case 0 ' deve esistere un gruppo corrente e devo poter creare il gruppo di drag If GetCurrLayer() = GDB_ID.NULL Or Not m_Scene.CreateDragGroup() Then Return False End If ' imposto stato a primo punto m_Scene.SetStatusSelPoint() m_nStep = 1 ' abilito dialogo RaiseEvent PrepareInputBox("REVOLVE", "Insert First Point on Axis", "CapEnds", False, False) RaiseEvent SetInputBoxCheck(False) m_nInpType = IBT.TY_POINT3D Case 1 m_ptP1 = m_ptLast m_nStep = 2 m_Scene.EnableDrag() RaiseEvent PrepareInputBox("REVOLVE", "Insert Second Point on Axis", "CapEnds", False, True) m_nInpType = IBT.TY_POINT3D Case 2 ' reset scena m_Scene.ResetStatus(False) ' creo la superficie di rivoluzione (i punti sono in globale) EnableCommandLog() Dim vtAx As Vector3d = m_ptLast - m_ptP1 EgtCreateSurfTmByRevolve(GetCurrLayer(), EgtGetLastSelectedObj(), m_ptP1.Loc(GDB_ID.GRID), vtAx.Loc(GDB_ID.GRID), m_bLast, m_dEpsStm, GDB_RT.GRID) DisableCommandLog() EgtDraw() ' aggiorno stato m_nStep = 0 RaiseEvent UpdateUI(Me, True) Case Else m_nStep = 0 Return False End Select Return True End Function Private Sub DragRevolve() If m_nStep = 2 Then EgtSetGeoLine(m_ptP1, m_ptLast) ' cancello eventuale vecchia superficie EgtEmptyGroup(m_Scene.GetDragGroup()) ' creo la superficie di rivoluzione (i punti sono in globale) Dim vtAx As Vector3d = m_ptLast - m_ptP1 EgtCreateSurfTmByRevolve(m_Scene.GetDragGroup(), EgtGetLastSelectedObj(), m_ptP1, vtAx, m_bLast, EPS_STM_DRAG, GDB_RT.GLOB) EgtDraw() End If End Sub Private Function ProcessScrew() As Boolean Select Case m_nStep Case 0 ' deve esistere un gruppo corrente e devo poter creare il gruppo di drag If GetCurrLayer() = GDB_ID.NULL Or Not m_Scene.CreateDragGroup() Then Return False End If ' imposto stato a primo punto m_Scene.SetStatusSelPoint() m_nStep = 1 ' abilito dialogo RaiseEvent PrepareInputBox("SCREW", "Insert First Point on Axis", "CapEnds", False, False) RaiseEvent SetInputBoxCheck(False) m_nInpType = IBT.TY_POINT3D Case 1 m_ptP1 = m_ptLast m_nStep = 2 m_Scene.EnableDrag() RaiseEvent PrepareInputBox("SCREW", "Insert Second Point on Axis", "CapEnds", False, False) m_nInpType = IBT.TY_POINT3D Case 2 m_ptP2 = m_ptLast m_nStep = 3 m_Scene.SetStatusNull() m_Scene.DisableDrag() RaiseEvent PrepareInputBox("SCREW", "Insert Angle", "CapEnds", False, True) m_nInpType = IBT.TY_DOUBLE m_dLast = 360 SetInputBoxDouble(m_dLast) Case 3 m_ptP2 = m_ptLast m_dPrev = m_dLast m_nStep = 4 m_Scene.SetStatusNull() m_Scene.DisableDrag() RaiseEvent PrepareInputBox("SCREW", "Insert Move", "CapEnds", False, True) m_nInpType = IBT.TY_LENGTH m_dLast = 0 SetInputBoxDouble(m_dLast, True) Case 4 ' reset scena m_Scene.ResetStatus(False) ' creo la superficie di rivoluzione (i punti sono in globale) EnableCommandLog() Dim vtAx As Vector3d = m_ptP2 - m_ptP1 EgtCreateSurfTmByScrewing(GetCurrLayer(), EgtGetLastSelectedObj(), m_ptP1.Loc(GDB_ID.GRID), vtAx.Loc(GDB_ID.GRID), m_dPrev, m_dLast, m_bLast, m_dEpsStm, GDB_RT.GRID) DisableCommandLog() EgtDraw() ' aggiorno stato m_nStep = 0 RaiseEvent UpdateUI(Me, True) Case Else m_nStep = 0 Return False End Select Return True End Function Private Sub DragScrew() If m_nStep = 2 Then EgtSetGeoLine(m_ptP1, m_ptLast) EgtDraw() ElseIf m_nStep = 3 Then EgtSetGeoLine(m_ptP1, m_ptP2) ' cancello eventuale vecchia superficie EgtErase(EgtGetFirstInGroup(m_Scene.GetDragGroup())) ' creo la superficie di rivoluzione (i punti sono in globale) Dim vtAx As Vector3d = m_ptP2 - m_ptP1 EgtCreateSurfTmByScrewing(m_Scene.GetDragGroup(), EgtGetLastSelectedObj(), m_ptP1, vtAx, m_dLast, 0, m_bLast, EPS_STM_DRAG, GDB_RT.GLOB) EgtDraw() ElseIf m_nStep = 4 Then EgtSetGeoLine(m_ptP1, m_ptP2) ' cancello eventuale vecchia superficie EgtErase(EgtGetFirstInGroup(m_Scene.GetDragGroup())) ' creo la superficie di rivoluzione (i punti sono in globale) Dim vtAx As Vector3d = m_ptP2 - m_ptP1 EgtCreateSurfTmByScrewing(m_Scene.GetDragGroup(), EgtGetLastSelectedObj(), m_ptP1, vtAx, m_dPrev, m_dLast, m_bLast, EPS_STM_DRAG, GDB_RT.GLOB) EgtDraw() End If End Sub Private Function ProcessSwept() As Boolean Select Case m_nStep Case 0 ' deve esistere un gruppo corrente e devo poter creare il gruppo di drag If GetCurrLayer() = GDB_ID.NULL Or Not m_Scene.CreateDragGroup() Then Return False ' imposto nuovo stato m_nStep = 1 ' abilito dialogo RaiseEvent PrepareInputBox("SWEPT", "", "CapEnds", False, True) RaiseEvent SetInputBoxCheck(m_bLastCapEndsCheck) m_nInpType = IBT.TY_NULL ' anteprima EgtDisableModified() DragSwept() EgtEnableModified() Case 1 ' creo la superficie swept (a partire da due contorni selezionati) EnableCommandLog() Dim nGuideId As Integer = EgtGetLastSelectedObj() Dim nSectId As Integer = EgtGetPrevSelectedObj() EgtCreateSurfTmSwept(GetCurrLayer(), nSectId, nGuideId, m_bLast, m_dEpsStm) DisableCommandLog() ' reset stato scena m_Scene.ResetStatus() ' reset stato m_nStep = 0 RaiseEvent UpdateUI(Me, True) Case Else m_nStep = 0 Return False End Select Return True End Function Private Sub DragSwept() If m_nStep = 1 Then ' cancello eventuale vecchia superficie di swept EgtEmptyGroup(m_Scene.GetDragGroup()) ' creo la superficie di swept (a partire dai contorni selezionati) Dim nGuideId As Integer = EgtGetLastSelectedObj() Dim nSectId As Integer = EgtGetPrevSelectedObj() ' eseguo EgtCreateSurfTmSwept(m_Scene.GetDragGroup(), nSectId, nGuideId, m_bLast, EPS_STM_DRAG) EgtDraw() End If End Sub Private Function ProcessRuled() As Boolean Select Case m_nStep Case 0 ' deve esistere un gruppo corrente e devo poter creare il gruppo di drag If GetCurrLayer() = GDB_ID.NULL Or Not m_Scene.CreateDragGroup() Then Return False ' imposto nuovo stato m_nStep = 1 ' abilito dialogo RaiseEvent PrepareInputBox("RULED", "", "MinDist", False, True) RaiseEvent SetInputBoxCheck(m_bLastRuledCheck) m_nInpType = IBT.TY_NULL ' anteprima EgtDisableModified() DragRuled() EgtEnableModified() Case 1 ' creo la superficie rigata (a partire da due contorni selezionati) EnableCommandLog() Dim nLastId As Integer = EgtGetLastSelectedObj() Dim nPrevId As Integer = EgtGetPrevSelectedObj() EgtCreateSurfTmRuled(GetCurrLayer(), nPrevId, nLastId, If( m_bLast, RUL_TYPE.MINDIST, RUL_TYPE.ISOPAR), m_dEpsStm) DisableCommandLog() ' aggiorno stato m_bLastRuledCheck = m_bLast ' reset stato scena m_Scene.ResetStatus() ' reset stato m_nStep = 0 RaiseEvent UpdateUI(Me, True) Case Else m_nStep = 0 Return False End Select Return True End Function Private Sub DragRuled() If m_nStep = 1 Then ' cancello eventuale vecchia superficie rigata EgtEmptyGroup(m_Scene.GetDragGroup()) ' creo la superficie rigata (a partire dai contorni selezionati) Dim nGuideId As Integer = EgtGetLastSelectedObj() Dim nSectId As Integer = EgtGetPrevSelectedObj() ' eseguo EgtCreateSurfTmRuled(m_Scene.GetDragGroup(), nSectId, nGuideId, If( m_bLast, RUL_TYPE.MINDIST, RUL_TYPE.ISOPAR), EPS_STM_DRAG) EgtDraw() End If End Sub Private Function ProcessMergeSurf() As Boolean If m_nStep <> 0 Then Return False End If ' creo vettore di superfici selezionate Dim nSurfNum As Integer = 0 Dim nSurfIds(EgtGetSelectedObjCount() - 1) As Integer Dim nId As Integer = EgtGetFirstSelectedObj() While nId <> GDB_ID.NULL Select Case EgtGetType(nId) Case GDB_TY.SRF_MESH nSurfIds(nSurfNum) = nId nSurfNum = nSurfNum + 1 End Select nId = EgtGetNextSelectedObj() End While ' lancio la combinazione delle superfici EnableCommandLog() If nSurfNum <= 10 Then EgtCreateSurfTmBySewing(GetCurrLayer(), nSurfNum, nSurfIds, True) Else EgtCreateSurfTmByTriangles(GetCurrLayer(), nSurfNum, nSurfIds, True) End If DisableCommandLog() ' reset stato scena m_Scene.ResetStatus() ' reset stato m_nStep = 0 RaiseEvent UpdateUI(Me, True) Return True End Function Private Function ProcessExplodeSurf() As Boolean If m_nStep <> 0 Then Return False End If ' opero su tutti gli oggetti selezionati EnableCommandLog() Dim nId As Integer = EgtGetFirstSelectedObj() While nId <> GDB_ID.NULL ' recupero il successivo, perchè il corrente verrà cancellato Dim nNextId = EgtGetNextSelectedObj() ' eseguo esplosione Dim nCount As Integer Dim nFirstId As Integer = EgtExplodeSurface(nId, nCount) ' passo al successivo nId = nNextId End While DisableCommandLog() ' reset stato scena m_Scene.ResetStatus() ' reset stato m_nStep = 0 RaiseEvent UpdateUI(Me, True) Return True End Function Private Function ProcessInvertSurf() As Boolean If m_nStep <> 0 Then Return False End If ' lancio l'inversione delle superfici EnableCommandLog() EgtInvertSurface( GDB_ID.SEL) DisableCommandLog() ' reset stato scena m_Scene.ResetStatus() ' reset stato m_nStep = 0 RaiseEvent UpdateUI(Me, False) Return True End Function Private Function ProcessExtractSurfLoops() As Boolean If m_nStep <> 0 Then Return False ' posso partire solo se esiste un gruppo corrente If GetCurrLayer() = GDB_ID.NULL Then Return False ' lancio l'estrazione dei contorni della superficie EnableCommandLog() Dim nCount As Integer = 0 EgtExtractSurfTmLoops( EgtGetLastSelectedObj(), GetCurrLayer(), nCount) DisableCommandLog() ' reset stato scena m_Scene.ResetStatus() ' reset stato m_nStep = 0 RaiseEvent UpdateUI(Me, True) Return True End Function Private Function ProcessExtractSurfFacetLoops() As Boolean If m_nStep <> 0 Then Return False ' posso partire solo se esiste un gruppo corrente If GetCurrLayer() = GDB_ID.NULL Then Return False ' lancio l'estrazione dei contorni della superficie EnableCommandLog() Dim nLastId, nLastSub As Integer Dim ptLastSel As Point3d EgtGetLastSelInfo( nLastId, nLastSub, ptLastSel) Dim nF As Integer = EgtSurfTmFacetFromTria(nLastId, nLastSub) If nF >= 0 Then Dim nCount As Integer = 0 EgtExtractSurfTmFacetLoops( nLastId, nF, GetCurrLayer(), nCount) End If DisableCommandLog() ' reset stato scena m_Scene.ResetStatus() ' reset stato m_nStep = 0 RaiseEvent UpdateUI(Me, True) Return True End Function Private Function ProcessAddSurf() As Boolean Select Case m_nStep Case 0 ' deve esistere un gruppo corrente e devo poter creare il gruppo di drag If GetCurrLayer() = GDB_ID.NULL Or Not m_Scene.CreateDragGroup() Then Return False ' imposto nuovo stato m_nStep = 1 ' abilito dialogo RaiseEvent PrepareInputBox("ADD SURF", "", "", False, False) m_nInpType = IBT.TY_NULL ' anteprima EgtDisableModified() DragAddSurf() EgtEnableModified() Case 1 ' eseguo l'unione delle due superfici EnableCommandLog() Dim nLastId As Integer = EgtGetLastSelectedObj() Dim nPrevId As Integer = EgtGetPrevSelectedObj() If EgtGetType( nPrevId) = GDB_TY.SRF_FRGN And EgtGetType( nLastId) = GDB_TY.SRF_FRGN Then EgtSurfFrAdd( nPrevId, nLastId) EgtErase( nLastId) ElseIf EgtGetType( nPrevId) = GDB_TY.SRF_MESH And EgtGetType( nLastId) = GDB_TY.SRF_MESH Then EgtSurfTmAdd( nPrevId, nLastId) EgtErase( nLastId) End If DisableCommandLog() ' reset stato scena m_Scene.ResetStatus() ' reset stato m_nStep = 0 RaiseEvent UpdateUI(Me, True) Case Else m_nStep = 0 Return False End Select Return True End Function Private Sub DragAddSurf() If m_nStep = 1 Then ' cancello eventuale vecchia superficie unione EgtEmptyGroup( m_Scene.GetDragGroup()) ' creo la superficie unione delle due superfici Dim nLastId As Integer = EgtGetLastSelectedObj() Dim nPrevId As Integer = EgtGetPrevSelectedObj() If EgtGetType( nPrevId) = GDB_TY.SRF_FRGN And EgtGetType( nLastId) = GDB_TY.SRF_FRGN Then Dim nDragId As Integer = EgtCopyGlob( nPrevId, m_Scene.GetDragGroup()) EgtSurfFrAdd( nDragId, nLastId) ElseIf EgtGetType( nPrevId) = GDB_TY.SRF_MESH And EgtGetType( nLastId) = GDB_TY.SRF_MESH Then Dim nDragId As Integer = EgtCopyGlob( nPrevId, m_Scene.GetDragGroup()) EgtSurfTmAdd( nDragId, nLastId) End If EgtDraw() End If End Sub Private Function ProcessSubtractSurf() As Boolean Select Case m_nStep Case 0 ' deve esistere un gruppo corrente e devo poter creare il gruppo di drag If GetCurrLayer() = GDB_ID.NULL Or Not m_Scene.CreateDragGroup() Then Return False ' imposto nuovo stato m_nStep = 1 ' abilito dialogo RaiseEvent PrepareInputBox("SUBTRACT SURF", "", "Erase tool", False, True) RaiseEvent SetInputBoxCheck( m_bLastBooleanCheck) m_nInpType = IBT.TY_NULL ' anteprima EgtDisableModified() DragAddSurf() EgtEnableModified() Case 1 ' eseguo la sottrazione delle due superfici EnableCommandLog() Dim nLastId As Integer = EgtGetLastSelectedObj() Dim nPrevId As Integer = EgtGetPrevSelectedObj() If EgtGetType( nPrevId) = GDB_TY.SRF_FRGN And EgtGetType( nLastId) = GDB_TY.SRF_FRGN Then EgtSurfFrSubtract( nPrevId, nLastId) If m_bLast Then EgtErase( nLastId) ElseIf EgtGetType( nPrevId) = GDB_TY.SRF_MESH And EgtGetType( nLastId) = GDB_TY.SRF_MESH Then EgtSurfTmSubtract( nPrevId, nLastId) If m_bLast Then EgtErase( nLastId) End If DisableCommandLog() ' salvo stato m_bLastBooleanCheck = m_bLast ' reset stato scena m_Scene.ResetStatus() ' reset stato m_nStep = 0 RaiseEvent UpdateUI(Me, True) Case Else m_nStep = 0 Return False End Select Return True End Function Private Sub DragSubtractSurf() If m_nStep = 1 Then ' cancello eventuale vecchia superficie differenza EgtEmptyGroup( m_Scene.GetDragGroup()) ' creo la superficie differenza delle due superfici Dim nLastId As Integer = EgtGetLastSelectedObj() Dim nPrevId As Integer = EgtGetPrevSelectedObj() If EgtGetType( nPrevId) = GDB_TY.SRF_FRGN And EgtGetType( nLastId) = GDB_TY.SRF_FRGN Then Dim nDragId As Integer = EgtCopyGlob( nPrevId, m_Scene.GetDragGroup()) EgtSurfFrSubtract( nDragId, nLastId) ElseIf EgtGetType( nPrevId) = GDB_TY.SRF_MESH And EgtGetType( nLastId) = GDB_TY.SRF_MESH Then Dim nDragId As Integer = EgtCopyGlob( nPrevId, m_Scene.GetDragGroup()) EgtSurfTmSubtract( nDragId, nLastId) End If EgtDraw() End If End Sub Private Function ProcessIntersectSurf() As Boolean Select Case m_nStep Case 0 ' deve esistere un gruppo corrente e devo poter creare il gruppo di drag If GetCurrLayer() = GDB_ID.NULL Or Not m_Scene.CreateDragGroup() Then Return False ' imposto nuovo stato m_nStep = 1 ' abilito dialogo RaiseEvent PrepareInputBox( "INTERSECT SURF", "", "Erase original", False, True) RaiseEvent SetInputBoxCheck( m_bLastBooleanCheck) m_nInpType = IBT.TY_NULL ' anteprima EgtDisableModified() DragAddSurf() EgtEnableModified() Case 1 ' eseguo l'intersezione delle due superfici EnableCommandLog() Dim nLastId As Integer = EgtGetLastSelectedObj() Dim nPrevId As Integer = EgtGetPrevSelectedObj() If EgtGetType( nPrevId) = GDB_TY.SRF_FRGN And EgtGetType( nLastId) = GDB_TY.SRF_FRGN Then EgtSurfFrIntersect( nPrevId, nLastId) If m_bLast Then EgtErase( nLastId) End If ElseIf EgtGetType( nPrevId) = GDB_TY.SRF_MESH And EgtGetType( nLastId) = GDB_TY.SRF_MESH Then EgtSurfTmIntersect( nPrevId, nLastId) If m_bLast Then EgtErase( nLastId) End If End If DisableCommandLog() ' salvo stato m_bLastBooleanCheck = m_bLast ' reset stato scena m_Scene.ResetStatus() ' reset stato m_nStep = 0 RaiseEvent UpdateUI(Me, True) Case Else m_nStep = 0 Return False End Select Return True End Function Private Sub DragIntersectSurf() If m_nStep = 1 Then ' cancello eventuale vecchia superficie intersezione EgtEmptyGroup( m_Scene.GetDragGroup()) ' creo la superficie intersezione delle due superfici Dim nLastId As Integer = EgtGetLastSelectedObj() Dim nPrevId As Integer = EgtGetPrevSelectedObj() If EgtGetType( nPrevId) = GDB_TY.SRF_FRGN And EgtGetType( nLastId) = GDB_TY.SRF_FRGN Then Dim nDragId As Integer = EgtCopyGlob( nPrevId, m_Scene.GetDragGroup()) EgtSurfFrIntersect( nDragId, nLastId) ElseIf EgtGetType( nPrevId) = GDB_TY.SRF_MESH And EgtGetType( nLastId) = GDB_TY.SRF_MESH Then Dim nDragId As Integer = EgtCopyGlob( nPrevId, m_Scene.GetDragGroup()) EgtSurfTmIntersect( nDragId, nLastId) End If EgtDraw() End If End Sub Private Function ProcessDelete() As Boolean If m_nStep <> 0 Then Return False End If If m_nLast <> GDB_ID.NULL Then EnableCommandLog() EgtErase(m_nLast) DisableCommandLog() ' reset m_Scene.ResetStatus() m_nStep = 0 RaiseEvent UpdateUI(Me, True) End If Return True End Function Private Function ProcessChangeLayer(bGlob As Boolean) As Boolean If m_nStep <> 0 Then Return False End If ' verifico ci sia qualcosa di selezionato Dim nId As Integer = EgtGetFirstSelectedObj() If nId = GDB_ID.NULL Then Return False ' verifico ci sia un layer corrente Dim nCurrLayerId As Integer = EgtGetCurrLayer() If nCurrLayerId = GDB_ID.NULL Then Return False ' il riferimento è il layer corrente Dim nRefId As Integer = nCurrLayerId ' la posizione è come ultimo figlio Dim nPos As GDB_POS = GDB_POS.LAST_SON ' ciclo di cambiamento layer (rilocazione) While nId <> GDB_ID.NULL EnableCommandLog() If bGlob Then EgtRelocateGlob(nId, nRefId, nPos) Else EgtRelocate(nId, nRefId, nPos) End If DisableCommandLog() nId = EgtGetNextSelectedObj() End While ' reset stato scena m_Scene.ResetStatus() ' reset stato m_nStep = 0 RaiseEvent UpdateUI(Me, True) Return True End Function Private Function ProcessChangeColor() As Boolean If m_nStep <> 0 Then Return False ' verifico ci sia qualcosa di selezionato Dim nId As Integer = EgtGetLastSelectedObj() If nId = GDB_ID.NULL Then Return False ' ne recupero il colore Dim colObj As Color3d EgtGetCalcColor(nId, colObj) ' lancio dialogo scelta colore If Not SelectColor(colObj, colObj) Then Return False ' assegno nuovo colore (tenendo alpha del vecchio) EnableCommandLog() EgtSetColor(GDB_ID.SEL, colObj, False) DisableCommandLog() ' reset stato scena m_Scene.ResetStatus() ' reset stato m_nStep = 0 RaiseEvent UpdateUI(Me, False) Return True End Function Private Function ProcessResetColor() As Boolean If m_nStep <> 0 Then Return False End If ' verifico ci sia qualcosa di selezionato Dim nId As Integer = EgtGetFirstSelectedObj() If nId = GDB_ID.NULL Then Return False End If ' reset colore EnableCommandLog() EgtResetColor(GDB_ID.SEL) DisableCommandLog() ' reset stato scena m_Scene.ResetStatus() ' reset stato m_nStep = 0 RaiseEvent UpdateUI(Me, False) Return True End Function Private Function ProcessChangeAlpha() As Boolean Select Case m_nStep Case 0 ' verifico ci sia qualcosa di selezionato Dim nId As Integer = EgtGetFirstSelectedObj() If nId = GDB_ID.NULL Then Return False End If ' imposto stato a cambio alpha (trasparenza) m_nStep = 1 m_Scene.SetStatusNull() ' abilito dialogo RaiseEvent PrepareInputBox("TRANSPARENCY", "Insert Alpha (10-100)", "", False, False) m_nInpType = IBT.TY_INTEGER ' recupero trasparenza dell'ultima entità selezionata Dim colObj As Color3d EgtGetCalcColor(EgtGetLastSelectedObj(), colObj) SetInputBoxInteger(colObj.A) Case 1 ' non accetto valori fuori dall'intervallo 10-100 a parte 0 If m_nLast <> 0 And m_nLast < 10 Then m_nLast = 10 ElseIf m_nLast > 100 Then m_nLast = 100 End If ' assegnazione trasparenza EnableCommandLog() EgtSetAlpha(GDB_ID.SEL, m_nLast) DisableCommandLog() ' reset stato scena m_Scene.ResetStatus() ' reset stato m_nStep = 0 RaiseEvent UpdateUI(Me, False) Case Else m_nStep = 0 Return False End Select Return True End Function Private Function ProcessInvertCurve() As Boolean If m_nStep <> 0 Then Return False End If ' lancio l'inversione delle curve e dei vettori EnableCommandLog() Dim vCrvId As New List(Of Integer) Dim vVecId As New List(Of Integer) Dim nId As Integer = EgtGetFirstSelectedObj() While nId <> GDB_ID.NULL Select Case EgtGetType(nId) Case GDB_TY.CRV_LINE, GDB_TY.CRV_ARC, GDB_TY.CRV_BEZ, GDB_TY.CRV_COMPO vCrvId.Add(nId) Case GDB_TY.GEO_VECTOR vVecId.Add(nId) End Select nId = EgtGetNextSelectedObj() End While If vCrvId.Count() > 0 Then EgtInvertCurve(vCrvId.ToArray()) If vVecId.Count() > 0 Then EgtInvertVector(vVecId.ToArray()) DisableCommandLog() ' reset stato scena m_Scene.ResetStatus() ' reset stato m_nStep = 0 RaiseEvent UpdateUI(Me, False) Return True End Function Private Function ProcessExtendCurve() As Boolean Select Case m_nStep Case 0 ' verifico condizioni e preparo per il drag If Not PrepareTransform(False) Then Return False End If EgtUnselectableAdd(EgtGetLastSelectedObj()) m_Scene.SetDragIntersForSelPoint(True) ' imposto stato a lunghezza di estensione m_nStep = 1 m_dLast = m_dLastExtend ' recupero dati estremo più vicino a punto di selezione per permettere drag lunghezza con mouse m_Scene.SetStatusSelPoint(False) Dim nId, nSub As Integer Dim ptLastSel As Point3d EgtGetLastSelInfo( nId, nSub, ptLastSel) EgtCurveLength(nId, m_dPrev) Dim bStart As Boolean = True EgtCurveNearestExtremityToPoint(nId, ptLastSel.Loc(nId), bStart) If bStart Then m_bLast = True m_ptP1 = ptLastSel EgtStartVector(nId, m_vtCont) m_vtCont = -m_vtCont.Glob(nId) Else m_bLast = False EgtEndPoint(nId, m_ptP1) m_ptP1 = ptLastSel EgtEndVector(nId, m_vtCont) m_vtCont = m_vtCont.Glob(nId) End If ' abilito dialogo RaiseEvent PrepareInputBox("TRIM-EXTEND", "Insert Length", "", False, True) m_nInpType = IBT.TY_SPECIALDOUBLE SetInputBoxDouble(m_dLast, True) EgtDisableModified() DragExtendCurve() EgtEnableModified() Case 1 ' eseguo estensione sull'estremo più vicino al punto di selezione Dim nId As Integer = EgtGetLastSelectedObj() EnableCommandLog() EgtTrimExtendCurveByLen(nId, m_dLast, m_ptP1.Loc(GDB_ID.GRID), GDB_RT.GRID) DisableCommandLog() ' reset stato scena m_Scene.ResetStatus() ' aggiorno stato m_dLastExtend = m_dLast m_nStep = 0 RaiseEvent UpdateUI(Me, False) Case Else m_nStep = 0 Return False End Select Return True End Function Private Function DragExtendCurve() As Boolean If m_nStep = 1 Then ' devo sempre partire dalla curva originale EgtEmptyGroup(m_Scene.GetDragGroup()) PrepareTransform(False) ' verifico se caso speciale : drag Dim bSpecial As Boolean = m_Scene.GetDragStatus() ' lunghezza aggiuntiva per caso speciale Dim dAddLen As Double = IIf(bSpecial, EXTEND_ADD, 0) ' eseguo trim/estensione sull'estremo più vicino al punto di selezione Dim nId As Integer = EgtGetFirstInGroup(m_Scene.GetDragGroup()) EgtTrimExtendCurveByLen(nId, m_dLast + dAddLen, m_ptP1, GDB_RT.GLOB) EgtDraw() End If Return False End Function Private Function ExecuteSpecialDataExtendCurve() As Boolean If m_nStep = 1 Then ' verifico se caso speciale : drag Dim bSpecial As Boolean = m_Scene.GetDragStatus() ' se standard If Not bSpecial Then m_dLast = (m_ptLast - m_ptP1) * m_vtCont ' altrimenti speciale Else Dim dLen As Double Dim nDragId As Integer = EgtGetFirstInGroup(m_Scene.GetDragGroup()) If EgtCurveLengthAtPoint(nDragId, m_ptLast.Loc(nDragId), EXTEND_BIG_ADD, dLen) Then ' modifico inizio (su drag inizio spostato di m_dLast) If m_bLast Then Dim dDragLen As Double EgtCurveLength(nDragId, dDragLen) m_dLast = dDragLen - dLen - m_dPrev ' modifico fine (inizio fisso) Else m_dLast = dLen - m_dPrev End If End If End If End If Return False End Function Private Function ProcessBreakCurve() As Boolean Select Case m_nStep Case 0 m_Scene.SetStatusSelPoint() ' imposto stato a punto per BreakCurve m_nStep = 1 ' abilito dialogo RaiseEvent PrepareInputBox("BREAK", "Insert Point on Curve", "", False, False) m_nInpType = IBT.TY_POINT3D Case 1 ' eseguo spezzatura Dim nId As Integer = EgtGetLastSelectedObj() EnableCommandLog() EgtSplitCurveAtPoint(nId, m_ptLast.Loc(GDB_ID.GRID), GDB_RT.GRID) EgtDeselectObj(nId) DisableCommandLog() ' reset stato scena m_Scene.ResetStatus() ' aggiorno stato m_nStep = 0 RaiseEvent UpdateUI(Me, True) Case Else m_nStep = 0 Return False End Select Return True End Function Private Function ProcessSplitCurve() As Boolean Select Case m_nStep Case 0 ' imposto stato a numero di pezzi m_nStep = 1 m_Scene.SetStatusNull() ' abilito dialogo RaiseEvent PrepareInputBox("SPLIT", "Insert Pieces Number", "", False, False) m_nInpType = IBT.TY_INTEGER m_nLast = 2 SetInputBoxInteger(m_nLast) Case 1 ' eseguo spezzatura in parti Dim nId As Integer = EgtGetLastSelectedObj() EnableCommandLog() EgtSplitCurve(nId, m_nLast) EgtDeselectObj(nId) DisableCommandLog() ' reset stato scena m_Scene.ResetStatus() ' aggiorno stato m_nStep = 0 RaiseEvent UpdateUI(Me, True) Case Else m_nStep = 0 Return False End Select Return True End Function Private Function ProcessJoinCurve() As Boolean If m_nStep <> 0 Then Return False End If ' posso partire solo se esiste un gruppo corrente If GetCurrLayer() = GDB_ID.NULL Then Return False End If ' creo la curva composita (concatenando le curve selezionate) EnableCommandLog() EgtCreateCurveCompoByChain(GetCurrLayer(), 1, {GDB_ID.SEL}, New Point3d, Not m_bLast, GDB_RT.GRID) DisableCommandLog() ' reset stato scena m_Scene.ResetStatus() ' reset stato m_nStep = 0 RaiseEvent UpdateUI(Me, True) Return True End Function Private Function ProcessExplodeCurve() As Boolean If m_nStep <> 0 Then Return False End If ' opero su tutti gli oggetti selezionati EnableCommandLog() Dim nId As Integer = EgtGetFirstSelectedObj() While nId <> GDB_ID.NULL ' recupero il successivo, perchè il corrente verrà cancellato Dim nNextId = EgtGetNextSelectedObj() ' eseguo esplosione Select Case EgtGetType(nId) Case GDB_TY.CRV_COMPO ' separo la curva composita nelle curve componenti Dim nCount As Integer Dim nFirstId As Integer = EgtExplodeCurveCompo(nId, nCount) Case GDB_TY.CRV_BEZ ' approssimo la curva di Bezier con archi Dim nNewId As Integer = EgtApproxCurve(nId, APP_TYPE.ARCS, 10 * EPS_SMALL) Case GDB_TY.EXT_TEXT ' esplodo il testo nei suoi contorni Dim nCount As Integer Dim nFirstId As Integer = EgtExplodeText(nId, nCount) End Select ' passo al successivo nId = nNextId End While DisableCommandLog() ' reset stato scena m_Scene.ResetStatus() ' reset stato m_nStep = 0 RaiseEvent UpdateUI(Me, True) Return True End Function Private Function ProcessChangeStartCurve() As Boolean Select Case m_nStep Case 0 m_Scene.SetStatusSelPoint() ' imposto stato a punto per Change Start Curve m_nStep = 1 ' abilito dialogo RaiseEvent PrepareInputBox("CHANGE START", "Insert Point on Curve", "", False, False) m_nInpType = IBT.TY_POINT3D Case 1 ' eseguo cambio inizio Dim nId As Integer = EgtGetLastSelectedObj() EnableCommandLog() EgtChangeClosedCurveStartPoint(nId, m_ptLast.Loc(GDB_ID.GRID), GDB_RT.GRID) EgtDeselectObj(nId) DisableCommandLog() ' reset stato scena m_Scene.ResetStatus() ' aggiorno stato m_nStep = 0 RaiseEvent UpdateUI(Me, False) Case Else m_nStep = 0 Return False End Select Return True End Function Private Function ProcessSetCurveThickness() As Boolean Select Case m_nStep Case 0 ' verifico condizioni e preparo per il drag If Not PrepareTransform() Then Return False End If ' imposto stato a impostazione spessore curva m_nStep = 1 m_Scene.SetStatusNull() ' abilito dialogo RaiseEvent PrepareInputBox("CURVE THICKNESS", "Insert Thickness", "Extrusion from CPlane", False, True) m_nInpType = IBT.TY_LENGTH ' recupero spessore dell'ultima entità selezionata Dim dThick As Double If EgtCurveThickness(EgtGetLastSelectedObj(), dThick) Then m_dLast = dThick Else m_dLast = 0 End If SetInputBoxDouble(m_dLast, True) RaiseEvent SetInputBoxCheck(False) Case 1 EnableCommandLog() ' se richiesto, imposto direzione estrusione If m_bLast Then EgtModifyCurveExtrusion(GDB_ID.SEL, Vector3d.Z_AX, GDB_RT.GRID) End If ' eseguo impostazione spessore curve selezionate EgtModifyCurveThickness(GDB_ID.SEL, m_dLast) DisableCommandLog() ' reset stato scena m_Scene.ResetStatus() ' aggiorno stato m_nStep = 0 RaiseEvent UpdateUI(Me, False) Case Else m_nStep = 0 Return False End Select Return True End Function Private Sub DragSetCurveThickness() If m_nStep = 1 Then ' imposto direzione estrusione da Z griglia If m_bLast Then EgtModifyCurveExtrusion(m_Scene.GetDragGroup(), EgtGetGridVersZ(), GDB_RT.GLOB) ' ripristino direzione estrusione originale Else ' ogni entità deve riprendere la sua propria estrusione originale Dim nId As Integer = EgtGetFirstInGroup(m_Scene.GetDragGroup()) While nId <> GDB_ID.NULL Dim nOrigId As Integer Dim vtOrigExtr As Vector3d If EgtGetInfo(nId, "Id", nOrigId) And EgtCurveExtrusion(nOrigId, vtOrigExtr) Then EgtModifyCurveExtrusion(nId, vtOrigExtr.Glob(nOrigId), GDB_RT.GLOB) End If nId = EgtGetNext(nId) End While End If ' eseguo impostazione spessore curve selezionate EgtModifyCurveThickness(m_Scene.GetDragGroup(), m_dLast) EgtDraw() End If End Sub Private Function ModifyText() As Boolean Select Case m_nStep Case 0 ' verifico condizioni e preparo per il drag Dim nId As Integer = EgtGetLastSelectedObj() If EgtGetType(nId) <> GDB_TY.EXT_TEXT Then Return False If Not PrepareTransform(False) Then Return False ' imposto stato a modifica testo m_nStep = 1 m_Scene.SetStatusNull() ' recupero il testo originale m_sLast = String.Empty EgtTextGetContent( nId, m_sLast) ' abilito dialogo RaiseEvent PrepareInputBox("MODIFY TEXT", "Modify Text", "", False, True) m_nInpType = IBT.TY_STRING SetInputBoxString(m_sLast) Case 1 m_nStep = 2 m_Scene.SetStatusNull() ' recupero gli attributi del testo Dim nId As Integer = EgtGetLastSelectedObj() Dim dH As Double = m_dLastTextH EgtTextGetHeight( nId, dH) Dim bItalic As Boolean = False EgtTextGetItalic( nId, bItalic) Dim sFont As String = string.Empty EgtTextGetFont( nId, sFont) if String.IsNullOrWhiteSpace( sFont) Then EgtGetDefaultFont( sFont) RaiseEvent PrepareInputBox("MODIFY TEXT", "Insert Height", "Italic", True, True) m_nInpType = IBT.TY_LENGTH m_dLast = dH SetInputBoxDouble(m_dLast, True) m_bLast = bItalic RaiseEvent SetInputBoxCheck(m_bLast) LoadFonts() For i As Integer = 0 To m_sFonts.Count() - 1 Dim bSel = (String.Compare(m_sFonts(i), sFont, True) = 0) RaiseEvent AddInputBoxCombo(m_sFonts(i), bSel) Next Case 2 ' reset scena m_Scene.ResetStatus(False) Dim nId As Integer = EgtGetLastSelectedObj() EnableCommandLog() ' modifico il contenuto del testo EgtModifyText( nId, m_sLast) ' modifico l'altezza EgtChangeTextHeight( nId, m_dLast) ' modifico il flag di italico EgtChangeTextItalic( nId, m_bLast) ' modifico il font Dim sFont As String = String.Empty If m_nLast >= 0 And m_nLast < m_sFonts.Count() Then sFont = m_sFonts(m_nLast) End If EgtChangeTextFont( nId, sFont) DisableCommandLog() EgtDraw() ' aggiorno stato m_dLastTextH = m_dLast m_nStep = 0 RaiseEvent UpdateUI(Me, True) Case Else m_nStep = 0 Return False End Select Return True End Function Private Sub DragModifyText() ' il gruppo di Drag ha riferimento globale If m_nStep = 1 Then ' recupero entità testo già nel gruppo di drag Dim nId As Integer = EgtGetFirstInGroup(m_Scene.GetDragGroup()) if nId = GDB_ID.NULL Then Return ' modifico il contenuto del testo EgtModifyText( nId, m_sLast) EgtDraw() ElseIf m_nStep = 2 Then ' recupero entità testo già nel gruppo di drag Dim nId As Integer = EgtGetFirstInGroup(m_Scene.GetDragGroup()) if nId = GDB_ID.NULL Then Return ' modifico l'altezza EgtChangeTextHeight( nId, m_dLast) ' modifico il flag di italico EgtChangeTextItalic( nId, m_bLast) ' modifico il font Dim sFont As String = String.Empty If m_nLast >= 0 And m_nLast < m_sFonts.Count() Then sFont = m_sFonts(m_nLast) End If EgtChangeTextFont( nId, sFont) EgtDraw() End If End Sub Private Function ProcessMove() As Boolean Select Case m_nStep Case 0 ' verifico condizioni e preparo per il drag If Not PrepareTransform() Then Return False End If m_Scene.SetStatusSelPoint() ' imposto stato a primo punto per Move m_nStep = 1 ' abilito dialogo "MOVE", "Insert Base Point", "Copy" RaiseEvent PrepareInputBox(EgtMsg(2402), EgtMsg(2403), EgtMsg(2001), False, False) m_nInpType = IBT.TY_POINT3D RaiseEvent SetInputBoxCheck(m_bLastTransfCheck) Case 1 m_ptP1 = m_ptLast m_nStep = 2 m_Scene.EnableDrag() ' abilito dialogo "MOVE", "Insert Target Point", "Copy" RaiseEvent PrepareInputBox(EgtMsg(2402), EgtMsg(2404), EgtMsg(2001), False, True) SetInputBoxPoint3d(m_ptLast) m_nInpType = IBT.TY_POINT3D Case 2 m_Scene.ResetStatus(False) EnableCommandLog() ' eseguo copia e movimento If m_bLast Then Dim nId As Integer = EgtGetFirstSelectedObj() While nId <> GDB_ID.NULL Dim nCopyId As Integer = EgtCopyGlob(nId, GetCurrLayer()) EgtMove(nCopyId, (m_ptLast - m_ptP1).Loc(GDB_ID.GRID), GDB_RT.GRID) nId = EgtGetNextSelectedObj() End While ' eseguo movimento Else EgtMove(GDB_ID.SEL, (m_ptLast - m_ptP1).Loc(GDB_ID.GRID), GDB_RT.GRID) End If DisableCommandLog() EgtDraw() ' aggiorno stato m_bLastTransfCheck = m_bLast m_nStep = 0 RaiseEvent UpdateUI(Me, True) Case Else m_nStep = 0 Return False End Select Return True End Function Private Sub DragMove() If m_nStep = 2 Then ' ripristino lo stato iniziale EgtChangeGroupFrame(m_Scene.GetDragGroup(), Frame3d.GLOB) ' eseguo tutto il movimento EgtMove(m_Scene.GetDragGroup(), (m_ptLast - m_ptP1), GDB_RT.GLOB) EgtSetGeoLine(m_ptP1, m_ptLast) EgtDraw() End If End Sub Private Function ProcessRotate() As Boolean Select Case m_nStep Case 0 ' verifico condizioni e preparo per il drag If Not PrepareTransform() Then Return False End If m_Scene.SetStatusSelPoint() ' imposto stato a primo punto per Rotate m_nStep = 1 ' abilito dialogo "ROTATE", "Insert Center", "Copy" RaiseEvent PrepareInputBox(EgtMsg(2406), EgtMsg(2407), EgtMsg(2001), False, False) m_nInpType = IBT.TY_POINT3D RaiseEvent SetInputBoxCheck(m_bLastTransfCheck) Case 1 m_ptP1 = m_ptLast m_nStep = 2 m_Scene.EnableDrag() ' abilito dialogo "ROTATE", "Insert Base Point", "Copy" RaiseEvent PrepareInputBox(EgtMsg(2406), EgtMsg(2408), EgtMsg(2001), False, False) m_nInpType = IBT.TY_POINT3D Case 2 If Point3d.SameApprox(m_ptP1, m_ptLast) Then RaiseEvent OutputInfo(Me, EgtMsg(2051)) ' Point must be different from previous Return False Else RaiseEvent OutputInfo(Me, "") End If m_ptP2 = m_ptLast m_nStep = 3 m_Scene.EnableDrag() EgtSetGeoLine(m_ptP1, m_ptLast) ' abilito dialogo "ROTATE", "Insert Angle or Rotation Point", "Copy" RaiseEvent PrepareInputBox(EgtMsg(2406), EgtMsg(2409), EgtMsg(2001), False, True) m_nInpType = IBT.TY_DOUBLE_OR_POINT3d Case 3 m_Scene.ResetStatus(False) ' calcolo parametri di rotazione If m_bPnt3dVsDbl Then Dim bDet As Boolean = True EgtGetVectorRotation((m_ptP2 - m_ptP1), (m_ptLast - m_ptP1), EgtGetGridVersZ(), m_dLast, bDet) End If EnableCommandLog() ' eseguo copia e rotazione If m_bLast Then Dim nId As Integer = EgtGetFirstSelectedObj() While nId <> GDB_ID.NULL Dim nCopyId As Integer = EgtCopyGlob(nId, GetCurrLayer()) EgtRotate(nCopyId, m_ptP1.Loc(GDB_ID.GRID), Vector3d.Z_AX, m_dLast, GDB_RT.GRID) nId = EgtGetNextSelectedObj() End While ' eseguo rotazione Else EgtRotate(GDB_ID.SEL, m_ptP1.Loc(GDB_ID.GRID), Vector3d.Z_AX, m_dLast, GDB_RT.GRID) End If DisableCommandLog() EgtDraw() ' aggiorno stato m_bLastTransfCheck = m_bLast m_nStep = 0 RaiseEvent UpdateUI(Me, True) Case Else m_nStep = 0 Return False End Select Return True End Function Private Sub DragRotate() If m_nStep = 2 Then EgtSetGeoLine(m_ptP1, m_ptLast) EgtDraw() ElseIf m_nStep = 3 Then ' ripristino lo stato iniziale EgtChangeGroupFrame(m_Scene.GetDragGroup(), Frame3d.GLOB) ' calcolo parametri rotazione If m_bPnt3dVsDbl Then Dim bDet As Boolean = True EgtGetVectorRotation((m_ptP2 - m_ptP1), (m_ptLast - m_ptP1), EgtGetGridVersZ(), m_dLast, bDet) Else m_ptLast = m_ptP2 m_ptLast.Rotate(m_ptP1, EgtGetGridVersZ(), m_dLast) End If ' aggiorno linea di drag EgtSetGeoLine(m_ptP1, m_ptLast, False) ' eseguo rotazione EgtRotate(m_Scene.GetDragGroup(), m_ptP1, EgtGetGridVersZ(), m_dLast, GDB_RT.GLOB) EgtDraw() End If End Sub Private Function ProcessRotate3D() As Boolean Select Case m_nStep Case 0 ' verifico condizioni e preparo per il drag If Not PrepareTransform() Then Return False End If m_Scene.SetStatusSelPoint() ' imposto stato a primo punto per Rotate3d m_nStep = 1 ' abilito dialogo "ROTATE 3D", "Insert First Point on Axis", "Copy" RaiseEvent PrepareInputBox(EgtMsg(2411), EgtMsg(2412), EgtMsg(2001), False, False) m_nInpType = IBT.TY_POINT3D RaiseEvent SetInputBoxCheck(m_bLastTransfCheck) Case 1 m_ptP1 = m_ptLast m_ptP2 = m_ptP1 m_nStep = 2 m_Scene.EnableDrag() ' abilito dialogo "ROTATE 3D", "Insert Second Point on Axis", "Copy" RaiseEvent PrepareInputBox(EgtMsg(2411), EgtMsg(2413), EgtMsg(2001), False, True) m_nInpType = IBT.TY_POINT3D Case 2 If Point3d.SameApprox(m_ptP1, m_ptLast) Then RaiseEvent OutputInfo(Me, EgtMsg(2051)) ' Point must be different from previous Return False Else RaiseEvent OutputInfo(Me, "") End If m_ptP2 = m_ptLast m_nStep = 3 m_Scene.EnableDrag() ' abilito dialogo "ROTATE 3D", "Insert Base Point", "Copy" RaiseEvent PrepareInputBox(EgtMsg(2411), EgtMsg(2414), EgtMsg(2001), False, True) m_nInpType = IBT.TY_DOUBLE Case 3 Dim VtNorm As Vector3d = (m_ptLast - m_ptP1) ^ (m_ptP2 - m_ptP1) If VtNorm.IsSmall() Then RaiseEvent OutputInfo(Me, EgtMsg(2052)) ' The points must be not aligned Return False Else RaiseEvent OutputInfo(Me, "") End If m_ptP3 = m_ptLast m_nStep = 4 m_Scene.EnableDrag() ' abilito dialogo "ROTATE 3D", "Insert Angle or Rotation Point", "Copy" RaiseEvent PrepareInputBox(EgtMsg(2411), EgtMsg(2415), EgtMsg(2001), False, True) m_nInpType = IBT.TY_DOUBLE_OR_POINT3d Case 4 m_Scene.ResetStatus(False) ' calcolo parametri di rotazione Dim VtAx As Vector3d = m_ptP2 - m_ptP1 If m_bPnt3dVsDbl Then Dim bDet As Boolean = True EgtGetVectorRotation((m_ptP3 - m_ptP1), (m_ptLast - m_ptP1), VtAx, m_dLast, bDet) Else m_ptLast = m_ptP3 m_ptLast.Rotate(m_ptP1, VtAx, m_dLast) End If EnableCommandLog() ' eseguo copia e rotazione If m_bLast Then Dim nId As Integer = EgtGetFirstSelectedObj() While nId <> GDB_ID.NULL Dim nCopyId As Integer = EgtCopyGlob(nId, GetCurrLayer()) EgtRotate(nCopyId, m_ptP1.Loc(GDB_ID.GRID), VtAx.Loc(GDB_ID.GRID), m_dLast, GDB_RT.GRID) nId = EgtGetNextSelectedObj() End While ' eseguo rotazione Else EgtRotate(GDB_ID.SEL, m_ptP1.Loc(GDB_ID.GRID), VtAx.Loc(GDB_ID.GRID), m_dLast, GDB_RT.GRID) End If DisableCommandLog() EgtDraw() ' aggiorno stato m_bLastTransfCheck = m_bLast m_nStep = 0 RaiseEvent UpdateUI(Me, True) Case Else m_nStep = 0 Return False End Select Return True End Function Private Sub DragRotate3D() If m_nStep = 2 Then EgtSetGeoLine(m_ptP1, m_ptLast) EgtDraw() ElseIf m_nStep = 3 Then EgtResetGeoLine(False) EgtSetGeoTria(m_ptP1, m_ptP2, m_ptLast) EgtDraw() ElseIf m_nStep = 4 Then ' ripristino lo stato iniziale EgtChangeGroupFrame(m_Scene.GetDragGroup(), Frame3d.GLOB) ' calcolo parametri rotazione Dim VtAx As Vector3d = m_ptP2 - m_ptP1 If m_bPnt3dVsDbl Then Dim bDet As Boolean = True EgtGetVectorRotation((m_ptP3 - m_ptP1), (m_ptLast - m_ptP1), VtAx, m_dLast, bDet) Else m_ptLast = m_ptP3 m_ptLast.Rotate(m_ptP1, VtAx, m_dLast) End If ' aggiorno triangolo di drag EgtSetGeoTria(m_ptP1, m_ptP2, m_ptLast, False) ' eseguo rotazione EgtRotate(m_Scene.GetDragGroup(), m_ptP1, VtAx, m_dLast, GDB_RT.GLOB) EgtDraw() End If End Sub Private Function ProcessMirror() As Boolean Select Case m_nStep Case 0 ' verifico condizioni e preparo per il drag If Not PrepareTransform() Then Return False End If m_Scene.SetStatusSelPoint() ' imposto stato a primo punto per Mirror m_nStep = 1 ' abilito dialogo "MIRROR", "Insert First Point", "Copy" RaiseEvent PrepareInputBox(EgtMsg(2416), EgtMsg(2417), EgtMsg(2001), False, False) m_nInpType = IBT.TY_POINT3D RaiseEvent SetInputBoxCheck(m_bLastTransfCheck) Case 1 m_ptP1 = m_ptLast m_ptP2 = m_ptP1 m_nStep = 2 m_Scene.EnableDrag() ' abilito dialogo "MIRROR", "Insert Second Point", "Copy" RaiseEvent PrepareInputBox(EgtMsg(2416), EgtMsg(2418), EgtMsg(2001), False, True) m_nInpType = IBT.TY_POINT3D Case 2 If Point3d.SameApprox(m_ptP1, m_ptLast) Then RaiseEvent OutputInfo(Me, EgtMsg(2051)) ' Point must be different from previous Return False Else RaiseEvent OutputInfo(Me, "") End If m_Scene.ResetStatus(False) ' esecuzione Dim VtNorm As Vector3d = (m_ptLast - m_ptP1) ^ EgtGetGridVersZ() If VtNorm.Len > EPS_SMALL Then EnableCommandLog() ' eseguo copia e mirror If m_bLast Then Dim nId As Integer = EgtGetFirstSelectedObj() While nId <> GDB_ID.NULL Dim nCopyId As Integer = EgtCopyGlob(nId, GetCurrLayer()) EgtMirror(nCopyId, m_ptP1.Loc(GDB_ID.GRID), VtNorm.Loc(GDB_ID.GRID), GDB_RT.GRID) nId = EgtGetNextSelectedObj() End While ' eseguo mirror Else EgtMirror(GDB_ID.SEL, m_ptP1.Loc(GDB_ID.GRID), VtNorm.Loc(GDB_ID.GRID), GDB_RT.GRID) End If DisableCommandLog() End If EgtDraw() ' aggiorno stato m_bLastTransfCheck = m_bLast m_nStep = 0 RaiseEvent UpdateUI(Me, True) Case Else m_nStep = 0 Return False End Select Return True End Function Private Sub DragMirror() If m_nStep = 2 Then ' linea di mirror EgtSetGeoLine(m_ptP1, m_ptLast) ' ripristino lo stato iniziale, tramite annullo mirror precedente Dim VtNorm As Vector3d = (m_ptP2 - m_ptP1) ^ EgtGetGridVersZ() If VtNorm.Len > EPS_SMALL Then EgtMirror(m_Scene.GetDragGroup(), m_ptP1, VtNorm, GDB_RT.GLOB) End If ' eseguo mirror VtNorm = (m_ptLast - m_ptP1) ^ EgtGetGridVersZ() If VtNorm.Len > EPS_SMALL Then EgtMirror(m_Scene.GetDragGroup(), m_ptP1, VtNorm, GDB_RT.GLOB) RaiseEvent OutputInfo(Me, "") Else RaiseEvent OutputInfo(Me, EgtMsg(2051)) ' Point must be different from previous End If ' salvo il punto m_ptP2 = m_ptLast EgtDraw() End If End Sub Private Function ProcessMirror3D() As Boolean Select Case m_nStep Case 0 ' verifico condizioni e preparo per il drag If Not PrepareTransform() Then Return False End If m_Scene.SetStatusSelPoint() ' imposto stato a primo punto per Mirror m_nStep = 1 ' abilito dialogo "MIRROR 3D", "Insert First Point", "Copy" RaiseEvent PrepareInputBox(EgtMsg(2421), EgtMsg(2422), EgtMsg(2001), False, False) m_nInpType = IBT.TY_POINT3D RaiseEvent SetInputBoxCheck(m_bLastTransfCheck) Case 1 m_ptP1 = m_ptLast m_ptP2 = m_ptP1 m_nStep = 2 m_Scene.EnableDrag() ' abilito dialogo "MIRROR 3D", "Insert Second Point", "Copy" RaiseEvent PrepareInputBox(EgtMsg(2421), EgtMsg(2423), EgtMsg(2001), False, True) m_nInpType = IBT.TY_POINT3D Case 2 If Point3d.SameApprox(m_ptP1, m_ptLast) Then RaiseEvent OutputInfo(Me, EgtMsg(2051)) ' The Point must be different from previous Return False Else RaiseEvent OutputInfo(Me, "") End If m_ptP2 = m_ptLast m_ptP3 = m_ptP2 m_nStep = 3 m_Scene.EnableDrag() ' abilito dialogo "MIRROR 3D", "Insert Third Point", "Copy" RaiseEvent PrepareInputBox(EgtMsg(2421), EgtMsg(2424), EgtMsg(2001), False, True) m_nInpType = IBT.TY_POINT3D Case 3 Dim VtNorm As Vector3d = (m_ptLast - m_ptP1) ^ (m_ptP2 - m_ptP1) If VtNorm.IsSmall() Then RaiseEvent OutputInfo(Me, EgtMsg(2052)) ' The points must be not aligned Return False Else RaiseEvent OutputInfo(Me, "") End If m_Scene.ResetStatus(False) ' esecuzione If Not VtNorm.IsSmall() Then EnableCommandLog() ' eseguo copia e mirror If m_bLast Then Dim nId As Integer = EgtGetFirstSelectedObj() While nId <> GDB_ID.NULL Dim nCopyId As Integer = EgtCopyGlob(nId, GetCurrLayer()) EgtMirror(nCopyId, m_ptP1.Loc(GDB_ID.GRID), VtNorm.Loc(GDB_ID.GRID), GDB_RT.GRID) nId = EgtGetNextSelectedObj() End While ' eseguo mirror Else EgtMirror(GDB_ID.SEL, m_ptP1.Loc(GDB_ID.GRID), VtNorm.Loc(GDB_ID.GRID), GDB_RT.GRID) End If DisableCommandLog() End If EgtDraw() ' aggiorno stato m_bLastTransfCheck = m_bLast m_nStep = 0 RaiseEvent UpdateUI(Me, True) Case Else m_nStep = 0 Return False End Select Return True End Function Private Sub DragMirror3D() If m_nStep = 2 Then ' linea di mirror EgtSetGeoLine(m_ptP1, m_ptLast) ElseIf m_nStep = 3 Then ' triangolo di mirror EgtResetGeoLine() EgtSetGeoTria(m_ptP1, m_ptP2, m_ptLast) ' ripristino lo stato iniziale, tramite undo di mirror precedente Dim VtNorm As Vector3d = (m_ptP3 - m_ptP1) ^ (m_ptP2 - m_ptP1) If VtNorm.Len > EPS_SMALL Then EgtMirror(m_Scene.GetDragGroup(), m_ptP1, VtNorm, GDB_RT.GLOB) End If ' eseguo mirror VtNorm = (m_ptLast - m_ptP1) ^ (m_ptP2 - m_ptP1) If VtNorm.Len > EPS_SMALL Then EgtMirror(m_Scene.GetDragGroup(), m_ptP1, VtNorm, GDB_RT.GLOB) End If ' salvo il punto m_ptP3 = m_ptLast EgtDraw() End If End Sub Private Function ProcessScale() As Boolean Select Case m_nStep Case 0 ' verifico condizioni e preparo per il drag If Not PrepareTransform() Then Return False End If m_Scene.SetStatusSelPoint() ' imposto stato a primo punto per Rotate m_nStep = 1 ' abilito dialogo "SCALE", "Insert Center", "Copy" RaiseEvent PrepareInputBox(EgtMsg(2426), EgtMsg(2427), EgtMsg(2001), False, False) m_nInpType = IBT.TY_POINT3D RaiseEvent SetInputBoxCheck(m_bLastTransfCheck) Case 1 m_ptP1 = m_ptLast m_dPrev = 1 m_dLast = 1 m_nStep = 2 m_Scene.SetStatusNull() ' abilito dialogo "SCALE", "Insert Factor", "Copy" RaiseEvent PrepareInputBox(EgtMsg(2426), EgtMsg(2428), EgtMsg(2001), False, True) m_nInpType = IBT.TY_DOUBLE SetInputBoxDouble(m_dLast) Case 2 If m_dLast < EPS_SMALL Then RaiseEvent OutputInfo(Me, EgtMsg(2053)) ' Zero or Negative Values not allowed Return False Else RaiseEvent OutputInfo(Me, "") End If m_Scene.ResetStatus(False) EnableCommandLog() ' eseguo copia e scalatura If m_bLast Then Dim nId As Integer = EgtGetFirstSelectedObj() While nId <> GDB_ID.NULL Dim nCopyId As Integer = EgtCopyGlob(nId, GetCurrLayer()) EgtScale(nCopyId, New Frame3d(m_ptP1.Loc(GDB_ID.GRID)), m_dLast, m_dLast, m_dLast, GDB_RT.GRID) nId = EgtGetNextSelectedObj() End While ' eseguo scalatura Else EgtScale(GDB_ID.SEL, New Frame3d(m_ptP1.Loc(GDB_ID.GRID)), m_dLast, m_dLast, m_dLast, GDB_RT.GRID) End If DisableCommandLog() EgtDraw() ' aggiorno stato m_bLastTransfCheck = m_bLast m_nStep = 0 RaiseEvent UpdateUI(Me, True) Case Else m_nStep = 0 Return False End Select Return True End Function Private Sub DragScale() If m_nStep = 2 Then If m_dLast < EPS_SMALL Then RaiseEvent OutputInfo(Me, EgtMsg(2053)) ' Zero or Negative Values not allowed Return Else RaiseEvent OutputInfo(Me, "") End If ' calcolo parametri di scalatura Dim frScale As New Frame3d(EgtGetGridFrame()) frScale.ChangeOrigin(m_ptP1) Dim dScale As Double = m_dLast / m_dPrev ' eseguo scalatura EgtScale(m_Scene.GetDragGroup(), frScale, dScale, dScale, dScale, GDB_RT.GLOB) m_dPrev = m_dLast EgtDraw() End If End Sub Private Function ProcessScale3D() As Boolean Select Case m_nStep Case 0 ' verifico condizioni e preparo per il drag If Not PrepareTransform() Then Return False End If m_Scene.SetStatusSelPoint() ' imposto stato a primo punto per Rotate m_nStep = 1 ' abilito dialogo "SCALE 3D", "Insert Center", "Copy" RaiseEvent PrepareInputBox(EgtMsg(2431), EgtMsg(2432), EgtMsg(2001), False, False) m_nInpType = IBT.TY_POINT3D RaiseEvent SetInputBoxCheck(m_bLastTransfCheck) Case 1 m_ptP1 = m_ptLast m_d3Prev(0) = 1 m_d3Prev(1) = 1 m_d3Prev(2) = 1 m_d3Last(0) = 1 m_d3Last(1) = 1 m_d3Last(2) = 1 m_nStep = 2 m_Scene.SetStatusNull() m_Scene.DisableDrag() ' abilito dialogo "SCALE 3D", "Insert Factors", "Copy" RaiseEvent PrepareInputBox(EgtMsg(2431), EgtMsg(2433), EgtMsg(2001), False, True) m_nInpType = IBT.TY_3DOUBLE SetInputBox3Double(m_d3Last) Case 2 If m_d3Last(0) < 0 Or m_d3Last(1) < 0 Or m_d3Last(2) < 0 Or (m_d3Last(0) < EPS_SMALL And m_d3Last(1) < EPS_SMALL) Or (m_d3Last(0) < EPS_SMALL And m_d3Last(2) < EPS_SMALL) Or (m_d3Last(1) < EPS_SMALL And m_d3Last(2) < EPS_SMALL) Then RaiseEvent OutputInfo(Me, EgtMsg(2054)) ' Two Zero or Negative Values not allowed Return False Else RaiseEvent OutputInfo(Me, "") End If m_Scene.ResetStatus(False) EnableCommandLog() ' eseguo copia e scalatura If m_bLast Then Dim nId As Integer = EgtGetFirstSelectedObj() While nId <> GDB_ID.NULL Dim nCopyId As Integer = EgtCopyGlob(nId, GetCurrLayer()) EgtScale(nCopyId, New Frame3d(m_ptP1.Loc(GDB_ID.GRID)), m_d3Last(0), m_d3Last(1), m_d3Last(2), GDB_RT.GRID) nId = EgtGetNextSelectedObj() End While ' eseguo scalatura Else Dim bOk = EgtScale(GDB_ID.SEL, New Frame3d(m_ptP1.Loc(GDB_ID.GRID)), m_d3Last(0), m_d3Last(1), m_d3Last(2), GDB_RT.GRID) If Not bOk Then ' "Some entities are not scalable" "Warning" MessageBox.Show(EgtMsg(2055), EgtMsg(2003), MessageBoxButtons.OK, MessageBoxIcon.Warning) End If End If DisableCommandLog() EgtDraw() ' aggiorno stato m_bLastTransfCheck = m_bLast m_nStep = 0 RaiseEvent UpdateUI(Me, True) Case Else m_nStep = 0 Return False End Select Return True End Function Private Sub DragScale3D() If m_nStep = 2 Then If m_d3Last(0) < 0 Or m_d3Last(1) < 0 Or m_d3Last(2) < 0 Or (m_d3Last(0) < EPS_SMALL And m_d3Last(1) < EPS_SMALL) Or (m_d3Last(0) < EPS_SMALL And m_d3Last(2) < EPS_SMALL) Or (m_d3Last(1) < EPS_SMALL And m_d3Last(2) < EPS_SMALL) Then RaiseEvent OutputInfo(Me, EgtMsg(2054)) ' Two Zero or Negative Values not allowed Return Else RaiseEvent OutputInfo(Me, "") End If ' se uno dei tre precedenti coefficienti era nullo, devo ricreare il gruppo di drag If m_d3Prev(0) < EPS_SMALL Or m_d3Prev(1) < EPS_SMALL Or m_d3Prev(2) < EPS_SMALL Then m_Scene.EraseDragGroup() PrepareTransform() m_d3Prev(0) = 1 m_d3Prev(1) = 1 m_d3Prev(2) = 1 End If ' calcolo parametri di scalatura Dim frScale As New Frame3d(EgtGetGridFrame()) frScale.ChangeOrigin(m_ptP1) Dim d3Scale(2) As Double d3Scale(0) = m_d3Last(0) / m_d3Prev(0) d3Scale(1) = m_d3Last(1) / m_d3Prev(1) d3Scale(2) = m_d3Last(2) / m_d3Prev(2) ' eseguo scalatura Dim bOk = EgtScale(m_Scene.GetDragGroup(), frScale, d3Scale(0), d3Scale(1), d3Scale(2), GDB_RT.GLOB) If bOk Then m_d3Prev(0) = m_d3Last(0) m_d3Prev(1) = m_d3Last(1) m_d3Prev(2) = m_d3Last(2) Else RaiseEvent OutputInfo(Me, EgtMsg(2055)) ' Some entities are not scalable ' forzo ripartenza da zero su prossimo drag m_d3Prev(0) = 0 m_d3Prev(1) = 0 m_d3Prev(2) = 0 End If EgtDraw() End If End Sub Private Function ProcessOffset() As Boolean Select Case m_nStep Case 0 ' verifico condizioni e preparo per il drag If Not PrepareTransform(False) Then Return False End If ' imposto stato a lunghezza di offset m_nStep = 1 m_dLast = m_dLastOffset m_dPrev = m_dLast m_Scene.SetStatusSelPoint(False) ' abilito dialogo "OFFSET", "Insert Distance", "Copy" RaiseEvent PrepareInputBox(EgtMsg(2436), EgtMsg(2437), EgtMsg(2001), True, True) m_nInpType = IBT.TY_SPECIALDOUBLE SetInputBoxDouble(m_dLast, True) RaiseEvent SetInputBoxCheck(m_bLastOffsetCheck) RaiseEvent AddInputBoxCombo(EgtMsg(2438), True) ' Fillet RaiseEvent AddInputBoxCombo(EgtMsg(2439), False) ' Chamfer RaiseEvent AddInputBoxCombo(EgtMsg(2440), False) ' Extend EgtDraw() Case 1 ' reset stato scena m_Scene.ResetStatus(False) EnableCommandLog() ' eseguo offset con copia Dim nCount As Integer If m_bLast Then EgtOffsetCurveAdv(EgtGetLastSelectedObj(), m_dLast, m_nLast, nCount) ' altrimenti solo offset Else Dim nId As Integer = EgtGetLastSelectedObj() Dim bOk = EgtOffsetCurveAdv(nId, m_dLast, m_nLast, nCount) If nCount > 0 Then EgtErase(nId) End If End If DisableCommandLog() EgtDraw() ' aggiorno stato m_bLastOffsetCheck = m_bLast m_dLastOffset = m_dLast m_nStep = 0 RaiseEvent UpdateUI(Me, True) Case Else m_nStep = 0 Return False End Select Return True End Function Private Sub DragOffset() If m_nStep = 1 Then ' linea di distanza EgtSetGeoLine(m_ptP1, m_ptLast) ' devo sempre partire dalla curva originale m_Scene.EraseDragGroup() PrepareTransform(False) ' eseguo offset Dim nId As Integer = EgtGetFirstInGroup(m_Scene.GetDragGroup()) Dim nCount As Integer EgtOffsetCurveAdv(nId, m_dLast, m_nLast, nCount) If nCount <= 0 Then Dim vtPlaN As Vector3d Dim dPlaDist As Double If EgtCurveIsFlat(nId, vtPlaN, dPlaDist) Then RaiseEvent OutputInfo(Me, EgtMsg(2056)) ' Distance too big Else RaiseEvent OutputInfo(Me, EgtMsg(2057)) ' Curve not flat (in its plane) End If Else EgtErase(nId) RaiseEvent OutputInfo(Me, "") End If EgtDraw() End If End Sub Private Function ExecuteSpecialDataOffset() As Boolean If m_nStep = 1 Then Dim dDist As Double Dim nSide As Integer Dim ptMin As Point3d Dim nId As Integer = EgtGetLastSelectedObj() If EgtPointCurveDistSide(m_ptLast.Loc(nId), nId, EgtGetGridVersZ().Loc(nId), nId, dDist, ptMin, nSide) Then ' calcolo la distanza tra m_ptLast e ptMin sul piano griglia m_ptP1 = ptMin.Glob(nId) Dim vtDiff As Vector3d = m_ptLast - m_ptP1 vtDiff -= vtDiff * EgtGetGridVersZ() * EgtGetGridVersZ() Dim dDistFr As Double = vtDiff.Len() ' assegno la distanza di offset tenendo conto del lato ( sx=-1, dx=+1) m_dLast = dDistFr * nSide ' se vettore estrusione della curva opposto al versore Z della griglia, devo cambiare segno alla distanza Dim vtExtr As Vector3d If EgtCurveExtrusion(nId, vtExtr) And Not vtExtr.IsSmall() Then If vtExtr * EgtGetGridVersZ() < -EPS_SMALL Then m_dLast = -m_dLast End If End If End If Return False End Function Private Function PrepareTransform(Optional bAllSelected As Boolean = True) As Boolean ' verifico ci sia qualcosa di selezionato If EgtGetFirstSelectedObj() = GDB_ID.NULL Then Return False End If ' se non esiste già, creo il gruppo di drag e vi copio le entità selezionate If m_Scene.GetDragGroup() = GDB_ID.NULL Then If Not m_Scene.CreateDragGroup() Then Return False End If End If ' se devo prendere tutti If bAllSelected Then Dim nId As Integer = EgtGetFirstSelectedObj() While nId <> GDB_ID.NULL If m_Scene.AddToDragGroup(nId) = GDB_ID.NULL Then m_Scene.EraseDragGroup() Return False End If nId = EgtGetNextSelectedObj() End While ' altrimenti solo l'ultimo Else Dim nId As Integer = EgtGetLastSelectedObj() If nId = GDB_ID.NULL Or m_Scene.AddToDragGroup(nId) = GDB_ID.NULL Then m_Scene.EraseDragGroup() Return False End If End If Return True End Function Private Function GridLenFromGlobLen(vtLen As Vector3d) As Double vtLen.ToLoc(EgtGetGridFrame()) Return Math.Sqrt(vtLen.x * vtLen.x + vtLen.y * vtLen.y) End Function Private Function GridAngFromGlobDir(vtDir As Vector3d) As Double vtDir.ToLoc(EgtGetGridFrame()) Dim dLen As Double Dim dAngVertDeg As Double Dim dAngOrizzDeg As Double vtDir.ToSpherical(dLen, dAngVertDeg, dAngOrizzDeg) Return dAngOrizzDeg End Function Private Function GlobDirFromGridAng(dGridAngDeg As Double) As Vector3d Dim vtDir As Vector3d = Vector3d.X_AX() vtDir.Rotate(Vector3d.Z_AX, dGridAngDeg) vtDir.ToGlob(EgtGetGridFrame()) Return vtDir End Function '-------------------------------- Current Part and Layer ----------------------------------------- Public Function GetCurrPart() As Integer Return EgtGetCurrPart() End Function Public Function GetCurrLayer() As Integer Return EgtGetCurrLayer() End Function '-------------------------------- Modified Status ------------------------------------------------ Public Function SetCurrFile(sFile As String) As Boolean Return EgtSetCurrFilePath(sFile) End Function Public Function ResetCurrFile() As Boolean Return EgtSetCurrFilePath("") End Function Public Function GetCurrFile() As String Dim sCurrFile As String = String.Empty EgtGetCurrFilePath(sCurrFile) Return sCurrFile End Function Public Sub SetModified(Optional bReloadUI As Boolean = True) EgtSetModified() RaiseEvent UpdateUI(Me, bReloadUI) End Sub Public Sub ResetModified(Optional bReloadUI As Boolean = True) EgtResetModified() RaiseEvent UpdateUI(Me, bReloadUI) End Sub Public Function GetModified() As Boolean Return EgtGetModified() End Function Public Function ManageModified() As Boolean ' se non modificato, procedo normalmente If Not GetModified() Then Return True End If ' chiedo cosa fare Dim sMsg As String = "Save changes" Dim sCurrFile = GetCurrFile() If Not String.IsNullOrEmpty(sCurrFile) Then sMsg += " to " + sCurrFile End If sMsg += " ?" Dim nRes = MessageBox.Show(m_Scene, sMsg, "", MessageBoxButtons.YesNoCancel, MessageBoxIcon.Question) Select Case nRes Case Windows.Forms.DialogResult.Yes SaveProject() Return True Case Windows.Forms.DialogResult.No Return True Case Else Return False End Select End Function '-------------------------------- Fonts ---------------------------------------------------------- Private m_sFonts As New ArrayList Private Sub LoadFonts() ' pulisco eventuale vecchio array m_sFonts.Clear() ' carico font Nfe Dim sNfeDir As String = String.Empty EgtGetNfeFontDir(sNfeDir) If Not String.IsNullOrWhiteSpace(sNfeDir) Then For Each File As String In IO.Directory.GetFiles(sNfeDir, "*.nfe") m_sFonts.Add(IO.Path.GetFileName(File)) Next End If ' carico font di sistema Dim oneFontFamily As FontFamily For Each oneFontFamily In FontFamily.Families m_sFonts.Add(oneFontFamily.Name) Next End Sub '-------------------------------- Colors --------------------------------------------------------- Private m_bCustomColors As Boolean = False Private m_sCustColSect As String = "" Private m_sCustColKey As String = "" Public Function SetUseCustomColors(bUse As Boolean, sCustColSect As String, sCustColKey As String) As Boolean m_bCustomColors = bUse If m_bCustomColors Then m_sCustColSect = sCustColSect m_sCustColKey = sCustColKey Else m_sCustColSect = "" m_sCustColKey = "" End If Return True End Function Private Function SelectColor(Col As Color3d, ByRef NewCol As Color3d) As Boolean ' Path file Ini Dim sIniFile As String = "" EgtGetIniFile(sIniFile) ' Se richiesto, recupero i colori custom Dim nCustomColors As New List(Of Integer) If m_bCustomColors Then ' Recupero colori custom Dim sCustomColors As String = "" GetPrivateProfileString(m_sCustColSect, m_sCustColKey, "", sCustomColors, sIniFile) Dim CustomColors() As String = sCustomColors.Split(","c) For Each Color In CustomColors Dim nColor As Integer If Integer.TryParse(Color, nColor) Then nCustomColors.Add(nColor) End If Next End If ' Creo dialogo colori Dim ColorDlg As New System.Windows.Forms.ColorDialog ColorDlg.FullOpen = True ColorDlg.CustomColors = nCustomColors.ToArray() ColorDlg.Color = Col.ToColor() ' Visualizzo dialogo If ColorDlg.ShowDialog() <> Windows.Forms.DialogResult.OK Then Return False ' Recupero colore scelto NewCol.FromColor(ColorDlg.Color) ' Se richiesto, salvo eventuali modifiche ai colori custom If m_bCustomColors Then Dim sCustomColors As String = "" For Each Color In ColorDlg.CustomColors sCustomColors &= Color.ToString() & "," Next sCustomColors = sCustomColors.Trim({" "c, ","c}) WritePrivateProfileString(m_sCustColSect, m_sCustColKey, sCustomColors, sIniFile) End If Return True End Function '-------------------------------- Registrazione Comandi (in Lua) --------------------------------- Private m_bCommandLog As Boolean = False Public Function SetCommandLog(bCmdLog As Boolean, sCmdLogDir As String, sCmdLogFile As String) As Boolean ' imposto stato m_bCommandLog = bCmdLog ' se necessario inizializzo logger If m_bCommandLog Then Dim sCmdBakFile As String = sCmdLogFile & ".bak" Dim sFile = sCmdLogDir & "\" & sCmdLogFile Dim sBackup = sCmdLogDir & "\" & sCmdBakFile ' se logger già in uso, non faccio alcunchè e non lo avvio If FileInUse(sFile) Then m_bCommandLog = False Return False End If ' backup di eventuale log già presente If My.Computer.FileSystem.FileExists(sFile) Then ' cancello eventuale vecchio backup If My.Computer.FileSystem.FileExists(sBackup) Then My.Computer.FileSystem.DeleteFile(sBackup) End If ' rinomino il file My.Computer.FileSystem.RenameFile(sFile, sCmdBakFile) End If ' avvio logger EgtSetCommandLogger(sFile) End If Return True End Function Public Function GetCommandLog() As Boolean Return m_bCommandLog End Function Private Sub EnableCommandLog() If m_bCommandLog Then EgtEnableCommandLogger() End If End Sub Private Sub DisableCommandLog() EgtDisableCommandLogger() End Sub End Class