Imports System.Globalization Imports System.Collections.ObjectModel 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 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 '-------------------------------------------------------------------------------------------------- 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 Friend Function LenToString(dVal As Double, nNumDec As Integer) As String Return DoubleToString(EgtToUiUnits(dVal), nNumDec) End Function Friend Function StringToLen(sVal As String, ByRef dVal As Double) As Boolean If String.IsNullOrEmpty(sVal) Then Return False If EgtLuaEvalNumExpr(sVal, dVal) Then dVal = EgtFromUiUnits(dVal) Return True Else Return False End If End Function 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 End Module