68ee975722
- aggiunta gestione drop dei file - aggiunto aggiornamento disegno utensile all'aggiornamento in batch dei dati utensili.
261 lines
11 KiB
VB.net
261 lines
11 KiB
VB.net
Imports System.IO
|
|
Imports System.Globalization
|
|
Imports EgtUILib
|
|
|
|
Module ToolsUpdate
|
|
|
|
' Classe CLD (correttore, lunghezza, diametro) di un utensile
|
|
Class CldTool
|
|
' Membri
|
|
Friend nCorr As Integer
|
|
Friend dLen As Double
|
|
Friend dDiam As Double
|
|
' Costruttori
|
|
Sub New()
|
|
nCorr = 0
|
|
dLen = 0
|
|
dDiam = 0
|
|
End Sub
|
|
Sub New(nC As Integer, dL As Double, dD As Double)
|
|
nCorr = nC
|
|
dLen = dL
|
|
dDiam = dD
|
|
End Sub
|
|
End Class
|
|
|
|
' Classe di confronto tra utensili basata sul numero di correttore
|
|
Class CldToolComparer
|
|
Implements IComparer(Of CldTool)
|
|
' Funzione di confronto
|
|
Friend Function Compare(x As CldTool, y As CldTool) As Integer Implements IComparer(Of CldTool).Compare
|
|
If x.nCorr > y.nCorr Then Return 1
|
|
If x.nCorr < y.nCorr Then Return -1
|
|
Return 0
|
|
End Function
|
|
End Class
|
|
|
|
Friend Function UpdateTools(sFile As String, sMachine As String, bTest As Boolean) As Boolean
|
|
EgtOutLog("-- Start UpdateTools --")
|
|
' Inizializzo stato senza errori
|
|
Dim nErr As Integer = 0
|
|
Dim sErrFile As String = Path.ChangeExtension(sFile, ".txt")
|
|
Try
|
|
My.Computer.FileSystem.DeleteFile(sErrFile)
|
|
Catch ex As Exception
|
|
End Try
|
|
' Vettore di Cld degli utensili
|
|
Dim vCldTool As New List(Of CldTool)(256)
|
|
' Lettura file utensili
|
|
If Not LoadTools(sFile, vCldTool) Then
|
|
WriteErrorFile(sErrFile, 1, Nothing)
|
|
Return False
|
|
End If
|
|
' Imposto la macchina corrente
|
|
If Not EgtSetCurrMachine(sMachine) Then
|
|
WriteErrorFile(sErrFile, 2, Nothing)
|
|
Return False
|
|
End If
|
|
' Eseguo aggiornamento
|
|
Dim sInfo As String = String.Empty
|
|
If Not ExecUpdate(vCldTool, bTest, sInfo) Then
|
|
WriteErrorFile(sErrFile, 3, sInfo)
|
|
Return False
|
|
End If
|
|
' Salvo informazioni
|
|
WriteErrorFile(sErrFile, 0, sInfo)
|
|
Return True
|
|
End Function
|
|
|
|
Private Function LoadTools(sFile As String, ByRef vCldTool As List(Of CldTool)) As Boolean
|
|
' Classe di confronto
|
|
Dim ToolComp As New CldToolComparer
|
|
' Leggo i dati degli utensili dal file
|
|
Try
|
|
Dim sr As StreamReader = New StreamReader(sFile)
|
|
Do While sr.Peek() > -1
|
|
' Leggo la linea
|
|
Dim sLine As String = sr.ReadLine()
|
|
' La divido usando come separatore ';'
|
|
Dim sItems() As String = sLine.Split(";".ToCharArray)
|
|
' Ci devono essere almeno tre parti
|
|
If sItems.Count() < 3 Then Continue Do
|
|
' Leggo i valori
|
|
Dim OneCldT As New CldTool
|
|
If Not Integer.TryParse(sItems(0), OneCldT.nCorr) OrElse OneCldT.nCorr = 0 Then Continue Do
|
|
If Not Double.TryParse(sItems(1), NumberStyles.Float, CultureInfo.InvariantCulture, OneCldT.dLen) Then Continue Do
|
|
If Not Double.TryParse(sItems(2), NumberStyles.Float, CultureInfo.InvariantCulture, OneCldT.dDiam) Then Continue Do
|
|
' Se non c'è già un record con lo stesso correttore, lo inserisco
|
|
Dim nI As Integer = vCldTool.BinarySearch(OneCldT, ToolComp)
|
|
If nI < 0 Then
|
|
Dim nNextI = Not nI
|
|
vCldTool.Insert(nNextI, OneCldT)
|
|
End If
|
|
Loop
|
|
sr.Close()
|
|
Return True
|
|
Catch ex As Exception
|
|
Return False
|
|
End Try
|
|
End Function
|
|
|
|
Private Function ExecUpdate(ByRef vCldTool As List(Of CldTool), bTest As Boolean, ByRef sInfo As String) As Boolean
|
|
' Classe di confronto
|
|
Dim ToolComp As New CldToolComparer
|
|
' Leggo direttorio toolmakers
|
|
GetPrivateProfileString(S_MACH, K_TOOLMAKERSDIR, "", IniFile.m_sToolMakersDir)
|
|
' Ciclo su tutti gli utensili nel DB
|
|
Const ALL_TOOLS As Integer = MCH_TF.DRILLBIT + MCH_TF.SAWBLADE + MCH_TF.MILL + MCH_TF.MORTISE + MCH_TF.CHISEL + MCH_TF.COMPO
|
|
Dim sName As String = String.Empty
|
|
Dim nType As Integer = 0
|
|
Dim bNext As Boolean = EgtTdbGetFirstTool(ALL_TOOLS, sName, nType)
|
|
While bNext
|
|
EgtTdbSetCurrTool(sName)
|
|
Dim nCorr As Integer = 0
|
|
EgtTdbGetCurrToolParam(MCH_TP.CORR, nCorr)
|
|
If nCorr > 0 Then
|
|
Dim nI As Integer = vCldTool.BinarySearch(New CldTool(nCorr, 0, 0), ToolComp)
|
|
If nI >= 0 Then
|
|
' Recupero i dati dell'utensile nel DB
|
|
Dim dLen As Double = 0
|
|
EgtTdbGetCurrToolParam(MCH_TP.LEN, dLen)
|
|
Dim dTotLen As Double = 0
|
|
EgtTdbGetCurrToolParam(MCH_TP.TOTLEN, dTotLen)
|
|
Dim dDiam As Double = 0
|
|
EgtTdbGetCurrToolParam(MCH_TP.DIAM, dDiam)
|
|
Dim dTotDiam As Double = 0
|
|
EgtTdbGetCurrToolParam(MCH_TP.TOTDIAM, dTotDiam)
|
|
Dim dMaxMat As Double = 0
|
|
EgtTdbGetCurrToolParam(MCH_TP.MAXMAT, dMaxMat)
|
|
' Modifiche della lunghezza
|
|
Dim dDeltaL As Double = 0
|
|
If vCldTool(nI).dLen > EPS_SMALL Then
|
|
dDeltaL = vCldTool(nI).dLen - dLen
|
|
EgtTdbSetCurrToolParam(MCH_TP.LEN, vCldTool(nI).dLen)
|
|
EgtTdbSetCurrToolParam(MCH_TP.TOTLEN, dTotLen + dDeltaL)
|
|
End If
|
|
' Modifiche del diametro
|
|
Dim dDeltaD As Double = 0
|
|
If vCldTool(nI).dDiam > EPS_SMALL And
|
|
(nType = MCH_TY.SAW_STD Or nType = MCH_TY.SAW_FLAT Or nType = MCH_TY.MILL_STD Or nType = MCH_TY.MILL_NOTIP Or nType = MCH_TY.CHISEL_STD) Then
|
|
dDeltaD = vCldTool(nI).dDiam - dDiam
|
|
EgtTdbSetCurrToolParam(MCH_TP.DIAM, vCldTool(nI).dDiam)
|
|
EgtTdbSetCurrToolParam(MCH_TP.TOTDIAM, dTotDiam + dDeltaD)
|
|
End If
|
|
' Aggiornamento del massimo materiale lavorabile
|
|
If nType = MCH_TY.SAW_STD Or nType = MCH_TY.SAW_FLAT Then
|
|
EgtTdbSetCurrToolParam(MCH_TP.MAXMAT, dMaxMat + dDeltaD / 2)
|
|
Else
|
|
EgtTdbSetCurrToolParam(MCH_TP.MAXMAT, dMaxMat + dDeltaL)
|
|
End If
|
|
' Se non esiste il disegno dell'utensile o modificato
|
|
Dim sDrawStat As String = "Ok"
|
|
Dim sDraw As String = String.Empty
|
|
EgtTdbGetCurrToolParam(MCH_TP.DRAW, sDraw)
|
|
Dim sPath As String = String.Empty
|
|
EgtTdbGetToolDir(sPath)
|
|
sPath = sPath & "\" & sDraw
|
|
If Not bTest And (EgtTdbIsCurrToolModified() OrElse Not File.Exists(sPath)) Then
|
|
' Se disegno automatico, lo aggiorno
|
|
If IsUUID(Path.GetFileNameWithoutExtension(sDraw)) Then
|
|
If ExecToolDraw(sDraw) Then
|
|
sDrawStat = "Modified"
|
|
Else
|
|
sDrawStat = "Editing Error"
|
|
End If
|
|
End If
|
|
End If
|
|
' Se non è test salvo modifiche utensile
|
|
If Not bTest Then EgtTdbSaveCurrTool()
|
|
' informazioni
|
|
Dim sOut As String = sName & " (" & ToolTypeToString(nType) & ")" & " C=" & nCorr.ToString() &
|
|
" L=" & dLen.ToString("F3", CultureInfo.InvariantCulture) &
|
|
" D=" & dDiam.ToString("F3", CultureInfo.InvariantCulture) &
|
|
" NewL=" & vCldTool(nI).dLen.ToString("F3", CultureInfo.InvariantCulture) &
|
|
" NewD=" & vCldTool(nI).dDiam.ToString("F3", CultureInfo.InvariantCulture) &
|
|
" Draw=" & sDrawStat
|
|
sInfo &= sOut & vbCrLf
|
|
EgtOutLog(sOut)
|
|
Else
|
|
Dim sOut As String = sName & " (" & ToolTypeToString(nType) & ")" & " C=" & nCorr.ToString() & " not found"
|
|
sInfo &= sOut & vbCrLf
|
|
EgtOutLog(sOut)
|
|
End If
|
|
Else
|
|
Dim sOut As String = sName & " (" & ToolTypeToString(nType) & ")" & " without corrector"
|
|
sInfo &= sOut & vbCrLf
|
|
EgtOutLog(sOut)
|
|
End If
|
|
bNext = EgtTdbGetNextTool(ALL_TOOLS, sName, nType)
|
|
End While
|
|
' Se non è test, salvo il DB utensili modificato
|
|
If Not bTest Then EgtTdbSave()
|
|
Return True
|
|
End Function
|
|
|
|
Private Function ExecToolDraw(sName As String) As Boolean
|
|
' Recupero dati dell'utensile corrente
|
|
EgtTdbGetCurrToolParam(MCH_TP.HEAD, ToolDraw.sHeadName)
|
|
Dim nExit As Integer = 0
|
|
EgtTdbGetCurrToolParam(MCH_TP.EXIT_, nExit)
|
|
ToolDraw.sExitName = nExit.ToString()
|
|
EgtTdbGetCurrToolParam(MCH_TP.EXIT_, nExit)
|
|
EgtTdbGetCurrToolParam(MCH_TP.TYPE, ToolDraw.nType)
|
|
EgtTdbGetCurrToolParam(MCH_TP.TOTLEN, ToolDraw.dTotLen)
|
|
EgtTdbGetCurrToolParam(MCH_TP.LEN, ToolDraw.dLen)
|
|
EgtTdbGetCurrToolParam(MCH_TP.TOTDIAM, ToolDraw.dTotDiam)
|
|
EgtTdbGetCurrToolParam(MCH_TP.DIAM, ToolDraw.dDiam)
|
|
EgtTdbGetCurrToolParam(MCH_TP.THICK, ToolDraw.dThick)
|
|
EgtTdbGetCurrToolParam(MCH_TP.MAXMAT, ToolDraw.dMaxMat)
|
|
EgtTdbGetCurrToolParam(MCH_TP.SIDEANG, ToolDraw.dSideAng)
|
|
EgtTdbGetCurrToolParam(MCH_TP.CORNRAD, ToolDraw.dCornRad)
|
|
' Creo contesto temporaneo per disegno utensile
|
|
Dim nTempCtx As Integer = EgtInitContext()
|
|
If nTempCtx = 0 Then Return False
|
|
ToolDraw.nToolContext = nTempCtx
|
|
' Creo il disegno dell'utensile
|
|
If Not ToolDraw.Create() Then Return False
|
|
' Salvo il disegno dell'utensile
|
|
Dim bOk As Boolean = ToolDraw.Save(sName)
|
|
' Cancello il contesto temporaneo e ripristino quello di progetto
|
|
EgtDeleteContext(nTempCtx)
|
|
EgtSetCurrentContext(IniFile.m_ProjectSceneContext)
|
|
Return bOk
|
|
End Function
|
|
|
|
Private Function ToolTypeToString(nType As Integer) As String
|
|
Select Case nType
|
|
Case MCH_TY.DRILL_STD
|
|
Return "Drill"
|
|
Case MCH_TY.DRILL_LONG
|
|
Return "LongDrill"
|
|
Case MCH_TY.SAW_STD
|
|
Return "Saw"
|
|
Case MCH_TY.SAW_FLAT
|
|
Return "FlatSaw"
|
|
Case MCH_TY.MILL_STD
|
|
Return "Mill"
|
|
Case MCH_TY.MILL_NOTIP
|
|
Return "NoTipMill"
|
|
Case MCH_TY.CHISEL_STD
|
|
Return "Chisel"
|
|
Case MCH_TY.COMPO
|
|
Return "Compo"
|
|
Case Else
|
|
Return "Unknown"
|
|
End Select
|
|
End Function
|
|
|
|
Private Function WriteErrorFile(sErrFile As String, nErr As Integer, sInfo As String) As Boolean
|
|
Try
|
|
Dim sw As StreamWriter = New StreamWriter(sErrFile)
|
|
sw.WriteLine("Err=" & nErr.ToString())
|
|
If Not IsNothing(sInfo) Then sw.WriteLine(sInfo)
|
|
sw.Close()
|
|
Return True
|
|
Catch ex As Exception
|
|
Return False
|
|
End Try
|
|
End Function
|
|
|
|
End Module
|