Nicola Pievani
617 lines
25 KiB
VB.net
617 lines
25 KiB
VB.net
Imports System.Globalization
|
|
Imports System.Diagnostics
|
|
Imports System.Collections.ObjectModel
|
|
Imports System.Text.RegularExpressions
|
|
Imports EgtWPFLib
|
|
Imports EgtUILib
|
|
|
|
Module Utility
|
|
|
|
'--------------------------------------------------------------------------------------------------
|
|
#Region "COMPO SOLID3d"
|
|
|
|
Friend Function CreateSolid3D(sIniFile As String) As Boolean
|
|
EgtSaveFile("C:\EgtData\OmagCUT\Temp\Ribasso.nge", NGE.TEXT)
|
|
Dim bOk As Boolean = False
|
|
Dim dRawHeight As Double = GetPrivateProfileDouble(S_RAWPART, K_RAWHEIGHT, 30, sIniFile)
|
|
' se abilitato e dimensione solido da sotto: creo il solido
|
|
Dim sPathSOLID As String = String.Empty
|
|
If GetPrivateProfileString(S_SIDES, "CreateSOLID", "", sPathSOLID, sIniFile) <> 0 And
|
|
GetPrivateProfileInt(S_SIDES, K_SIZEALWAYSONTOP, 0, sIniFile) = 0 Then
|
|
' Recupero file LUA
|
|
EgtLuaExecFile(sPathSOLID)
|
|
Dim dThick As Double = dRawHeight
|
|
EgtLuaSetGlobNumVar("CMP.THICK", dThick)
|
|
bOk = EgtLuaExecLine("CMP_Draw(false)")
|
|
Dim nErr As Integer = 0
|
|
EgtLuaGetGlobIntVar("CMP.ERR", nErr)
|
|
' Reset lua
|
|
EgtLuaResetGlobVar("CMP")
|
|
Else
|
|
EgtOutLog("CreateSolid3d Failed: file '" & sPathSOLID & "' not found or parameter 'SizeAlwaysOnTop' is TRUE")
|
|
End If
|
|
Return bOk
|
|
End Function
|
|
|
|
#End Region ' Compo Solid3d
|
|
'--------------------------------------------------------------------------------------------------
|
|
|
|
Friend Function CompoColor(sIniFile As String) As Color3d
|
|
Dim InsertColor As New Color3d(89, 210, 210, 25)
|
|
Dim IndexColor As Integer = GetPrivateProfileInt(S_COMPO, K_LASTCOLOR, 1, sIniFile)
|
|
If Not GetPrivateProfileColor(S_COMPO, K_COLOR & IndexColor.ToString, InsertColor, sIniFile) Then
|
|
IndexColor = 1
|
|
GetPrivateProfileColor(S_COMPO, K_COLOR & IndexColor.ToString, InsertColor, sIniFile)
|
|
End If
|
|
WritePrivateProfileString(S_COMPO, K_LASTCOLOR, (IndexColor + 1).ToString, sIniFile)
|
|
Return InsertColor
|
|
End Function
|
|
|
|
|
|
Friend StopWatch As Stopwatch
|
|
|
|
Friend Sub TimeSpanInit()
|
|
StopWatch = New Stopwatch
|
|
StopWatch.Start()
|
|
End Sub
|
|
|
|
Friend Function TimeSpanEnd()
|
|
Dim sTime As String = ""
|
|
If Not IsNothing(StopWatch) Then
|
|
StopWatch.Stop()
|
|
Dim ts As TimeSpan = StopWatch.Elapsed
|
|
sTime = String.Format("{0:00}:{1:00}:{2:00}.{3:000}", ts.Hours, ts.Minutes, ts.Seconds, ts.Milliseconds)
|
|
End If
|
|
Return sTime
|
|
End Function
|
|
|
|
'--------------------------------------------------------------------------------------------------
|
|
Friend Sub UpdateUI()
|
|
' Costringo ad aggiornare UI
|
|
Dim nDummy As Integer
|
|
Application.Current.Dispatcher.Invoke(Windows.Threading.DispatcherPriority.Background,
|
|
New Action(Function() nDummy = 0))
|
|
End Sub
|
|
|
|
'--------------------------------------------------------------------------------------------------
|
|
#Region "INCHES FRACTIONS"
|
|
'Enum FractionPattern
|
|
' None
|
|
' Feet_Inches
|
|
' Inches
|
|
'End Enum
|
|
|
|
'' seleziona il tipo di Pattern con cui stamoare i dati
|
|
Friend nCurrFractionPattern As FractionStringConverter.FractionPattern = FractionPattern.Feet_Inches
|
|
Friend dPrecision As Double = 64
|
|
|
|
'Friend Function StringFractionToStringDecimal(dVal As Double, dBase As Double) As String
|
|
' Dim sSign As String = String.Empty
|
|
' If dVal < 0 Then
|
|
' sSign = "-"
|
|
' dVal = Math.Abs(dVal)
|
|
' End If
|
|
' Dim sFraction As String = String.Empty
|
|
' ' integer and decima part of the value
|
|
' Dim dInteger As Double = Math.Floor(dVal)
|
|
' Dim dFraction As Double = dVal - dInteger
|
|
' ' the nearest decimal numerator
|
|
' Dim dNumeretor As Double = dFraction * dBase
|
|
' Dim dRound As Double = Math.Round(dNumeretor)
|
|
' ' estimates the irreducible fraction
|
|
' If dRound = 0 Then
|
|
' ' no decimal part
|
|
' ElseIf dRound = dBase Then
|
|
' ' no decimal part
|
|
' dInteger = dInteger + 1
|
|
' Else
|
|
' ' simplify fraction
|
|
' While dRound Mod 2 = 0
|
|
' dRound = dRound / 2
|
|
' dBase = dBase / 2
|
|
' End While
|
|
' sFraction = DoubleToString(dRound, 0) & "/" & DoubleToString(dBase, 0)
|
|
' End If
|
|
' ' sVal: dFeet'dInteger"sFraction --- dInteger sFraction
|
|
' Return WriteFraction(dInteger, sFraction)
|
|
'End Function
|
|
|
|
'' trasforma il valore da pollici a piedi
|
|
'Private Sub ConvertInchesToFeet(ByRef dFeet As Double, ByRef dInches As Double)
|
|
' If dInches = 0 Then Return
|
|
' While dInches - 12 >= 0
|
|
' dFeet = dFeet + 1
|
|
' dInches = dInches - 12
|
|
' End While
|
|
'End Sub
|
|
|
|
'' stampa dati in funzione del pattern dichiarato
|
|
'Private Function WriteFraction(ByVal dInches As Double, sFraction As String) As String
|
|
' Dim sVal As String = String.Empty
|
|
' Select Case nCurrFractionPattern
|
|
' Case FractionPattern.Feet_Inches
|
|
' Dim dFeet As Double = 0
|
|
' ConvertInchesToFeet(dFeet, dInches)
|
|
' If dFeet > 0 Then
|
|
' sVal = String.Format("{0}'{1}""{2}", DoubleToString(dFeet, 0), DoubleToString(dInches, 0), sFraction).Trim
|
|
' Else
|
|
' sVal = String.Format("{0}""{1}", DoubleToString(dInches, 0), sFraction).Trim
|
|
' End If
|
|
' Case FractionPattern.Inches
|
|
' sVal = DoubleToString(dInches, 0) & " " & sFraction
|
|
' sVal = String.Format("{0}""{1}", DoubleToString(dInches, 0), sFraction).Trim
|
|
' End Select
|
|
' Return sVal
|
|
'End Function
|
|
|
|
'' riceve la stringa sorgente e restituisce la nuova strunga in formato decimale (senza eseguire conversioni di unità)
|
|
'Friend Function StringFractionToDouble(sVal As String, ByRef sValConverted As String) As Boolean
|
|
' Dim dVal As Double = 0
|
|
' ' dato in ingresso: sVal = 2'3"23/32
|
|
' Dim sFeet As String = String.Empty
|
|
' Dim sFeetPattern As String = "^.*?(?=')"
|
|
' Dim dFeet As Double = 0
|
|
' Dim bOkFeet As Boolean = True
|
|
' Dim bFeetExists As Boolean = False
|
|
' Dim sInch As String = String.Empty
|
|
' Dim sInchPattern As String = "(?<=')(.*?)(?="")" ' se la stringa contiene l'apice singolo
|
|
' Dim sInchPattern1 As String = "(.*?)(?="")" ' se la stringa NON contiene l'apice singolo
|
|
' Dim dInch As Double = 0
|
|
' Dim bOkInch As Boolean = True
|
|
' Dim bInchExists As Boolean = False
|
|
' Dim sFraction As String = String.Empty
|
|
' Dim sFractionPattern As String = "(?<="")(.*)" ' se la stringa contiene l'apice doppio
|
|
' Dim sFractionPattern1 As String = "(?<=')(.*)" ' se la stringa NON contiene l'apice doppio ma solo quello singolo
|
|
' Dim dFraction As Double = 0
|
|
' Dim bOkFraction As Boolean = True
|
|
' Dim bFractionExists As Boolean = False
|
|
|
|
' ' recupero il valore di Feet (2')
|
|
' Dim sMyMatch As String = Regex.Match(sVal, sFeetPattern).Groups(1).Value
|
|
' If Not String.IsNullOrEmpty(sMyMatch) Or Not String.IsNullOrWhiteSpace(sMyMatch) Then
|
|
' sFeet = sMyMatch.Trim
|
|
' bOkFeet = StringToDouble(sFeet, dFeet)
|
|
' bFeetExists = True
|
|
' End If
|
|
|
|
' ' recupero il valore di Inch (3") dopo i Feet - oppure direttamente i pollici
|
|
' If bFeetExists Then
|
|
' sMyMatch = Regex.Match(sVal, sInchPattern).Groups(1).Value
|
|
' Else
|
|
' sMyMatch = Regex.Match(sVal, sInchPattern1).Groups(1).Value
|
|
' End If
|
|
' If Not String.IsNullOrEmpty(sMyMatch) Or Not String.IsNullOrWhiteSpace(sMyMatch) Then
|
|
' sInch = sMyMatch.Trim
|
|
' bOkInch = StringToDouble(sInch, dInch)
|
|
' bInchExists = True
|
|
' End If
|
|
|
|
' ' recupero il valore frazionario (23/32) dopo i pollici - oppure dopo i feet - oppure direttamente i valore inteso come pollici
|
|
' If bInchExists Then
|
|
' sMyMatch = Regex.Match(sVal, sFractionPattern).Groups(1).Value
|
|
' ElseIf bFeetExists And Not bInchExists Then
|
|
' sMyMatch = Regex.Match(sVal, sFractionPattern1).Groups(1).Value
|
|
' ElseIf Not bFeetExists And Not bInchExists Then
|
|
' sMyMatch = sVal
|
|
' End If
|
|
' If Not String.IsNullOrEmpty(sMyMatch) Or Not String.IsNullOrWhiteSpace(sMyMatch) Then
|
|
' sFraction = sMyMatch
|
|
' bOkFraction = StringToDouble(sFraction, dFraction)
|
|
' End If
|
|
|
|
' ' calcolo il valore decimale dell'espressione
|
|
' If bOkFeet And bOkInch And bOkFraction Then
|
|
' dVal = dFeet / 12 + dInch + dFraction
|
|
' sValConverted = DoubleToString(dVal, 4)
|
|
' Return True
|
|
' Else
|
|
' Return False
|
|
' End If
|
|
'End Function
|
|
|
|
#End Region ' Inches Fraction
|
|
'--------------------------------------------------------------------------------------------------
|
|
|
|
Friend Function DoubleToString(dVal As Double, nNumDec As Integer) As String
|
|
Dim sFormat As String = "F" + Math.Abs(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
|
|
|
|
Friend Function StringToDouble(sVal As String, ByRef dVal As Double) As Boolean
|
|
If String.IsNullOrEmpty(sVal) Then Return False
|
|
Return EgtLuaEvalNumExpr(sVal, dVal)
|
|
End Function
|
|
|
|
Friend Function StringToInt(sVal As String, ByRef nVal As Integer) As Boolean
|
|
Dim dVal As Double = 0
|
|
If Not StringToDouble(sVal, dVal) Then Return False
|
|
nVal = CInt(Math.Round(dVal))
|
|
Return True
|
|
End Function
|
|
|
|
' conerte il dato (in mm) in stringa nell'unità corrente
|
|
Friend Function LenToString(dVal As Double, nNumDec As Integer, Optional ByVal bForceToDecimal As Boolean = False) As String
|
|
Dim sVal As String = DoubleToString(EgtToUiUnits(dVal), nNumDec)
|
|
' se richiesta scrittura in frazione (solo se unità corrente INCHES)
|
|
If (nCurrFractionPattern <> FractionPattern.None And Not EgtUiUnitsAreMM()) And Not bForceToDecimal Then
|
|
' conevrto il dato corrente in decimale
|
|
Dim dCurrVal As Double = dVal
|
|
StringToDouble(sVal, dCurrVal)
|
|
Return DoubleToStringFraction(dCurrVal, dPrecision)
|
|
End If
|
|
Return sVal
|
|
End Function
|
|
|
|
Friend Function StringToLen(sVal As String, ByRef dVal As Double, Optional ByVal bForceToDecimal As Boolean = False) As Boolean
|
|
If String.IsNullOrEmpty(sVal) Then Return False
|
|
|
|
If (nCurrFractionPattern <> FractionPattern.None And Not EgtUiUnitsAreMM()) And Not bForceToDecimal Then
|
|
Dim sValSource As String = sVal
|
|
' conevrto la stringa in formato decimale (sempre in stringa)
|
|
StringFractionToStringDecimal(sValSource, sVal)
|
|
End If
|
|
|
|
If EgtLuaEvalNumExpr(sVal, dVal) Then
|
|
dVal = EgtFromUiUnits(dVal)
|
|
Return True
|
|
Else
|
|
Return False
|
|
End If
|
|
End Function
|
|
|
|
#Region "PreGuidCode"
|
|
|
|
' recupero i primi 5 caratteri della stringa
|
|
Friend Function GetPreGuidCode(sGuidCode As String) As String
|
|
If sGuidCode.Count > 5 Then
|
|
Return sGuidCode(0) & sGuidCode(1) & sGuidCode(2) & sGuidCode(3) & sGuidCode(4)
|
|
End If
|
|
Return String.Empty
|
|
End Function
|
|
|
|
' sostituisce i primi 5 caratteri della stringa con qualle passata
|
|
Friend Function UppDateGuidCode(ByRef sGuidCode As String, sPreGuidCode As String) As Boolean
|
|
If sPreGuidCode.Count = 5 Then
|
|
sGuidCode = sGuidCode.Remove(0, 5)
|
|
sGuidCode = sPreGuidCode & sGuidCode
|
|
Return True
|
|
End If
|
|
Return False
|
|
End Function
|
|
|
|
' restituisce 5 caratteri
|
|
Friend Function CreatePreGuidCode(nId As Integer) As String
|
|
' recupero il frame dell'oggetto
|
|
Dim frGlobFrame As New Frame3d
|
|
If Not EgtGetGroupGlobFrame(nId, frGlobFrame) Then
|
|
Return String.Empty
|
|
End If
|
|
' recupero il suo versore
|
|
Dim vtX As Vector3d = frGlobFrame.VersX
|
|
Dim Len As Double
|
|
Dim AngV As Double
|
|
Dim AngH As Double
|
|
vtX.ToSpherical(Len, AngV, AngH)
|
|
' costruisco il codice (6 caratteri!) che identifica la posizione del pezzo in parcheggio
|
|
Dim sPreGuid As String = GetDirectionCode(AngH)
|
|
Return sPreGuid
|
|
End Function
|
|
|
|
Friend Function GetDirectionCode(dVal As Double) As String
|
|
Dim bIsNegative As Boolean = False
|
|
If dVal < 0 Then
|
|
dVal = dVal + (-1)
|
|
bIsNegative = True
|
|
End If
|
|
Dim sVal As String = DoubleToString(dVal * 1000, 0)
|
|
Dim nCount As Integer = sVal.Count
|
|
For Index As Integer = 1 To 4 - nCount
|
|
sVal = "0" & sVal
|
|
Next
|
|
Dim vVal As Char() = {"+", "1", "0", "0", "0"}
|
|
If bIsNegative Then
|
|
vVal = {"-"c, sVal(0), sVal(1), sVal(2), sVal(3)}
|
|
Else
|
|
vVal = {"+"c, sVal(0), sVal(1), sVal(2), sVal(3)}
|
|
End If
|
|
' ricostruisco la stringa dotata di segno
|
|
sVal = vVal(0) & vVal(1) & vVal(2) & vVal(3) & vVal(4)
|
|
Return sVal
|
|
End Function
|
|
|
|
#End Region ' PreGiudCode
|
|
|
|
|
|
Friend Function UIExprToExpr(sUIExpr As String) As String
|
|
If String.IsNullOrWhiteSpace(sUIExpr) Then
|
|
Return ""
|
|
End If
|
|
Return sUIExpr.Replace("""", "*GEO.ONE_INCH")
|
|
End Function
|
|
|
|
Friend Function ExprToUIExpr(sExpr As String) As String
|
|
If String.IsNullOrWhiteSpace(sExpr) Then
|
|
Return ""
|
|
End If
|
|
Return sExpr.Replace("*GEO.ONE_INCH", """")
|
|
End Function
|
|
|
|
Friend Function DistToString(vtDist As Vector3d) As String
|
|
Dim nDec As Integer = If(EgtUiUnitsAreMM(), 1, 2)
|
|
Dim sDistance As String = EgtMsg(1301) 'Dist=
|
|
sDistance &= LenToString(vtDist.Len(), nDec) & vbCrLf
|
|
sDistance &= " dX=" & LenToString(vtDist.x, nDec)
|
|
sDistance &= " dY=" & LenToString(vtDist.y, nDec)
|
|
sDistance &= " dZ=" & LenToString(vtDist.z, nDec)
|
|
Return sDistance
|
|
End Function
|
|
|
|
'--------------------------------------------------------------------------------------------------
|
|
Friend Function GetValueWithKey(sString As String, sKey As String) As String
|
|
If String.IsNullOrWhiteSpace(sString) Then Return ""
|
|
Dim sPurged As String = sString.Trim()
|
|
Dim nPos As Integer = sPurged.IndexOf("="c)
|
|
If nPos < 0 Then Return ""
|
|
If String.Compare(sPurged.Substring(0, nPos), sKey, True) = 0 Then Return sPurged.Substring(nPos + 1)
|
|
Return ""
|
|
End Function
|
|
|
|
'--------------------------------------------------------------------------------------------------
|
|
Friend Sub HideParkedParts(Optional bDisableModified As Boolean = True)
|
|
' Se richiesto, disabilito impostazione modificato
|
|
Dim bOldEnMod As Boolean = False
|
|
If bDisableModified Then
|
|
bOldEnMod = EgtGetEnableModified()
|
|
If bOldEnMod Then EgtDisableModified()
|
|
End If
|
|
' Nascondo pezzi parcheggiati
|
|
Dim nPartId As Integer = EgtGetFirstPart()
|
|
While nPartId <> GDB_ID.NULL
|
|
EgtSetStatus(nPartId, GDB_ST.OFF)
|
|
nPartId = EgtGetNextPart(nPartId)
|
|
End While
|
|
' Se necessario, ripristino precedente impostazione modificato
|
|
If bOldEnMod Then EgtEnableModified()
|
|
End Sub
|
|
|
|
Friend Sub ShowParkedParts(Optional bDisableModified As Boolean = True)
|
|
' Se richiesto, disabilito impostazione modificato
|
|
Dim bOldEnMod As Boolean = False
|
|
If bDisableModified Then
|
|
bOldEnMod = EgtGetEnableModified()
|
|
If bOldEnMod Then EgtDisableModified()
|
|
End If
|
|
' Visualizzo pezzi parcheggiati
|
|
Dim nPartId As Integer = EgtGetFirstPart()
|
|
While nPartId <> GDB_ID.NULL
|
|
EgtSetStatus(nPartId, GDB_ST.ON_)
|
|
nPartId = EgtGetNextPart(nPartId)
|
|
End While
|
|
' Se necessario, ripristino precedente impostazione modificato
|
|
If bOldEnMod Then EgtEnableModified()
|
|
End Sub
|
|
|
|
Friend Function SetTextColor(nGroup As Integer) As Boolean
|
|
' Recupero il colore da assegnare ai testi
|
|
Dim colText As New Color3d(0, 0, 0)
|
|
Dim sTextColor As String = " "
|
|
Dim MainWindow As MainWindow = DirectCast(Application.Current.MainWindow, MainWindow)
|
|
If GetPrivateProfileString(S_NEST, K_TEXTCOLOR, " ", sTextColor, MainWindow.GetIniFile()) <> 0 Then
|
|
Dim sTextColorArray() As String = sTextColor.Split(",")
|
|
Dim nRed As Integer = 0 : Integer.TryParse(sTextColorArray(0), nRed)
|
|
Dim nGreen As Integer = 0 : Integer.TryParse(sTextColorArray(1), nGreen)
|
|
Dim nBlue As Integer = 0 : Integer.TryParse(sTextColorArray(2), nBlue)
|
|
colText.Setup(nRed, nGreen, nBlue)
|
|
End If
|
|
' Assegno questo colore ai testi del layer indicato
|
|
Dim nId As Integer = EgtGetFirstInGroup(nGroup)
|
|
While nId <> GDB_ID.NULL
|
|
If EgtGetType(nId) = GDB_TY.EXT_TEXT Then
|
|
EgtSetColor(nId, colText)
|
|
End If
|
|
nId = EgtGetNext(nId)
|
|
End While
|
|
Return True
|
|
End Function
|
|
|
|
Friend Function AddTopToPartRegion(nRegId As Integer) As Boolean
|
|
Dim frReg As New Frame3d : EgtGetGroupGlobFrame(nRegId, frReg)
|
|
Dim b3Reg As New BBox3d : EgtGetBBoxGlob(nRegId, GDB_BB.STANDARD, b3Reg)
|
|
Dim dH As Double = Math.Min(0.1 * b3Reg.DimY(), 30)
|
|
Dim ptIns As New Point3d(b3Reg.Center().x, b3Reg.Max().y - dH, b3Reg.Max().z)
|
|
ptIns.ToLoc(frReg)
|
|
Dim nSfrId As Integer = EgtGetFirstInGroup(nRegId)
|
|
While nSfrId <> GDB_ID.NULL
|
|
If EgtGetType(nSfrId) = GDB_TY.SRF_FRGN Then Exit While
|
|
nSfrId = EgtGetNext(nSfrId)
|
|
End While
|
|
If nSfrId <> GDB_ID.NULL Then
|
|
Dim ptStart As New Point3d(b3Reg.Min().x, b3Reg.Max().y - dH, b3Reg.Max().z)
|
|
ptStart.ToLoc(frReg)
|
|
Dim ptEnd As New Point3d(b3Reg.Max().x, b3Reg.Max().y - dH, b3Reg.Max().z)
|
|
ptEnd.ToLoc(frReg)
|
|
Dim nLineId As Integer = EgtCreateLine(nRegId, ptStart, ptEnd)
|
|
Dim nCount As Integer = 0
|
|
Dim nNewId As Integer = EgtTrimCurveWithRegion(nLineId, nSfrId, True, False, nCount)
|
|
If nNewId <> GDB_ID.NULL Then
|
|
If nCount > 0 Then EgtMidPoint(nNewId, ptIns)
|
|
For nTmpId As Integer = nNewId To nNewId + nCount - 1
|
|
EgtErase(nTmpId)
|
|
Next
|
|
Else
|
|
EgtErase(nLineId)
|
|
End If
|
|
End If
|
|
Dim vtDir As New Vector3d(1, 0, 0)
|
|
vtDir.ToLoc(frReg)
|
|
Dim dLen, dAngV, dAngH As Double
|
|
vtDir.ToSpherical(dLen, dAngV, dAngH)
|
|
Dim nText As Integer = EgtCreateTextAdv(nRegId, ptIns, dAngH, "*TOP*", "", 500, False, dH, 1, 0, INS_POS.MC)
|
|
Return (nText <> GDB_ID.NULL)
|
|
End Function
|
|
|
|
Friend Function SetBlockAndSlabNbr(sBlock As String, sSlabNbr As String) As Boolean
|
|
Dim nRawId As Integer = GetCurrentRaw()
|
|
If nRawId = GDB_ID.NULL Then Return False
|
|
If String.IsNullOrWhiteSpace(sBlock) Then sSlabNbr = ""
|
|
' Assegno info
|
|
EgtSetInfo(nRawId, INFO_RAW_BLOCK, sBlock)
|
|
EgtSetInfo(nRawId, INFO_RAW_SLABNBR, sSlabNbr)
|
|
' Cancello eventuale vecchio BarCode
|
|
EgtErase(EgtGetFirstNameInGroup(nRawId, NAME_BARCODE))
|
|
' Se definito, inserisco nuovo BarCode
|
|
Dim sBarCode As String = sBlock & " - " & sSlabNbr
|
|
If sBarCode <> " - " Then
|
|
Dim ptRawCen As Point3d
|
|
GetRawCenter(ptRawCen)
|
|
Dim ptRawMin, ptRawMax As Point3d
|
|
GetRawBox(ptRawMin, ptRawMax)
|
|
Dim ptText As New Point3d(ptRawCen.x, ptRawCen.y, ptRawMax.z)
|
|
Dim nText As Integer = EgtCreateTextAdv(nRawId, ptText, 0, sBarCode, "", 500, False, 50.0, 1, 0, INS_POS.MC, GDB_RT.GLOB)
|
|
EgtSetName(nText, NAME_BARCODE)
|
|
EgtSetColor(nText, New Color3d(255, 0, 0))
|
|
End If
|
|
Return True
|
|
End Function
|
|
|
|
'--------------------------------------------------------------------------------------------------
|
|
Public Class Language
|
|
|
|
Private m_sLanguageName As String
|
|
Private m_sFileName As String
|
|
|
|
Public Property LanguageName As String
|
|
Get
|
|
Return m_sLanguageName
|
|
End Get
|
|
Set(value As String)
|
|
m_sLanguageName = value
|
|
End Set
|
|
End Property
|
|
|
|
Public Property FileName As String
|
|
Get
|
|
Return m_sFileName
|
|
End Get
|
|
Set(value As String)
|
|
m_sFileName = value
|
|
End Set
|
|
End Property
|
|
|
|
Sub New(LanguageName As String, FileName As String)
|
|
Me.LanguageName = LanguageName
|
|
Me.FileName = FileName
|
|
End Sub
|
|
|
|
End Class
|
|
|
|
Public Function GetPrivateProfileLanguage(lpAppName As String, lpKeyName As String, lpFileName As String) As Language
|
|
Dim sVal As String = String.Empty
|
|
GetPrivateProfileString(lpAppName, lpKeyName, "", sVal, lpFileName)
|
|
Dim sItems() As String = sVal.Split(",".ToCharArray)
|
|
If sItems.Count() = 2 Then
|
|
Return New Language(sItems(0), sItems(1))
|
|
End If
|
|
Return Nothing
|
|
End Function
|
|
|
|
'--------------------------------------------------------------------------------------------------
|
|
Public Function GetBackTopColor() As Color3d
|
|
Dim MyMainWindow As MainWindow = DirectCast(Application.Current.MainWindow, MainWindow)
|
|
Dim nTheme = GetPrivateProfileInt(S_GENERAL, K_THEME, 0, MyMainWindow.GetIniFile())
|
|
Dim BackTopColor As New Color3d(211, 211, 211)
|
|
Dim sBackTop As String = K_BACKTOP
|
|
If nTheme = 1 Then sBackTop &= "1"
|
|
GetPrivateProfileColor(S_SCENE, sBackTop, BackTopColor, MyMainWindow.GetIniFile())
|
|
Return BackTopColor
|
|
End Function
|
|
|
|
Public Function GetBackBottomColor() As Color3d
|
|
Dim MyMainWindow As MainWindow = DirectCast(Application.Current.MainWindow, MainWindow)
|
|
Dim nTheme = GetPrivateProfileInt(S_GENERAL, K_THEME, 0, MyMainWindow.GetIniFile())
|
|
Dim BackBottomColor As New Color3d(211, 211, 211)
|
|
Dim sBackBottom As String = K_BACKBOTTOM
|
|
If nTheme = 1 Then sBackBottom &= "1"
|
|
GetPrivateProfileColor(S_SCENE, sBackBottom, BackBottomColor, MyMainWindow.GetIniFile())
|
|
Return BackBottomColor
|
|
End Function
|
|
|
|
Public Sub GetDrillFromDrilling(ByRef sCurrDrill As String, ByVal sCurrDrilling As String)
|
|
If String.IsNullOrEmpty(sCurrDrill) Or String.IsNullOrWhiteSpace(sCurrDrill) Then
|
|
' creo l'elenco degli utensili di foratura
|
|
Dim sToolName As String = String.Empty
|
|
Dim nType As Integer = MCH_TY.NONE
|
|
Dim DrillToolList As New ObservableCollection(Of String)
|
|
DrillToolList.Clear()
|
|
If EgtTdbGetFirstTool(MCH_TF.DRILLBIT, sToolName, nType) Then
|
|
DrillToolList.Add(sToolName)
|
|
While EgtTdbGetNextTool(MCH_TF.DRILLBIT, sToolName, nType)
|
|
DrillToolList.Add(sToolName)
|
|
End While
|
|
End If
|
|
' recupero l'utensile associato alla lavorazione
|
|
'Dim sCurrDrilling As String = m_MainWindow.m_CurrentMachine.sCurrDrilling
|
|
Dim ToolString As String = String.Empty
|
|
EgtMdbSetCurrMachining(sCurrDrilling)
|
|
' Recupero nome utensile tramite TUUID
|
|
Dim sTuuid As String = String.Empty
|
|
EgtMdbGetCurrMachiningParam(MCH_MP.TUUID, sTuuid)
|
|
EgtTdbGetToolFromUUID(sTuuid, ToolString)
|
|
Dim bToolExist As Boolean = False
|
|
For Each CurrTool As IEnumerable In DrillToolList
|
|
If CurrTool.ToString() = ToolString Then
|
|
bToolExist = True
|
|
Exit For
|
|
End If
|
|
Next
|
|
If bToolExist Then
|
|
sCurrDrill = ToolString
|
|
Else
|
|
sCurrDrill = String.Empty
|
|
End If
|
|
End If
|
|
End Sub
|
|
|
|
Public Sub GetMillFromMilling(ByRef sCurrMill As String, ByVal sCurrMilling As String)
|
|
If String.IsNullOrEmpty(sCurrMill) Or String.IsNullOrWhiteSpace(sCurrMill) Then
|
|
' creo l'elenco degli utensili di foratura
|
|
Dim sToolName As String = String.Empty
|
|
Dim nType As Integer = MCH_TY.NONE
|
|
Dim MillToolList As New ObservableCollection(Of String)
|
|
MillToolList.Clear()
|
|
If EgtTdbGetFirstTool(MCH_TF.MILL, sToolName, nType) Then
|
|
MillToolList.Add(sToolName)
|
|
While EgtTdbGetNextTool(MCH_TF.MILL, sToolName, nType)
|
|
MillToolList.Add(sToolName)
|
|
End While
|
|
End If
|
|
' recupero l'utensile associato alla lavorazione
|
|
'Dim sCurrDrilling As String = m_MainWindow.m_CurrentMachine.sCurrDrilling
|
|
Dim ToolString As String = String.Empty
|
|
EgtMdbSetCurrMachining(sCurrMilling)
|
|
' Recupero nome utensile tramite TUUID
|
|
Dim sTuuid As String = String.Empty
|
|
EgtMdbGetCurrMachiningParam(MCH_MP.TUUID, sTuuid)
|
|
EgtTdbGetToolFromUUID(sTuuid, ToolString)
|
|
Dim bToolExist As Boolean = False
|
|
For Each CurrTool As IEnumerable In MillToolList
|
|
If CurrTool.ToString() = ToolString Then
|
|
bToolExist = True
|
|
Exit For
|
|
End If
|
|
Next
|
|
If bToolExist Then
|
|
sCurrMill = ToolString
|
|
Else
|
|
sCurrMill = String.Empty
|
|
End If
|
|
End If
|
|
End Sub
|
|
|
|
End Module
|