DarioS
2eacaff301
- aggiunta gestione svuotature (manca scelta lavorazione da interfaccia) - ora compilazione richiede dichiarazione delle variabili, modificati di conseguenza i diversi sorgenti.
98 lines
3.6 KiB
VB.net
98 lines
3.6 KiB
VB.net
Imports EgtUILib
|
|
|
|
Module Engrave
|
|
|
|
Private m_MainWindow As MainWindow = DirectCast(Application.Current.MainWindow, MainWindow)
|
|
|
|
Friend Sub ColorToEngrave(nCtx As Integer)
|
|
' Leggo dati corrispondenza colore-angolo
|
|
Dim CurrCE As New ColorEngrave
|
|
CurrCE.Read(m_MainWindow.GetIniFile)
|
|
' Imposto contesto corrente
|
|
EgtSetCurrentContext(nCtx)
|
|
' Ciclo sui pezzi
|
|
Dim PartId As Integer = EgtGetFirstPart()
|
|
While PartId <> GDB_ID.NULL
|
|
' Ciclo sui layer di Engraving
|
|
Dim LayerId As Integer = EgtGetFirstNameInGroup(PartId, NAME_ONPATH)
|
|
While LayerId <> GDB_ID.NULL
|
|
' Ciclo sulle curve
|
|
Dim EntId As Integer = EgtGetFirstInGroup(LayerId)
|
|
While EntId <> GDB_ID.NULL
|
|
Dim colEnt As Color3d
|
|
If EgtGetColor(EntId, colEnt) Then
|
|
Dim dAff, dLar As Double
|
|
If CurrCE.GetEngraveAff(colEnt, dAff, dLar) Then
|
|
EgtSetInfo(EntId, INFO_DEPTH, dAff)
|
|
EgtSetInfo(EntId, INFO_WIDTH, dLar)
|
|
End If
|
|
End If
|
|
EntId = EgtGetNext(EntId)
|
|
End While
|
|
LayerId = EgtGetNextLayer(LayerId)
|
|
End While
|
|
PartId = EgtGetNextPart(PartId)
|
|
End While
|
|
End Sub
|
|
|
|
Friend Class ColorEngrave
|
|
Class CTE
|
|
Friend m_bOk As Boolean
|
|
Friend m_R As Integer
|
|
Friend m_G As Integer
|
|
Friend m_B As Integer
|
|
Friend m_dAff As Double
|
|
Friend m_dLar As Double
|
|
End Class
|
|
Private m_ListCte As New List(Of CTE)
|
|
Private m_nTol As Integer = 10
|
|
|
|
Friend Function Read(sIniFile As String) As Boolean
|
|
' Lettura parametri di conversione
|
|
Dim nIndex As Integer = 1
|
|
Dim OneCte As CTE = GetPrivateProfileColorEngrave(S_COLORTOENGRAVE, K_CTE & nIndex, sIniFile)
|
|
While Not IsNothing(OneCte)
|
|
m_ListCte.Add(OneCte)
|
|
nIndex += 1
|
|
OneCte = GetPrivateProfileColorEngrave(S_COLORTOENGRAVE, K_CTE & nIndex, sIniFile)
|
|
End While
|
|
' Lettura tolleranza
|
|
m_nTol = GetPrivateProfileInt(S_COLORTOENGRAVE, K_CTE_TOLERANCE, 10, sIniFile)
|
|
Return True
|
|
End Function
|
|
|
|
Private Function GetPrivateProfileColorEngrave(sSect As String, sKey As String, sIniFile As String) As CTE
|
|
Dim OneCte As New CTE
|
|
Dim sVal As String = String.Empty
|
|
GetPrivateProfileString(sSect, sKey, "", sVal, sIniFile)
|
|
Dim sItems() As String = sVal.Split(",".ToCharArray)
|
|
OneCte.m_bOk = If(sItems.Count() = 6, (sItems(5).Trim() <> "0"), True)
|
|
If sItems.Count() >= 5 Then
|
|
StringToInt(sItems(0), OneCte.m_R)
|
|
StringToInt(sItems(1), OneCte.m_G)
|
|
StringToInt(sItems(2), OneCte.m_B)
|
|
StringToDouble(sItems(3), OneCte.m_dAff)
|
|
StringToDouble(sItems(4), OneCte.m_dLar)
|
|
Return OneCte
|
|
End If
|
|
Return Nothing
|
|
End Function
|
|
|
|
Friend Function GetEngraveAff(cCol As Color3d, ByRef dAff As Double, ByRef dLar As Double) As Boolean
|
|
For Each Ctsa As CTE In m_ListCte
|
|
If Ctsa.m_bOk And
|
|
Math.Abs(cCol.R - Ctsa.m_R) < m_nTol And
|
|
Math.Abs(cCol.G - Ctsa.m_G) < m_nTol And
|
|
Math.Abs(cCol.B - Ctsa.m_B) < m_nTol Then
|
|
dAff = Ctsa.m_dAff
|
|
dLar = Ctsa.m_dLar
|
|
Return True
|
|
End If
|
|
Next
|
|
Return False
|
|
End Function
|
|
|
|
End Class
|
|
|
|
End Module
|