diff --git a/Constants/ConstMachIni.vb b/Constants/ConstMachIni.vb
index 8f3e088..dde8af4 100644
--- a/Constants/ConstMachIni.vb
+++ b/Constants/ConstMachIni.vb
@@ -19,6 +19,7 @@
Public Const K_MORTISEMAKER As String = "MortiseMaker"
Public Const K_CHISELMAKER As String = "ChiselMaker"
Public Const K_MOUNTEDTOOLCONFIG As String = "MountedToolConfig"
+ Public Const K_ACTIVE As String = "Active"
Public Const S_TOOLHOLDER As String = "ToolHolder"
@@ -55,6 +56,7 @@
Public Const K_MACH_EXITSCRIPT As String = "ExitScript"
Public Const S_FIXTURES As String = "Fixtures"
+ Public Const K_HOOKTOLERANCE As String = "HookTolerance"
Public Const S_HEADS As String = "Heads"
diff --git a/OptionPanel/MachiningOptionPanel/OperationExpander/DispositionParameterExpander/DispositionParameterExpanderVM.vb b/OptionPanel/MachiningOptionPanel/OperationExpander/DispositionParameterExpander/DispositionParameterExpanderVM.vb
index ee20dc1..a1ee8f8 100644
--- a/OptionPanel/MachiningOptionPanel/OperationExpander/DispositionParameterExpander/DispositionParameterExpanderVM.vb
+++ b/OptionPanel/MachiningOptionPanel/OperationExpander/DispositionParameterExpander/DispositionParameterExpanderVM.vb
@@ -383,7 +383,7 @@ Public Class DispositionParameterExpanderVM
vtMove.z = 0
End If
' Muovo tutti gli oggetti selezionati
- DispositionUtility.MoveRawPartPartAndFixture(GDB_ID.SEL, vtMove)
+ DispositionUtility.MoveRawPartPartAndFixture(GDB_ID.SEL, vtMove, DispositionUtility.SelType.NULL)
' se è un grezzo
If EgtVerifyRawPartCurrPhase(nFirstSelectedId) Then
Dim ptRawRefPoint As Point3d = DispositionUtility.GetRawPartRefPoint(nFirstSelectedId, m_RawRefPosition)
@@ -392,9 +392,9 @@ Public Class DispositionParameterExpanderVM
' se differisce
If Not vtRemainingMove.IsSmall() Then
' eseguo lo spostamento rimanente sull'asse x
- DispositionUtility.MoveRawPartPartAndFixture(GDB_ID.SEL, New Vector3d(vtRemainingMove.x, 0, 0))
+ DispositionUtility.MoveRawPartPartAndFixture(GDB_ID.SEL, New Vector3d(vtRemainingMove.x, 0, 0), DispositionUtility.SelType.NULL)
' eseguo lo spostamento rimanente sull'asse y
- DispositionUtility.MoveRawPartPartAndFixture(GDB_ID.SEL, New Vector3d(0, vtRemainingMove.y, 0))
+ DispositionUtility.MoveRawPartPartAndFixture(GDB_ID.SEL, New Vector3d(0, vtRemainingMove.y, 0), DispositionUtility.SelType.NULL)
End If
End If
' se rotazione
diff --git a/OptionPanel/MachiningOptionPanel/OperationExpander/DispositionParameterExpander/DispositionUtility.vb b/OptionPanel/MachiningOptionPanel/OperationExpander/DispositionParameterExpander/DispositionUtility.vb
index cd9c568..0f3bcc2 100644
--- a/OptionPanel/MachiningOptionPanel/OperationExpander/DispositionParameterExpander/DispositionUtility.vb
+++ b/OptionPanel/MachiningOptionPanel/OperationExpander/DispositionParameterExpander/DispositionUtility.vb
@@ -2,6 +2,37 @@
Public NotInheritable Class DispositionUtility
+ Friend Const MOBILE As String = "MOBILE"
+ Friend Const MDIR As String = "MDir"
+ Friend Const STROKE As String = "Stroke"
+ Friend Const POS As String = "Val"
+ Friend Const PDIST As String = "PDist"
+ Friend Const MDIST As String = "MDist"
+ Friend Const HOOK As String = "HOOK"
+ Friend Const CLASS_ As String = "CLASS"
+ Friend Const USED As String = "USED"
+ Friend Const FIXED As String = "FIXED"
+ Friend Const TYPE As String = "TYPE"
+ Friend Const FREE As String = "FREE"
+ Friend Const LINE As String = "LINE"
+ Friend Const POINT As String = "POINT"
+ Friend Enum HOOKTYPE As Integer
+ FREE = 0
+ POINT = 1
+ LINE = 2
+ End Enum
+
+ Friend Shared m_vtHook As Vector3d = Vector3d.NULL
+ Friend Shared m_nUsedHookId As Integer = GDB_ID.NULL
+
+ ' Identificativi per elemento da selezionare/deselezionare
+ Friend Enum SelType As Integer
+ NULL = 0
+ FIXTURE = 1
+ RAWPART = 2
+ BARS = 3
+ End Enum
+
Friend Shared Function GetRawPartRefPoint(nRawPartId As Integer, RawRefPosition As MCH_CR) As Point3d
Dim bboxRawPart As New BBox3d
' recupero il solido del grezzo dal primo elemento selezionato
@@ -36,7 +67,7 @@ Public NotInheritable Class DispositionUtility
Return ptRawRefPoint
End Function
- Public Shared Function MoveRawPartPartAndFixture(nMoveId As Integer, vtMove As Vector3d, Optional nCount As Integer = 1) As Boolean
+ Public Shared Function MoveRawPartPartAndFixture(nMoveId As Integer, vtMove As Vector3d, sSelType As Integer, Optional ptCurr As Point3d = Nothing, Optional nCount As Integer = 1) As Boolean
Dim bErrorMoving As Boolean = False
' Muovo gli oggetti selezionati se consentito
If nMoveId = GDB_ID.SEL Then
@@ -75,10 +106,15 @@ Public NotInheritable Class DispositionUtility
End If
End While
Else
+ Dim sName As String = ""
+ EgtGetName(EgtGetParent(nMoveId), sName)
If EgtVerifyFixture(nMoveId) Then
+ VerifyHookFixture(nMoveId, vtMove, ptCurr, True)
If Not EgtMoveFixture(nMoveId, vtMove) Then
bErrorMoving = True
End If
+ ElseIf sSelType = SelType.BARS Then
+ VerifyBarPosition(nMoveId, vtMove)
Else
If Not EgtMoveRawPart(nMoveId, vtMove) Then
bErrorMoving = True
@@ -114,7 +150,7 @@ Public NotInheritable Class DispositionUtility
If Not bErrorVerify AndAlso Not vtRefMove.IsSmall() Then
' provo a correggere (max 1 prova)
If nCount < 2 Then
- bErrorVerify = Not MoveRawPartPartAndFixture(nMoveId, vtRefMove, nCount + 1)
+ bErrorVerify = Not MoveRawPartPartAndFixture(nMoveId, vtRefMove, DispositionUtility.SelType.NULL, Nothing, nCount + 1)
End If
End If
' Se c'è almeno uno spostamento non valido
@@ -133,6 +169,8 @@ Public NotInheritable Class DispositionUtility
Else
If EgtVerifyFixture(nMoveId) Then
EgtMoveFixture(nMoveId, -vtMove)
+ ' segno hook occupato prima del movimento correttivo come non utilizzato
+ EgtSetInfo(m_nUsedHookId, USED, False)
Else
EgtMoveRawPart(nMoveId, -vtMove)
End If
@@ -480,6 +518,239 @@ Public NotInheritable Class DispositionUtility
Return True
End Function
+ ' Funzione che verifica i movimenti della barra
+ Private Shared Function VerifyBarPosition(nMoveId As Integer, vtMove As Vector3d) As Boolean
+ ' verifico direzione di spostamento consentita
+ Dim sMDir As String = ""
+ EgtGetInfo(nMoveId, MDIR, sMDir)
+ Dim aMDir() As String = sMDir.Split(","c)
+ Dim vX As Integer = 0
+ Dim vY As Integer = 0
+ Dim vZ As Integer = 0
+ Integer.TryParse(aMDir(0), vX)
+ Integer.TryParse(aMDir(1), vY)
+ Integer.TryParse(aMDir(2), vZ)
+ Dim vtMDir As New Vector3d(vX, vY, vZ)
+ vtMDir.Normalize()
+ vtMove = vtMove * vtMDir * vtMDir
+ ' recupero corsa
+ Dim sStroke As String = ""
+ Dim sStrokes() As String
+ Dim PStroke As Double = 0
+ Dim MStroke As Double = 0
+ EgtGetInfo(nMoveId, STROKE, sStroke)
+ sStrokes = sStroke.Split(","c)
+ StringToDouble(sStrokes(0), MStroke)
+ StringToDouble(sStrokes(1), PStroke)
+ ' recupero dati barra corrente
+ Dim dCurrBarYPos As Double = 0
+ Dim dCurrBarMVal As Double = 0
+ Dim dCurrBarPVal As Double = 0
+ GetBarExtreme(nMoveId, dCurrBarYPos, dCurrBarMVal, dCurrBarPVal)
+ ' recupero indice barra da spostare
+ Dim sBarName As String = ""
+ EgtGetName(nMoveId, sBarName)
+ Dim nBarId As Integer = 0
+ sBarName = sBarName.Substring(6, sBarName.Length - 6)
+ Integer.TryParse(sBarName, nBarId)
+ ' recupero dati barra precedente
+ Dim dMinYMove As Double
+ Dim dMaxYMove As Double
+ Dim dPrevBarYPos As Double = 0
+ Dim dPrevBarMVal As Double = 0
+ Dim dPrevBarPVal As Double = 0
+ If nBarId > 1 Then
+ ' recupero eventuale barra precedente
+ Dim nPrevBarId As Integer = EgtGetFirstNameInGroup(EgtGetParent(nMoveId), MOBILE & nBarId - 1)
+ If Not nPrevBarId = GDB_ID.NULL Then
+ GetBarExtreme(nPrevBarId, dPrevBarYPos, dPrevBarMVal, dPrevBarPVal)
+ ' calcolo il massimo tra corsa di spostamento ed ingombro della barra precedente
+ dMinYMove = Math.Max(dPrevBarYPos + dPrevBarPVal + dCurrBarMVal, MStroke)
+ Else
+ dMinYMove = MStroke
+ End If
+ Else
+ dMinYMove = MStroke
+ End If
+ ' recupero eventuale barra successiva
+ Dim dNextBarYPos As Double = 0
+ Dim dNextBarMVal As Double = 0
+ Dim dNextBarPVal As Double = 0
+ Dim nNextBarId As Integer = EgtGetFirstNameInGroup(EgtGetParent(nMoveId), MOBILE & nBarId + 1)
+ If Not nNextBarId = GDB_ID.NULL Then
+ GetBarExtreme(nNextBarId, dNextBarYPos, dNextBarMVal, dNextBarPVal)
+ ' calcolo il minimo tra corsa di spostamento ed ingombro della barra successiva
+ dMaxYMove = Math.Min(dNextBarYPos - dNextBarMVal - dCurrBarPVal, PStroke)
+ Else
+ dMaxYMove = PStroke
+ End If
+ ' sottraggo dagli estremi l'ingombro della barra
+ 'dMinYMove += dCurrBarMVal
+ 'dMaxYMove -= dCurrBarPVal
+ ' verifico che lo spostamento sia entro le corse
+ If dCurrBarYPos + vtMove.y <= dMinYMove Then
+ vtMove.y = dMinYMove - dCurrBarYPos
+ ElseIf dCurrBarYPos + vtMove.y >= dMaxYMove Then
+ vtMove.y = dMaxYMove - dCurrBarYPos
+ End If
+ EgtMove(nMoveId, vtMove)
+ ' scrivo nuova posizione
+ EgtSetInfo(nMoveId, POS, DoubleToString(dCurrBarYPos + vtMove.y, 4))
+ Return True
+ End Function
+
+ Private Shared Function GetBarExtreme(nMoveId As Integer, ByRef YPos As Double, ByRef PVal As Double, ByRef MVal As Double) As Boolean
+ ' recupero posizione
+ EgtGetInfo(nMoveId, POS, YPos)
+ ' recupero ingombro negativo
+ Dim dMDist As Double = 0
+ EgtGetInfo(nMoveId, MDIST, dMDist)
+ ' recupero ingombro positivo
+ Dim dPDist As Double = 0
+ EgtGetInfo(nMoveId, PDIST, dPDist)
+ MVal = dMDist
+ PVal = dPDist
+ Return True
+ End Function
+
+ ' Funzione che verifica l'agganciamento dei sottopezzi
+ Friend Shared Function VerifyHookFixture(nMoveId As Integer, ByRef vtMove As Vector3d, ptCurr As Point3d, bTolerance As Boolean) As Boolean
+ ' cerco punto hook sulla ventosa
+ Dim nFixtSolidId As Integer = EgtGetFirstNameInGroup(nMoveId, SOLID)
+ Dim nFixtHookId As Integer = EgtGetFirstNameInGroup(nFixtSolidId, HOOK)
+ ' recupero punto di hook
+ Dim ptFixtHook As Point3d
+ EgtStartPoint(nFixtHookId, GDB_ID.ROOT, ptFixtHook)
+ ' calcolo vtMove nel caso normale
+ If Not IsNothing(ptCurr) Then
+ vtMove = ptCurr - m_vtHook - ptFixtHook
+ End If
+ ' leggo tipo e classe
+ Dim nFixtHookType As HOOKTYPE = HOOKTYPE.FREE
+ Dim sType As String = ""
+ EgtGetInfo(nFixtHookId, TYPE, sType)
+ If sType.Equals(FREE) Then
+ nFixtHookType = HOOKTYPE.FREE
+ ' esco perchè non devo cercare alcun punto
+ Return True
+ ElseIf sType.Equals(POINT) Then
+ nFixtHookType = HOOKTYPE.POINT
+ ElseIf sType.Equals(LINE) Then
+ nFixtHookType = HOOKTYPE.LINE
+ Else
+ nFixtHookType = HOOKTYPE.FREE
+ ' esco perchè non devo cercare alcun punto
+ Return True
+ End If
+ Dim nFixtHookClass As Integer = 0
+ EgtGetInfo(nFixtHookId, CLASS_, nFixtHookClass)
+ ' cerco id tavola
+ Dim sTableName As String = ""
+ EgtGetTableName(sTableName)
+ Dim nTableId As Integer = EgtGetTableId(sTableName)
+ ' cerco hook su tavola macchina
+ Dim nTableSolidId As Integer = EgtGetFirstNameInGroup(nTableId, SOLID)
+ Dim nCurrHookId As Integer = EgtGetFirstNameInGroup(nTableSolidId, HOOK)
+ ' variabili per tenere da parte l'entità, la distanza e il punto di hook più vicino alla ventosa
+ Dim nNearestHookId As Integer = GDB_ID.NULL
+ Dim dNearestHookDist As Double = 99999999
+ Dim ptNearestHook As Point3d = Nothing
+ While nCurrHookId <> GDB_ID.NULL
+ 'HookAnalyzer(nCurrHookId, nFixtHookType, nFixtHookClass, ptFixtHook, nNearestHookId, dNearestHookDist)
+ HookAnalyzer(nCurrHookId, nFixtHookType, nFixtHookClass, ptCurr + m_vtHook, nNearestHookId, dNearestHookDist, ptNearestHook)
+ nCurrHookId = EgtGetNextName(nCurrHookId, HOOK)
+ End While
+ ' cerco hook su barra fissa
+ Dim nTableFixedId As Integer = EgtGetFirstNameInGroup(nTableId, FIXED)
+ nCurrHookId = EgtGetFirstNameInGroup(nTableFixedId, HOOK)
+ While nCurrHookId <> GDB_ID.NULL
+ 'HookAnalyzer(nCurrHookId, nFixtHookType, nFixtHookClass, ptFixtHook, nNearestHookId, dNearestHookDist)
+ HookAnalyzer(nCurrHookId, nFixtHookType, nFixtHookClass, ptCurr + m_vtHook, nNearestHookId, dNearestHookDist, ptNearestHook)
+ nCurrHookId = EgtGetNextName(nCurrHookId, HOOK)
+ End While
+ ' cerco hook su barre mobili
+ Dim nMobileInd As Integer = 1
+ Dim nMobile As Integer = EgtGetFirstNameInGroup(nTableId, MOBILE & nMobileInd)
+ While nMobile <> GDB_ID.NULL
+ nCurrHookId = EgtGetFirstNameInGroup(nMobile, HOOK)
+ While nCurrHookId <> GDB_ID.NULL
+ 'HookAnalyzer(nCurrHookId, nFixtHookType, nFixtHookClass, ptFixtHook, nNearestHookId, dNearestHookDist)
+ HookAnalyzer(nCurrHookId, nFixtHookType, nFixtHookClass, ptCurr + m_vtHook, nNearestHookId, dNearestHookDist, ptNearestHook)
+ nCurrHookId = EgtGetNextName(nCurrHookId, HOOK)
+ End While
+ nMobileInd += 1
+ nMobile = EgtGetFirstNameInGroup(nTableId, MOBILE & nMobileInd)
+ End While
+ ' se non ho trovato hook compatibili e liberi esco
+ If nNearestHookId = GDB_ID.NULL Then Return False
+ ' verifico se la distanza minima è inferiore al raggio dell'area di aggancio
+ Dim dHookTolerance As Double = EgtUILib.GetPrivateProfileDouble(S_FIXTURES, K_HOOKTOLERANCE, 50, IniFile.m_sCurrMachIniFilePath)
+ If bTolerance AndAlso dNearestHookDist > dHookTolerance Then Return False
+ ' sostituisco spostamento mouse con spostamento ad hook
+ vtMove = ptNearestHook - ptFixtHook
+ m_nUsedHookId = nNearestHookId
+ ' segno hook come utilizzato
+ EgtSetInfo(m_nUsedHookId, USED, True)
+ Return True
+ End Function
+
+ ' Funzione che analizza gli hook
+ Private Shared Sub HookAnalyzer(nCurrHookId As Integer, nFixtHookType As Integer, nFixtHookClass As Integer, ptFixtHook As Point3d, ByRef nNearestHookId As Integer, ByRef dNearestHookDist As Double, ByRef ptNearestHook As Point3d)
+ ' verifico se del tipo giusto
+ Dim nTableHookType As GDB_TY = EgtGetType(nCurrHookId)
+ If (nTableHookType = GDB_TY.GEO_POINT And nFixtHookType = HOOKTYPE.POINT) OrElse (nTableHookType = GDB_TY.CRV_LINE And nFixtHookType = HOOKTYPE.LINE) Then
+ ' verifico se della stessa classe
+ Dim nTableHookClass As Integer = 0
+ EgtGetInfo(nCurrHookId, CLASS_, nTableHookClass)
+ If nTableHookClass = nFixtHookClass Then
+ Dim dDist As Double = 0
+ ' punto a distanza minima sull'hook
+ Dim ptCurrHook As Point3d
+ If nTableHookType = GDB_TY.GEO_POINT Then
+ ' verifico se utilizzato
+ Dim bTableHookUsed As Boolean = False
+ EgtGetInfo(nCurrHookId, USED, bTableHookUsed)
+ If Not bTableHookUsed Then
+ ' calcolo distanza punto hook tavola dal punto hook della ventosa
+ EgtStartPoint(nCurrHookId, GDB_ID.ROOT, ptCurrHook)
+ dDist = Point3d.Dist(ptCurrHook, ptFixtHook)
+ Else
+ Return
+ End If
+ ElseIf nTableHookType = GDB_TY.CRV_LINE Then
+ ' calcolo distanza linea hook tavola dal punto hook della ventosa
+ Dim nRefId As Integer = 0
+ Dim dU As Double = 0
+ EgtPointCurveDist(ptFixtHook, nCurrHookId, nRefId, dDist, dU)
+ EgtAtParamPoint(nCurrHookId, dU, GDB_ID.ROOT, ptCurrHook)
+ Else
+ Return
+ End If
+ ' se minore della distanza minima, sostituisco il valore
+ If dDist < dNearestHookDist Then
+ nNearestHookId = nCurrHookId
+ dNearestHookDist = dDist
+ ptNearestHook = ptCurrHook
+ End If
+ Else
+ Return
+ End If
+ Else
+ Return
+ End If
+ End Sub
+
+ ' Funzione che fissa il vettore di hook
+ Friend Shared Sub VtHookFinder(nFixtureId As Integer, ptCurr As Point3d)
+ ' cerco punto hook sulla ventosa
+ Dim nFixtSolidId As Integer = EgtGetFirstNameInGroup(nFixtureId, SOLID)
+ Dim nFixtHookId As Integer = EgtGetFirstNameInGroup(nFixtSolidId, HOOK)
+ ' recupero punto di hook
+ Dim ptFixtHook As Point3d
+ EgtStartPoint(nFixtHookId, GDB_ID.ROOT, ptFixtHook)
+ m_vtHook = ptCurr - ptFixtHook
+ End Sub
+
' Funzione che restituisce il tipo di sottopezzo passatogli
Friend Shared Function FixtureType(nFixtureId As Integer) As FIX_TYPE
Dim sFixtureType As String = String.Empty
diff --git a/OptionPanel/MachiningOptionPanel/OperationExpander/DispositionParameterExpander/FixtureParameters/FixtureParametersVM.vb b/OptionPanel/MachiningOptionPanel/OperationExpander/DispositionParameterExpander/FixtureParameters/FixtureParametersVM.vb
index 4ec0ea1..662a238 100644
--- a/OptionPanel/MachiningOptionPanel/OperationExpander/DispositionParameterExpander/FixtureParameters/FixtureParametersVM.vb
+++ b/OptionPanel/MachiningOptionPanel/OperationExpander/DispositionParameterExpander/FixtureParameters/FixtureParametersVM.vb
@@ -129,8 +129,32 @@ Public Class FixtureParametersVM
OnPropertyChanged("FixtureErrorMsg")
Return
End If
+ ' verifico se la ventosa ha punti di hook da ancorare
+ If IsFixtureWithHook(nAddedFixtureId) Then
+ If Not PositionFixtureOnNearestHook(nAddedFixtureId) Then
+ ' non ci sono punti liberi, quindi rimuovo la ventosa e segnalo
+ EgtRemoveFixture(nAddedFixtureId)
+ MessageBox.Show("No free hook point!", "ERROR")
+ Return
+ End If
+ Else
+ ' se non ha punti di ancoraggio
' verifico se è in una posizione valida
If Not DispositionUtility.VerifyFixturePosition(nAddedFixtureId, New Vector3d) Then
+ ' se non trovo una posizione valida, esco
+ If Not SearchOkFixturePosition(nAddedFixtureId, ptTableMin, ptTableMax, ptTableMid) Then
+ Return
+ End If
+ End If
+ End If
+ ' sottraggo la ventosa aggiunta dal conto di quelle disponibili
+ SelectedFixture.UsedNumber += 1
+ EgtDraw()
+ OnPropertyChanged("FixtureErrorMsg")
+ End Sub
+
+ ' Funzione che cerca una posizione valida per la ventosa libera di muoversi
+ Private Function SearchOkFixturePosition(nAddedFixtureId As Integer, ptTableMin As Point3d, ptTableMax As Point3d, ptTableMid As Point3d) As Boolean
' creo un gruppo temporaneo
Dim nTempGroupId As Integer = EgtCreateGroup(GDB_ID.ROOT)
EgtSetLevel(nTempGroupId, GDB_LV.USER)
@@ -173,7 +197,7 @@ Public Class FixtureParametersVM
If nTableFrBorderCount = 0 Then
m_FixtureErrorMsg = "Impossibile posizionare la ventosa sulla tavola"
OnPropertyChanged("FixtureErrorMsg")
- Return
+ Return False
End If
' converto il punto medio della tavola in coordinate globali
Dim PtTableRef As Point3d
@@ -201,12 +225,147 @@ Public Class FixtureParametersVM
EgtMoveFixture(nAddedFixtureId, vtFixtureMove)
' cancello il gruppo temporaneo
EgtErase(nTempGroupId)
+ Return True
+ End Function
+
+ ' Funzione che dice se c'è un punto di aggancio sulla ventosa
+ Private Function IsFixtureWithHook(nFixtureId As Integer) As Boolean
+ ' cerco punto hook sulla ventosa
+ Dim nFixtSolidId As Integer = EgtGetFirstNameInGroup(nFixtureId, SOLID)
+ Dim nFixtHookId As Integer = EgtGetFirstNameInGroup(nFixtSolidId, DispositionUtility.HOOK)
+ If nFixtHookId = GDB_ID.NULL Then Return False
+ ' leggo tipo
+ Dim sType As String = ""
+ EgtGetInfo(nFixtHookId, DispositionUtility.TYPE, sType)
+ If sType.Equals(DispositionUtility.FREE) Then
+ Return False
+ ElseIf sType.Equals(DispositionUtility.POINT) Then
+ Return True
+ ElseIf sType.Equals(DispositionUtility.LINE) Then
+ Return True
+ Else
+ Return False
End If
- ' sottraggo la ventosa aggiunta dal conto di quelle disponibili
- SelectedFixture.UsedNumber += 1
- EgtDraw()
- OnPropertyChanged("FixtureErrorMsg")
- End Sub
+ End Function
+
+ ' Funzione che aggancia la ventosa al più vicino hook libero
+ Friend Shared Function PositionFixtureOnNearestHook(nFixtureId As Integer) As Boolean
+ ' cerco punto hook sulla ventosa
+ Dim nFixtSolidId As Integer = EgtGetFirstNameInGroup(nFixtureId, SOLID)
+ Dim nFixtHookId As Integer = EgtGetFirstNameInGroup(nFixtSolidId, DispositionUtility.HOOK)
+ ' recupero punto di hook
+ Dim ptFixtHook As Point3d
+ EgtStartPoint(nFixtHookId, GDB_ID.ROOT, ptFixtHook)
+ ' leggo tipo e classe
+ Dim nFixtHookType As DispositionUtility.HOOKTYPE = DispositionUtility.HOOKTYPE.FREE
+ Dim sType As String = ""
+ EgtGetInfo(nFixtHookId, DispositionUtility.TYPE, sType)
+ If sType.Equals(DispositionUtility.FREE) Then
+ nFixtHookType = DispositionUtility.HOOKTYPE.FREE
+ ' esco perchè non devo cercare alcun punto
+ Return True
+ ElseIf sType.Equals(DispositionUtility.POINT) Then
+ nFixtHookType = DispositionUtility.HOOKTYPE.POINT
+ ElseIf sType.Equals(DispositionUtility.LINE) Then
+ nFixtHookType = DispositionUtility.HOOKTYPE.LINE
+ Else
+ nFixtHookType = DispositionUtility.HOOKTYPE.FREE
+ ' esco perchè non devo cercare alcun punto
+ Return True
+ End If
+ Dim nFixtHookClass As Integer = 0
+ EgtGetInfo(nFixtHookId, DispositionUtility.CLASS_, nFixtHookClass)
+ ' cerco id tavola
+ Dim sTableName As String = ""
+ EgtGetTableName(sTableName)
+ Dim nTableId As Integer = EgtGetTableId(sTableName)
+ ' cerco hook su tavola macchina
+ Dim nTableSolidId As Integer = EgtGetFirstNameInGroup(nTableId, SOLID)
+ Dim nCurrHookId As Integer = EgtGetFirstNameInGroup(nTableSolidId, DispositionUtility.HOOK)
+ ' Punto di hook a cui spostare la ventosa
+ Dim ptCurrHook As Point3d = Nothing
+ While nCurrHookId <> GDB_ID.NULL
+ ' se punto di aggancio valido
+ If HookAnalyzer(nCurrHookId, nFixtHookType, nFixtHookClass, ptFixtHook, ptCurrHook) Then
+ ' sposto la ventosa
+ EgtMoveFixture(nFixtureId, ptCurrHook - ptFixtHook)
+ ' verifico se è in una posizione valida
+ If DispositionUtility.VerifyFixturePosition(nFixtureId, New Vector3d) Then
+ Return True
+ End If
+ End If
+ nCurrHookId = EgtGetNextName(nCurrHookId, DispositionUtility.HOOK)
+ End While
+ ' cerco hook su barra fissa
+ Dim nTableFixedId As Integer = EgtGetFirstNameInGroup(nTableId, DispositionUtility.FIXED)
+ nCurrHookId = EgtGetFirstNameInGroup(nTableFixedId, DispositionUtility.HOOK)
+ While nCurrHookId <> GDB_ID.NULL
+ ' se punto di aggancio valido
+ If HookAnalyzer(nCurrHookId, nFixtHookType, nFixtHookClass, ptFixtHook, ptCurrHook) Then
+ ' sposto la ventosa
+ EgtMoveFixture(nFixtureId, ptCurrHook - ptFixtHook)
+ ' verifico se è in una posizione valida
+ If DispositionUtility.VerifyFixturePosition(nFixtureId, New Vector3d) Then
+ Return True
+ End If
+ End If
+ nCurrHookId = EgtGetNextName(nCurrHookId, DispositionUtility.HOOK)
+ End While
+ ' cerco hook su barre mobili
+ Dim nMobileInd As Integer = 1
+ Dim nMobile As Integer = EgtGetFirstNameInGroup(nTableId, DispositionUtility.MOBILE & nMobileInd)
+ While nMobile <> GDB_ID.NULL
+ nCurrHookId = EgtGetFirstNameInGroup(nMobile, DispositionUtility.HOOK)
+ While nCurrHookId <> GDB_ID.NULL
+ ' se punto di aggancio valido
+ If HookAnalyzer(nCurrHookId, nFixtHookType, nFixtHookClass, ptFixtHook, ptCurrHook) Then
+ ' sposto la ventosa
+ EgtMoveFixture(nFixtureId, ptCurrHook - ptFixtHook)
+ ' verifico se è in una posizione valida
+ If DispositionUtility.VerifyFixturePosition(nFixtureId, New Vector3d) Then
+ Return True
+ End If
+ End If
+ nCurrHookId = EgtGetNextName(nCurrHookId, DispositionUtility.HOOK)
+ End While
+ nMobileInd += 1
+ nMobile = EgtGetFirstNameInGroup(nTableId, DispositionUtility.MOBILE & nMobileInd)
+ End While
+ Return False
+ End Function
+
+ ' Funzione che analizza l'hook e se valido ne prestituisce lo posizione(punto)
+ Private Shared Function HookAnalyzer(nCurrHookId As Integer, nFixtHookType As Integer, nFixtHookClass As Integer, ptFixtHook As Point3d, ByRef ptCurrHook As Point3d) As Boolean
+ ' verifico se del tipo giusto
+ Dim nTableHookType As GDB_TY = EgtGetType(nCurrHookId)
+ If (nTableHookType = GDB_TY.GEO_POINT And nFixtHookType = DispositionUtility.HOOKTYPE.POINT) OrElse (nTableHookType = GDB_TY.CRV_LINE And nFixtHookType = DispositionUtility.HOOKTYPE.LINE) Then
+ ' verifico se della stessa classe
+ Dim nTableHookClass As Integer = 0
+ EgtGetInfo(nCurrHookId, DispositionUtility.CLASS_, nTableHookClass)
+ If nTableHookClass = nFixtHookClass Then
+ Dim dDist As Double = 0
+ ' punto a distanza minima sull'hook
+ If nTableHookType = GDB_TY.GEO_POINT Then
+ ' verifico se utilizzato
+ Dim bTableHookUsed As Boolean = False
+ EgtGetInfo(nCurrHookId, DispositionUtility.USED, bTableHookUsed)
+ If Not bTableHookUsed Then
+ ' calcolo distanza punto hook tavola dal punto hook della ventosa
+ EgtStartPoint(nCurrHookId, GDB_ID.ROOT, ptCurrHook)
+ Return True
+ End If
+ ElseIf nTableHookType = GDB_TY.CRV_LINE Then
+ ' calcolo distanza linea hook tavola dal punto hook della ventosa
+ Dim nRefId As Integer = 0
+ Dim dU As Double = 0
+ EgtPointCurveDist(ptFixtHook, nCurrHookId, nRefId, dDist, dU)
+ EgtAtParamPoint(nCurrHookId, dU, GDB_ID.ROOT, ptCurrHook)
+ Return True
+ End If
+ End If
+ End If
+ Return False
+ End Function
#End Region ' AddCommand
diff --git a/Project/ProjectVM.vb b/Project/ProjectVM.vb
index 4d913f0..85b8dd7 100644
--- a/Project/ProjectVM.vb
+++ b/Project/ProjectVM.vb
@@ -864,6 +864,7 @@ Public Class ProjectVM
' Identificativi per elemento da selezionare/deselezionare
Private m_nIdToSel As Integer = GDB_ID.NULL
+ Private m_SelType As DispositionUtility.SelType = DispositionUtility.SelType.NULL
Private m_nIdToDesel As Integer = GDB_ID.NULL
'Private m_nFirstRawPartId As Integer = GDB_ID.NULL
@@ -883,6 +884,9 @@ Public Class ProjectVM
If m_SceneSelType = SceneSelTypeOpt.NULL OrElse m_SceneSelType = SceneSelTypeOpt.MACHINING Then Return
' Si può selezionare solo con il tasto sinistro
If e.Button <> Forms.MouseButtons.Left Then Return
+ ' Dati per drag
+ Dim TableRef As Point3d
+ EgtGetTableRef(1, TableRef)
' Per default no drag
m_bDrag = False
Dim nSel As Integer
@@ -892,7 +896,10 @@ Public Class ProjectVM
Select Case m_SceneSelType
Case SceneSelTypeOpt.FIXTURE
Dim nFixtureId As Integer = EgtGetParent(EgtGetParent(nId))
+ Dim sName As String = ""
+ EgtGetName(EgtGetParent(nId), sName)
If EgtVerifyFixture(nFixtureId) Then
+ m_SelType = DispositionUtility.SelType.FIXTURE
' Se già selezionato
If EgtIsSelectedObj(nFixtureId) Then
' Memorizzo Id da deselezionare
@@ -903,11 +910,21 @@ Public Class ProjectVM
End If
' Drag possibile
m_bDrag = True
+ ' salvo vettore click rispetto a punto hook della ventosa
+ Dim ptCurr As Point3d
+ EgtGetPlaneSnapPoint(e.Location, Vector3d.Z_AX, TableRef.z, ptCurr)
+ DispositionUtility.VtHookFinder(nFixtureId, ptCurr)
Exit While
+ ElseIf sName.Contains(DispositionUtility.MOBILE) Then
+ m_SelType = DispositionUtility.SelType.BARS
+ m_nIdToSel = EgtGetParent(nId)
+ ' Drag possibile
+ m_bDrag = True
End If
Case SceneSelTypeOpt.RAWPART, SceneSelTypeOpt.RAWPARTWITHFIXTURE
Dim nRawPartId As Integer = EgtGetParent(nId)
If EgtVerifyRawPartCurrPhase(nRawPartId) Then
+ m_SelType = DispositionUtility.SelType.RAWPART
' Se già selezionato
If EgtIsSelectedObj(nRawPartId) Then
' Memorizzo Id da deselezionare
@@ -925,7 +942,6 @@ Public Class ProjectVM
End While
' Dati per drag
m_locPrev = e.Location
- Dim TableRef As Point3d
EgtGetTableRef(1, TableRef)
m_bDrag = m_bDrag AndAlso EgtGetPlaneSnapPoint(e.Location, Vector3d.Z_AX, TableRef.z, m_ptPrev)
m_bDragToStart = m_bDrag
@@ -964,7 +980,7 @@ Public Class ProjectVM
Dim vtMove As Vector3d = ptCurr - m_ptPrev
vtMove.z = 0
' Muovo gli oggetti selezionati se consentito
- DispositionUtility.MoveRawPartPartAndFixture(nMoveId, vtMove)
+ DispositionUtility.MoveRawPartPartAndFixture(nMoveId, vtMove, m_SelType, ptCurr)
EgtDraw()
' Aggiorno il punto precedente
m_ptPrev = ptCurr
@@ -981,6 +997,9 @@ Public Class ProjectVM
' Se eseguito drag
If Not m_bDragToStart Then
' Basta reset alla fine
+ ' se sono in modalità movimento barre
+ ElseIf m_SelType = DispositionUtility.SelType.BARS Then
+ ' Basta reset alla fine
' Se selezione da eseguire
ElseIf m_nIdToSel <> GDB_ID.NULL Then
' se sono in modalità sottopezzi
diff --git a/SetUp/SetUpVM.vb b/SetUp/SetUpVM.vb
index d0c8a90..29c9dce 100644
--- a/SetUp/SetUpVM.vb
+++ b/SetUp/SetUpVM.vb
@@ -297,7 +297,7 @@ Public Class SetUpVM
'''
''' Funzione che mantiene le posizioni ma elimina tutti gli utensili attrezzati
'''
- Private Sub ClearAllPos()
+ Friend Sub ClearAllPos()
For GroupIndex = 0 To m_PositionGroupList.Count - 1
For PositionIndex = 0 To m_PositionGroupList(GroupIndex).PositionList.Count - 1
For ExitIndex = 0 To m_PositionGroupList(GroupIndex).PositionList(PositionIndex).ExitToolAssociationList.Count - 1
diff --git a/ToolsDbWindow/ToolTreeView.vb b/ToolsDbWindow/ToolTreeView.vb
index cde096e..935932f 100644
--- a/ToolsDbWindow/ToolTreeView.vb
+++ b/ToolsDbWindow/ToolTreeView.vb
@@ -69,6 +69,7 @@ Public Class ToolTreeViewItem
Friend Shared m_delRemoveTool As Action(Of ToolTreeViewItem)
Friend Shared m_delErrorOnTool As Action(Of Boolean)
Friend Shared m_delIsEnabledBtns As Action(Of Boolean, Boolean, Boolean)
+ Friend Shared m_delGetSelectedTool As Func(Of ToolTreeViewItem)
#Region "Tool Property"
@@ -125,6 +126,9 @@ Public Class ToolTreeViewItem
End Select
End If
End If
+ ' ricarico utensile per avere valore Active e ricaricarlo
+ EgtTdbSetCurrTool(Me.Name)
+ NotifyPropertyChanged("Active")
NotifyPropertyChanged("IsSelected")
End If
End Set
@@ -179,6 +183,8 @@ Public Class ToolTreeViewItem
EgtTdbGetCurrToolParam(MCH_TP.EXIT_, DbExit)
Int32.TryParse(value, nValue)
m_IsModifiedSelectedExit = If(nValue <> DbExit, True, False)
+ ' se modificato disattivo l'utensile
+ If m_IsModifiedSelectedExit Then EgtTdbSetCurrToolParam(MCH_TP.ACTIVE, False)
If Not GetValidationError("SelectedExit") Then
m_delErrorOnTool(True)
m_delIsEnabledBtns(False, False, True)
@@ -821,6 +827,8 @@ Public Class ToolTreeViewItem
EgtSetCurrentContext(IniFile.m_ProjectSceneContext)
EgtTdbGetCurrToolParam(MCH_TP.HEAD, DbHead)
m_IsModifiedSelectedHead = If(value.HName <> DbHead, True, False)
+ ' se modificato disattivo l'utensile
+ If m_IsModifiedSelectedHead Then EgtTdbSetCurrToolParam(MCH_TP.ACTIVE, False)
If Not m_SuspendToolDrawUpdate Then
UpdateSceneToolDraw()
End If
@@ -971,6 +979,11 @@ Public Class ToolTreeViewItem
EgtSetCurrentContext(IniFile.m_ProjectSceneContext)
EgtTdbGetCurrToolParam(MCH_TP.TCPOS, DbTcPos)
m_IsModifiedSelectedTcPos = If(value <> DbTcPos, True, False)
+ ' se modificato disattivo l'utensile
+ If m_IsModifiedSelectedTcPos Then
+ Dim z = EgtTdbSetCurrToolParam(MCH_TP.ACTIVE, False)
+ NotifyPropertyChanged("Active")
+ End If
m_delIsEnabledBtns(IsValid And Not IsModified, IsValid, True)
NotifyPropertyChanged("SelectedTcPos")
End If
@@ -987,6 +1000,49 @@ Public Class ToolTreeViewItem
End Get
End Property
+ Private m_PreviousCurrentTool As String = String.Empty
+ Public Property Active As Boolean
+ Get
+ EgtSetCurrentContext(IniFile.m_ProjectSceneContext)
+ ' salvo utensile corrente precedente
+ EgtTdbGetCurrToolParam(MCH_TP.NAME, m_PreviousCurrentTool)
+ Dim bChangeTool As Boolean = m_PreviousCurrentTool <> Me.Name
+ If bChangeTool Then EgtTdbSetCurrTool(Me.Name)
+ Dim bActive As Boolean = False
+ EgtTdbGetCurrToolParam(MCH_TP.ACTIVE, bActive)
+ ' ripristino utensile corrente
+ If bChangeTool Then EgtTdbSetCurrTool(m_PreviousCurrentTool)
+ Return bActive
+ End Get
+ Set(value As Boolean)
+ EgtSetCurrentContext(IniFile.m_ProjectSceneContext)
+ ' salvo utensile corrente precedente
+ Dim t = EgtTdbGetCurrToolParam(MCH_TP.NAME, m_PreviousCurrentTool)
+ ' verifico se l'utensile selezionato è modificato
+ Dim SelTool As ToolTreeViewItem = m_delGetSelectedTool()
+ If Not IsNothing(SelTool) AndAlso SelTool.IsModified Then
+ ' chiedo di salvare
+ If MessageBox.Show(String.Format(EgtMsg(6144), Me.Name), EgtMsg(6143), MessageBoxButton.YesNo, MessageBoxImage.Question) <> MessageBoxResult.Yes Then
+ Return
+ End If
+ End If
+ ' se attivato, verifico che non sia in conflitto con altri utensili
+ If value Then
+ ' verifico se c'è un utensile con la stessa posizione
+ If Not VerifyAllPositions() Then
+ MessageBox.Show(EgtMsg(6145), EgtMsg(6126), MessageBoxButton.OK, MessageBoxImage.Exclamation)
+ Return
+ End If
+ End If
+ ' lo scrivo nel Db
+ EgtTdbSetCurrTool(Me.Name)
+ EgtTdbSetCurrToolParam(MCH_TP.ACTIVE, value)
+ Dim y = EgtTdbSaveCurrTool()
+ NotifyPropertyChanged("Active")
+ ' ripristino utensile corrente
+ Dim X = EgtTdbSetCurrTool(m_PreviousCurrentTool)
+ End Set
+ End Property
#End Region ' Tool Property
' Definizione comandi
@@ -1194,6 +1250,70 @@ Public Class ToolTreeViewItem
EgtTdbSetCurrToolParam(MCH_TP.NAME, NamePar)
End Sub
+ ' funzione che verifica se c'è attivo un utensile sulla stessa posizione
+ Private Function VerifyAllPositions() As Boolean
+ EgtSetCurrentContext(IniFile.m_ProjectSceneContext)
+ ' carico posizione, testa e uscita dell'utensile che si attiva
+ EgtTdbSetCurrTool(Me.Name)
+ Dim sCheckedTcPos As String = String.Empty
+ EgtTdbGetCurrToolParam(MCH_TP.TCPOS, sCheckedTcPos)
+ Dim sCheckedHead As String = String.Empty
+ EgtTdbGetCurrToolParam(MCH_TP.HEAD, sCheckedHead)
+ Dim nCheckedExit As Integer = 0
+ EgtTdbGetCurrToolParam(MCH_TP.EXIT_, nCheckedExit)
+ ' verifico su tutti gli utensili disponibili
+ Dim ActiveToolsFamilies() As ToolsFamily = MachineModel.ReadActiveToolsFamilies()
+ For Each ToolsFamily In ActiveToolsFamilies
+ Dim nType As Integer = 0
+ Dim ToolName As String = String.Empty
+ EgtSetCurrentContext(IniFile.m_ProjectSceneContext)
+ If EgtTdbGetFirstTool(ToolsFamily.FamilyId, ToolName, nType) Then
+ If ToolName <> Me.Name Then
+ EgtTdbSetCurrTool(ToolName)
+ If Not VerifyPosition(sCheckedTcPos, sCheckedHead, nCheckedExit) Then Return False
+ End If
+ While EgtTdbGetNextTool(ToolsFamily.FamilyId, ToolName, nType)
+ If ToolName <> Me.Name Then
+ EgtTdbSetCurrTool(ToolName)
+ If Not VerifyPosition(sCheckedTcPos, sCheckedHead, nCheckedExit) Then Return False
+ End If
+ End While
+ End If
+ Next
+ Return True
+ End Function
+
+ Private Function VerifyPosition(sCheckedTcPos As String, sCheckedHead As String, nCheckedExit As Integer) As Boolean
+ ' verifico se attivo
+ Dim DbActive As Boolean = False
+ EgtSetCurrentContext(IniFile.m_ProjectSceneContext)
+ If Not EgtTdbGetCurrToolParam(MCH_TP.ACTIVE, DbActive) Then DbActive = False
+ ' se non è attivo non lo considero e restituisco vero
+ If Not DbActive Then Return True
+ ' recupero posizione
+ Dim DbTcPos As String = String.Empty
+ EgtSetCurrentContext(IniFile.m_ProjectSceneContext)
+ EgtTdbGetCurrToolParam(MCH_TP.TCPOS, DbTcPos)
+ ' se la posizione è uguale controllo la testa
+ If sCheckedTcPos = DbTcPos Then
+ Dim DbHead As String = String.Empty
+ EgtSetCurrentContext(IniFile.m_ProjectSceneContext)
+ EgtTdbGetCurrToolParam(MCH_TP.HEAD, DbHead)
+ ' se la testa è uguale, controllo l'uscita
+ If sCheckedHead = DbHead Then
+ Dim DbExit As Integer = 0
+ EgtSetCurrentContext(IniFile.m_ProjectSceneContext)
+ EgtTdbGetCurrToolParam(MCH_TP.EXIT_, DbExit)
+ ' se l'uscita è uguale la posizione è già occupata
+ If nCheckedExit = DbExit Then Return False
+ Else
+ ' se la testa è diversa vuol dire che la posizione è già occupata
+ Return False
+ End If
+ End If
+ Return True
+ End Function
+
#End Region ' Methods
#Region "ToolSceneUpdate"
@@ -1228,33 +1348,33 @@ Public Class ToolTreeViewItem
Private Function CreateToolDraw() As Boolean
' Calcolo parametri per disegno
- Dim sHeadName As String = If( Not IsNothing( SelectedHead), SelectedHead.HName, "")
- Dim nExit As Integer = 0 : If Not IsNothing( SelectedExit) Then StringToInt( SelectedExit, nExit)
+ Dim sHeadName As String = If(Not IsNothing(SelectedHead), SelectedHead.HName, "")
+ Dim nExit As Integer = 0 : If Not IsNothing(SelectedExit) Then StringToInt(SelectedExit, nExit)
Dim nType As Integer = Type
- Dim dTotLen As Double = 0 : StringToLen(TotLen, dTotLen)
- Dim dLen As Double = 0 : StringToLen(Len, dLen)
- Dim dTotDiam As Double = 0 : StringToLen(TotDiam, dTotDiam)
- Dim dDiam As Double = 0 : StringToLen(Diam, dDiam)
- Dim dThick As Double = 0 : StringToLen(Thick, dThick)
- Dim dMaxMat As Double = 0 : StringToLen(MaxMat, dMaxMat)
- Dim dSideAng As Double = 0 : StringToDouble(SideAng, dSideAng)
- Dim dCornRad As Double = 0 : StringToLen(CornRad, dCornRad)
+ Dim dTotLen As Double = 0 : StringToLen(TotLen, dTotLen)
+ Dim dLen As Double = 0 : StringToLen(Len, dLen)
+ Dim dTotDiam As Double = 0 : StringToLen(TotDiam, dTotDiam)
+ Dim dDiam As Double = 0 : StringToLen(Diam, dDiam)
+ Dim dThick As Double = 0 : StringToLen(Thick, dThick)
+ Dim dMaxMat As Double = 0 : StringToLen(MaxMat, dMaxMat)
+ Dim dSideAng As Double = 0 : StringToDouble(SideAng, dSideAng)
+ Dim dCornRad As Double = 0 : StringToLen(CornRad, dCornRad)
Dim sDraw As String = Draw
-
+
EgtSetCurrentContext(IniFile.m_ProjectSceneContext)
' Salvo parametri originali dell'utensile corrente
- Dim sHeadNameOri As string = "" : EgtTdbGetCurrToolParam(MCH_TP.HEAD, sHeadNameOri)
- Dim nExitOri As Integer = 0 : EgtTdbGetCurrToolParam(MCH_TP.EXIT_, nExitOri)
- Dim nTypeOri As Integer = 0 : EgtTdbGetCurrToolParam(MCH_TP.TYPE, nTypeOri)
- Dim dTotLenOri As Double = 0 : EgtTdbGetCurrToolParam(MCH_TP.TOTLEN, dTotLenOri)
- Dim dLenOri As Double = 0 : EgtTdbGetCurrToolParam(MCH_TP.LEN, dLenOri)
- Dim dTotDiamOri As Double = 0 : EgtTdbGetCurrToolParam(MCH_TP.TOTDIAM, dTotDiamOri)
- Dim dDiamOri As Double = 0 : EgtTdbGetCurrToolParam(MCH_TP.DIAM, dDiamOri)
- Dim dThickOri As Double = 0 : EgtTdbGetCurrToolParam(MCH_TP.THICK, dThickOri)
- Dim dMaxMatOri As Double = 0 : EgtTdbGetCurrToolParam(MCH_TP.MAXMAT, dMaxMatOri)
- Dim dSideAngOri As Double = 0 : EgtTdbGetCurrToolParam(MCH_TP.SIDEANG, dSideAngOri)
- Dim dCornRadOri As Double = 0 : EgtTdbGetCurrToolParam(MCH_TP.CORNRAD, dCornRadOri)
- Dim sDrawOri As String = "" : EgtTdbGetCurrToolParam(MCH_TP.DRAW, sDrawOri)
+ Dim sHeadNameOri As String = "" : EgtTdbGetCurrToolParam(MCH_TP.HEAD, sHeadNameOri)
+ Dim nExitOri As Integer = 0 : EgtTdbGetCurrToolParam(MCH_TP.EXIT_, nExitOri)
+ Dim nTypeOri As Integer = 0 : EgtTdbGetCurrToolParam(MCH_TP.TYPE, nTypeOri)
+ Dim dTotLenOri As Double = 0 : EgtTdbGetCurrToolParam(MCH_TP.TOTLEN, dTotLenOri)
+ Dim dLenOri As Double = 0 : EgtTdbGetCurrToolParam(MCH_TP.LEN, dLenOri)
+ Dim dTotDiamOri As Double = 0 : EgtTdbGetCurrToolParam(MCH_TP.TOTDIAM, dTotDiamOri)
+ Dim dDiamOri As Double = 0 : EgtTdbGetCurrToolParam(MCH_TP.DIAM, dDiamOri)
+ Dim dThickOri As Double = 0 : EgtTdbGetCurrToolParam(MCH_TP.THICK, dThickOri)
+ Dim dMaxMatOri As Double = 0 : EgtTdbGetCurrToolParam(MCH_TP.MAXMAT, dMaxMatOri)
+ Dim dSideAngOri As Double = 0 : EgtTdbGetCurrToolParam(MCH_TP.SIDEANG, dSideAngOri)
+ Dim dCornRadOri As Double = 0 : EgtTdbGetCurrToolParam(MCH_TP.CORNRAD, dCornRadOri)
+ Dim sDrawOri As String = "" : EgtTdbGetCurrToolParam(MCH_TP.DRAW, sDrawOri)
' Imposto parametri correnti all'utensile corrente
EgtTdbSetCurrToolParam(MCH_TP.HEAD, sHeadName)
EgtTdbSetCurrToolParam(MCH_TP.EXIT_, nExit)
@@ -1270,7 +1390,7 @@ Public Class ToolTreeViewItem
EgtTdbSetCurrToolParam(MCH_TP.DRAW, sDraw)
' Creo il disegno
- m_nDrawingError = EgtTdbCurrToolDraw( IniFile.m_ProjectSceneContext, IniFile.m_ToolsDbSceneContext)
+ m_nDrawingError = EgtTdbCurrToolDraw(IniFile.m_ProjectSceneContext, IniFile.m_ToolsDbSceneContext)
EgtSetCurrentContext(IniFile.m_ProjectSceneContext)
' Ripristino i valori originali dell'utensile corrente
@@ -1716,9 +1836,9 @@ Public Class ToolTreeViewItem
m_DrawError = EgtMsg(MSG_TOOLSERRORS + 40) ' Il Massimo Materiale deve essere più grande del Raggio Corner
ElseIf m_nDrawingError = 22 Then
m_DrawError = EgtMsg(MSG_TOOLSERRORS + 34) ' La Lunghezza Totale deve essere maggiore di Lunghezza + Spessore
- ElseIf m_nDrawingError = 997 then
+ ElseIf m_nDrawingError = 997 Then
m_DrawError = EgtMsg(MSG_TOOLSERRORS + 3) ' Il file non esiste o non è Nge
- ElseIf m_nDrawingError = 998 then
+ ElseIf m_nDrawingError = 998 Then
m_DrawError = EgtMsg(MSG_TOOLSERRORS + 4) ' Non esiste il ToolMaker per questo tipo di utensile
ElseIf m_nDrawingError <> 0 Then
m_DrawError = EgtMsg(MSG_TOOLSERRORS + 5) ' Impossibile creare l'utensile con questi parametri
diff --git a/ToolsDbWindow/ToolsDbV.xaml b/ToolsDbWindow/ToolsDbV.xaml
index 0356289..6b0a10a 100644
--- a/ToolsDbWindow/ToolsDbV.xaml
+++ b/ToolsDbWindow/ToolsDbV.xaml
@@ -108,6 +108,10 @@
+
@@ -909,7 +913,7 @@
UpdateSourceTrigger=PropertyChanged}"/>-->
-
+
diff --git a/ToolsDbWindow/ToolsDbVM.vb b/ToolsDbWindow/ToolsDbVM.vb
index 14c5c68..9d52308 100644
--- a/ToolsDbWindow/ToolsDbVM.vb
+++ b/ToolsDbWindow/ToolsDbVM.vb
@@ -8,6 +8,8 @@ Imports EgtWPFLib5
Public Class ToolsDbVM
Inherits TabViewModel
+ Private Const SETUP_FILEEXTENSION As String = ".stu"
+
Friend Shared m_bActive As Boolean = False
Private m_Title As String
@@ -73,6 +75,14 @@ Public Class ToolsDbVM
End Get
End Property
+ ' visibilità parametro Active
+ Private m_Active_Visibility As Boolean
+ Public ReadOnly Property Active_Visibility As Visibility
+ Get
+ Return If(m_Active_Visibility, Visibility.Visible, Visibility.Collapsed)
+ End Get
+ End Property
+
Private Sub OnCursorPos(ByVal sender As Object, ByVal sCursorPos As String) Handles m_ToolScene.OnCursorPos
Application.Msn.NotifyColleagues(Application.NOTIFYCURRPOS, sCursorPos)
End Sub
@@ -265,6 +275,8 @@ Public Class ToolsDbVM
' Passo all'item della lista il delegato alla funzuione che permette di disattivare la lista delle lavorazioni
ToolTreeViewItem.m_delIsEnabledBtns = AddressOf IsEnabledBtns
FamilyToolTreeViewItem.m_delIsEnabledBtns = AddressOf IsEnabledBtns
+ ' Passo all'item della lista il delegato alla funzuione che restituisce l'utensile selezionato
+ ToolTreeViewItem.m_delGetSelectedTool = AddressOf GetSelectedTool
LoadSelectedMachineTools()
@@ -317,6 +329,8 @@ Public Class ToolsDbVM
EgtOutLog("Error: SetUp configuration file not found!")
End If
+ ' leggo da ini se parametro Active è attivo
+ m_Active_Visibility = (EgtUILib.GetPrivateProfileInt(S_TOOLS, K_ACTIVE, 0, IniFile.m_sCurrMachIniFilePath) <> 0)
End Sub
#End Region ' Constructor
@@ -365,6 +379,96 @@ Public Class ToolsDbVM
End Sub
+ Private Function GetSelectedTool() As ToolTreeViewItem
+ For Each ToolFamily In m_ToolsList
+ For Each Tool In ToolFamily.Items
+ If Tool.m_IsSelected Then
+ Return DirectCast(Tool, ToolTreeViewItem)
+ End If
+ Next
+ Next
+ Return Nothing
+ End Function
+
+ ' Funzione che aggiorna setup default con tool che hanno patametro Active
+ Private Function UpdateDefSetup() As Boolean
+ InitSetupFile()
+ ' Creo Setup
+ Dim DefSetup As New SetUpVM
+ ' inizializzo ambiente setup
+ DefSetup.InitSetUp()
+ ' resetto lista utensili e posizioni
+ DefSetup.ToolsList.Clear()
+ DefSetup.ClearAllPos()
+ DefSetup.LoadMachineTools()
+ ' ciclo sugli utensili del db
+ For Each ToolFamily In m_ToolsList
+ For Each Tool In ToolFamily.Items
+ Dim ToolItem As ToolTreeViewItem = DirectCast(Tool, ToolTreeViewItem)
+ ' verifico se Active
+ If ToolItem.Active Then
+ For Each TF In DefSetup.ToolsList
+ For TIndex = TF.Items.Count - 1 To 0 Step -1
+ Dim T As ToolItem = DirectCast(TF.Items(TIndex), ToolItem)
+ If ToolItem.Name = T.Name Then
+ DefSetup.ToolDoubleClick(T)
+ End If
+ Next
+ Next
+ End If
+ Next
+ Next
+ Dim DefSetupPath As String = IniFile.m_sMachinesRoot & "\" & IniFile.m_sMachineName & "\SetUp"
+ Dim DefSetupName As String = String.Empty
+ EgtUILib.GetPrivateProfileString(S_SETUP, K_DEFAULT, "", DefSetupName, IniFile.m_sCurrMachIniFilePath)
+ DefSetupPath += "\" & DefSetupName & SETUP_FILEEXTENSION
+ If Not DefSetup.Save(DefSetupPath) Then EgtOutLog("Impossible to save default setup.")
+ Return True
+ End Function
+
+ ' Inizializzo file Setup
+ Private Sub InitSetupFile()
+ ' verifico che il file di configurazione attrezzaggio (lua) della macchina esista
+ If Not File.Exists(IniFile.m_sCurrMachScriptsDirPath & "\" & SETUP_LUA) Then
+ EgtOutLog("SetUp error: SetUp configuration file doesn't exist ")
+ MessageBox.Show(EgtMsg(MSG_SETUPERRORS + 7), EgtMsg(MSG_SETUPERRORS + 1), MessageBoxButton.OK, MessageBoxImage.Error)
+ Return
+ End If
+ ' carico Lua che contiene le funzioni per ottenere le posizioni valide dell'utensile selezionato,
+ ' e testa e uscita dell'utensile attrezzato
+ EgtLuaExecFile(IniFile.m_sCurrMachScriptsDirPath & "\" & SETUP_LUA)
+ ' verifico che le teste riportate in configurazione esistano
+ Dim Index As Integer = 1
+ Dim nErr As Integer = 0
+ While nErr = 0
+ Dim sHead As String = String.Empty
+ nErr = 999
+ EgtLuaSetGlobIntVar("STU.INDEX", Index)
+ EgtLuaCallFunction("STU.GetTcPosHeadGroupFromPos")
+ ' Leggo variabili
+ EgtLuaGetGlobStringVar("STU.HEAD", sHead)
+ EgtLuaGetGlobIntVar("STU.ERR", nErr)
+ If nErr = 0 Then
+ If EgtGetHeadExitCount(sHead) = 0 Then
+ MessageBox.Show(EgtMsg(MSG_SETUPERRORS + 8), EgtMsg(MSG_SETUPERRORS + 1), MessageBoxButton.OK, MessageBoxImage.Error)
+ Return
+ End If
+ End If
+ Index += 1
+ End While
+ ' Verifico esistenza direttorio per attrezzaggi
+ Dim sDir As String = IniFile.m_sMachinesRoot & "\" & IniFile.m_sMachineName & "\SetUp"
+ If Not Directory.Exists(sDir) Then
+ Try
+ Directory.CreateDirectory(sDir)
+ Catch ex As Exception
+ EgtOutLog("Error in SetupDir creation " & ex.ToString())
+ Return
+ End Try
+ End If
+
+ End Sub
+
#End Region ' Methods
#Region "COMMANDS"
@@ -616,6 +720,11 @@ Public Class ToolsDbVM
EgtTdbSave()
' Reset lua
EgtLuaResetGlobVar("STU")
+ ' Se c'è il parametro Active sugli utensili
+ If m_Active_Visibility Then
+ ' aggiorno setup di default
+ UpdateDefSetup()
+ End If
' Chiusura finestra
ToolTreeViewItem.m_delRemoveTool = Nothing
ToolTreeViewItem.m_delErrorOnTool = Nothing