Imports System.Globalization Imports System.Diagnostics Imports System.Collections.ObjectModel Imports System.Text.RegularExpressions Imports EgtWPFLib Imports EgtUILib Module Utility 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() As String 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" ' seleziona il tipo di Pattern di stampa dei dati Friend nCurrFractionPattern As FractionStringConverter.FractionPattern = FractionPattern.Feet_Inches Friend dPrecision As Double = 64 #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 ' Visualizzo gli elementi attivi in parcheggio SelParkIndWD.UpdateViewOnParkInd(False) ' 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 ' Restituisce il colore dell'utensile correntemente settato, se non trova l'utesile o il colore ritorna il default (0,255,0) Friend Function GetColorPV() As Color3d Dim ToolString As String = String.Empty Dim ToolColor As String = String.Empty 'EgtTdbGetCurrToolParam(MCH_MP.SYSNOTES, ToolString) EgtTdbGetCurrToolParam(MCH_TP.SYSNOTES, ToolString) EgtTdbGetCurrToolValInNotes(MCH_TP.SYSNOTES, "COLOR", ToolColor) Dim sItems As String() = ToolColor.Split(","c) ' Verifico che siano almeno 3 campi If sItems.Count < 3 Then Return New Color3d(0, 255, 0, 100) Else ' Verifico che tutti i campi siano numerici If IsNumeric(sItems(0)) And IsNumeric(sItems(1)) And IsNumeric(sItems(2)) Then Return New Color3d(CInt(sItems(0)), CInt(sItems(1)), CInt(sItems(2)), 100) Else Return New Color3d(0, 255, 0, 100) End If End If 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