Egalware/TestEIn
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
master
TestEIn/Controller.vb
T
Dario Sassi 9d7842c068 TestEIn 2.1j1 : 
- aggiornato e ricompilato.
2019-10-02 06:53:22 +00:00

5889 lines
207 KiB
VB.net
Raw Permalink Blame History

'----------------------------------------------------------------------------
' 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
Reference in New Issue View Git Blame Copy Permalink