From 092dd11ddc546c5df5bea2d437be0bdebca8c8f0 Mon Sep 17 00:00:00 2001 From: Dario Sassi Date: Wed, 10 Apr 2019 09:28:01 +0000 Subject: [PATCH] OmagCUT 2.1d2 : - aggiunta gestione colori per angoli e talloni di fianco in import (anche SlabSmith). --- CSVPage.xaml.vb | 2 +- ConstIni.vb | 5 + DrawPageUC.xaml.vb | 10 +- FastGridSlabManager.xaml.vb | 2 +- ImportPageUC.xaml.vb | 33 ++-- My Project/AssemblyInfo.vb | 4 +- OmagCUT.vbproj | 1 + OpenPageUC.xaml.vb | 7 +- SideAngle.vb | 300 ++++++++++++++++++++++++++++++++++++ SideAngleUc.xaml.vb | 200 +----------------------- Utility.vb | 43 +----- 11 files changed, 346 insertions(+), 261 deletions(-) create mode 100644 SideAngle.vb diff --git a/CSVPage.xaml.vb b/CSVPage.xaml.vb index f3becce..0a64075 100644 --- a/CSVPage.xaml.vb +++ b/CSVPage.xaml.vb @@ -441,7 +441,7 @@ Public Class CSVPage EgtSetColor(nText, New Color3d()) End If ' Aggiusto per lavorazioni - AdjustFlatPart(nId) + EgtAdjustFlatPart(nId) ' Se Csv completo, aggiungo info su CSV di origine If m_bFull Then EgtSetInfo(nId, INFO_CSV_PATH, m_sCsvPath) diff --git a/ConstIni.vb b/ConstIni.vb index d4ebe27..487de7d 100644 --- a/ConstIni.vb +++ b/ConstIni.vb @@ -129,6 +129,11 @@ Module ConstIni Public Const K_SCRAPLAYER As String = "ScrapLayer" Public Const K_STDTHICK As String = "StdThick" + Public Const S_COLORTOSIDEANG As String = "ColorToSideAng" + Public Const K_CTSA_ENABLE As String = "Enable" + Public Const K_CTSA_TOLERANCE As String = "Tolerance" + Public Const K_CTSA As String = "CTSA" + Public Const S_FRAME As String = "Frame" Public Const K_OFFSZ As String = "OffsZ" Public Const K_OFFSXY As String = "OffsXY" diff --git a/DrawPageUC.xaml.vb b/DrawPageUC.xaml.vb index e5d6a55..375f5d3 100644 --- a/DrawPageUC.xaml.vb +++ b/DrawPageUC.xaml.vb @@ -331,7 +331,7 @@ Public Class DrawPageUC If nStat = GDB_ST.SEL Then EgtDeselectAll() m_nSelectedLayer = GDB_ID.NULL - m_SideAngleUC.WriteSideAngleForNest(DrawScene.GetCtx()) + SideAngle.WriteSideAngleForNest(DrawScene.GetCtx()) ' Messaggio di selezione da effettuare MessageTxBx.Text = EgtMsg(MSG_DRAWPAGEUC + 6) ' Selezionare un contorno MessageBrd.Background = Application.Current.FindResource("OmagCut_Green") @@ -587,7 +587,7 @@ Public Class DrawPageUC EgtLuaGetGlobIntVar(LUA_CMP_VARS & ".ERR", nErr) m_bDrawOk = (nErr = 0) End If - AdjustFlatPart(EgtGetFirstPart()) + EgtAdjustFlatPart(EgtGetFirstPart()) Return m_bDrawOk End Function @@ -689,7 +689,7 @@ Public Class DrawPageUC EgtSetColor(nText, New Color3d()) End If ' Scrivo testi per nesting - m_SideAngleUC.WriteSideAngleForNest(DrawScene.GetCtx()) + SideAngle.WriteSideAngleForNest(DrawScene.GetCtx()) ' Esporto il pezzo in un file temporaneo Dim sTmpFile As String = m_MainWindow.GetTempDir() & "\FlatPartCompo.Nge" If Not EgtSaveObjToFile(1, sTmpFile, NGE.BIN) Then @@ -709,7 +709,7 @@ Public Class DrawPageUC ' Ne recupero l'Id Dim nId2 As Integer = EgtGetLastPart() ' Aggiusto per lavorazioni - AdjustFlatPart(nId2) + EgtAdjustFlatPart(nId2) ' Se dati Trf assegno nome univoco If m_bTrfData Then EgtSetInfo(nId2, "CsvPart", m_TrfOrderCode & "-" & nId2.ToString()) ' Inserisco in parcheggio @@ -803,7 +803,7 @@ Public Class DrawPageUC MessageTxBx.Text = EgtMsg(MSG_DRAWPAGEUC + 6) ' Selezionare un contorno MessageBrd.Background = Application.Current.FindResource("OmagCut_Green") ' Aggiungo testi su lati già inclinati - m_SideAngleUC.WriteSideAngleForNest(DrawScene.GetCtx()) + SideAngle.WriteSideAngleForNest(DrawScene.GetCtx()) End If ' In ogni caso, nascondo layer delle misure Dim PartId As Integer = EgtGetFirstInGroup(GDB_ID.ROOT) diff --git a/FastGridSlabManager.xaml.vb b/FastGridSlabManager.xaml.vb index 4619a0f..d876a1f 100644 --- a/FastGridSlabManager.xaml.vb +++ b/FastGridSlabManager.xaml.vb @@ -146,7 +146,7 @@ Public Class FastGridSlabManager Dim nRegId = EgtGetFirstNameInGroup(nId, NAME_REGION) EgtMove(nRegId, New Vector3d(0, 0, DELTAZ_REG), GDB_RT.GLOB) ' Aggiusto per lavorazioni - AdjustFlatPart(nId) + EgtAdjustFlatPart(nId) ' Se primo pezzo, lo inserisco con metodo standard If i = 1 Then Dim ptGridOrig As Point3d diff --git a/ImportPageUC.xaml.vb b/ImportPageUC.xaml.vb index e61cb6a..a40962e 100644 --- a/ImportPageUC.xaml.vb +++ b/ImportPageUC.xaml.vb @@ -397,7 +397,7 @@ Public Class ImportPageUC EgtDeselectAll() m_nSelectedPart = GDB_ID.NULL m_nSelectedLayer = GDB_ID.NULL - m_SideAngleUC.WriteSideAngleForNest(ImportScene.GetCtx()) + SideAngle.WriteSideAngleForNest(ImportScene.GetCtx()) ' Messaggio di selezione da effettuare MessageTxBx.Text = EgtMsg(MSG_DRAWPAGEUC + 6) ' Selezionare un contorno MessageBrd.Background = Application.Current.FindResource("OmagCut_Green") @@ -408,7 +408,7 @@ Public Class ImportPageUC EgtDeselectAll() m_nSelectedPart = GDB_ID.NULL m_nSelectedLayer = GDB_ID.NULL - m_SideAngleUC.WriteSideAngleForNest(ImportScene.GetCtx()) + SideAngle.WriteSideAngleForNest(ImportScene.GetCtx()) ' seleziono pezzo cliccato EgtSelectObj(nId) EgtSelectObj(nLayId) @@ -493,8 +493,11 @@ Public Class ImportPageUC ' Creo i pezzi Dim nType As Integer = If(m_nFileType = FT.NGE, FPC_TYPE.NGE, FPC_TYPE.LAYER) Dim dToler As Double = GetPrivateProfileDouble(S_FLATPARTS, K_FLPTOLERANCE, 0.1, m_MainWindow.GetIniFile()) - EgtCreateFlatParts(nType, dToler) - AdjustFlatParts() + EgtCreateAdjustFlatParts(nType, dToler) + ' Se prevista gestione colore->angolo di fianco + If GetPrivateProfileInt(S_COLORTOSIDEANG, K_CTSA_ENABLE, 0, m_MainWindow.GetIniFile()) <> 0 Then + SideAngle.ColorToSideAngle(ImportScene.GetCtx()) + End If ' Eseguo zoom ImportScene.ZoomAll() ' disabilito bottoni UseLayer e UseRegion, abilito bottoni Reset e Insert @@ -515,8 +518,11 @@ Public Class ImportPageUC ' Creo i pezzi Dim nType As Integer = If(m_nFileType = FT.NGE, FPC_TYPE.NGE, FPC_TYPE.CLOSEDCURVE) Dim dToler As Double = GetPrivateProfileDouble(S_FLATPARTS, K_FLPTOLERANCE, 0.1, m_MainWindow.GetIniFile()) - EgtCreateFlatParts(nType, dToler) - AdjustFlatParts() + EgtCreateAdjustFlatParts(nType, dToler) + ' Se prevista gestione colore->angolo di fianco + If GetPrivateProfileInt(S_COLORTOSIDEANG, K_CTSA_ENABLE, 0, m_MainWindow.GetIniFile()) <> 0 Then + SideAngle.ColorToSideAngle(ImportScene.GetCtx()) + End If ' Eseguo zoom ImportScene.ZoomAll() ' disabilito bottoni UseLayer e UseRegion, abilito bottoni Reset e Insert @@ -537,8 +543,11 @@ Public Class ImportPageUC ' Creo i pezzi Dim nType As Integer = If(m_nFileType = FT.NGE, FPC_TYPE.NGE, FPC_TYPE.REGION) Dim dToler As Double = GetPrivateProfileDouble(S_FLATPARTS, K_FLPTOLERANCE, 0.1, m_MainWindow.GetIniFile()) - EgtCreateFlatParts(nType, dToler) - AdjustFlatParts() + EgtCreateAdjustFlatParts(nType, dToler) + ' Se prevista gestione colore->angolo di fianco + If GetPrivateProfileInt(S_COLORTOSIDEANG, K_CTSA_ENABLE, 0, m_MainWindow.GetIniFile()) <> 0 Then + SideAngle.ColorToSideAngle(ImportScene.GetCtx()) + End If ' Eseguo zoom ImportScene.ZoomAll() ' disabilito bottoni UseLayer e UseRegion, abilito bottoni Reset e Insert @@ -610,7 +619,7 @@ Public Class ImportPageUC If nErr <> 0 Then EgtOutLog("Error in TrfRead : " & nErr.ToString()) EgtLuaResetGlobVar("TRF") ' Sistemazione layer - AdjustFlatParts() + EgtAdjustFlatParts() Return (nErr = 0) End Function @@ -654,7 +663,7 @@ Public Class ImportPageUC PartId = EgtGetNextPart(PartId) End While ' Scrivo testi per nesting - m_SideAngleUC.WriteSideAngleForNest(ImportScene.GetCtx()) + SideAngle.WriteSideAngleForNest(ImportScene.GetCtx()) ' Imposto riferimento sul centro geometrico di ogni pezzo VeinMatching.SetRefOnAllParts(ImportScene.GetCtx()) ' Eventuale pulizia VeinMatching @@ -816,7 +825,7 @@ Public Class ImportPageUC mmBtn.IsEnabled = True inchBtn.IsEnabled = True ' Elimino scritte angoli per input e inserisco quelle definitive - m_SideAngleUC.WriteSideAngleForNest(ImportScene.GetCtx()) + SideAngle.WriteSideAngleForNest(ImportScene.GetCtx()) ' Riabilito bottone reset ResetBtn.IsEnabled = True ' Pulisco area messaggi @@ -861,7 +870,7 @@ Public Class ImportPageUC mmBtn.IsEnabled = True inchBtn.IsEnabled = True ' Elimino scritte angoli per input e inserisco quelle definitive - m_SideAngleUC.WriteSideAngleForNest(ImportScene.GetCtx()) + SideAngle.WriteSideAngleForNest(ImportScene.GetCtx()) ' Ricavo nome pezzo selezionato Dim Part1 As Integer = m_MainWindow.m_ImportPageUC.m_nSelectedPart EgtErase(EgtGetFirstNameInGroup(Part1, SIDE_ANGLE_LAYER)) diff --git a/My Project/AssemblyInfo.vb b/My Project/AssemblyInfo.vb index f0103ad..0562eab 100644 --- a/My Project/AssemblyInfo.vb +++ b/My Project/AssemblyInfo.vb @@ -62,5 +62,5 @@ Imports System.Windows ' by using the '*' as shown below: ' - - + + diff --git a/OmagCUT.vbproj b/OmagCUT.vbproj index 413929a..cdde244 100644 --- a/OmagCUT.vbproj +++ b/OmagCUT.vbproj @@ -210,6 +210,7 @@ EditValueWD.xaml + UnderDrillUC.xaml diff --git a/OpenPageUC.xaml.vb b/OpenPageUC.xaml.vb index ac61f01..1e931a3 100644 --- a/OpenPageUC.xaml.vb +++ b/OpenPageUC.xaml.vb @@ -301,8 +301,11 @@ Public Class OpenPageUC bOk = bOk And bRawOk ' Sistemo i pezzi Dim dToler As Double = GetPrivateProfileDouble(S_FLATPARTS, K_FLPTOLERANCE, 0.1, m_MainWindow.GetIniFile()) - EgtCreateFlatParts(FPC_TYPE.REGION, dToler) - AdjustFlatParts() + EgtCreateAdjustFlatParts(FPC_TYPE.REGION, dToler) + ' Se prevista gestione colore->angolo di fianco + If GetPrivateProfileInt(S_COLORTOSIDEANG, K_CTSA_ENABLE, 0, m_MainWindow.GetIniFile()) <> 0 Then + SideAngle.ColorToSideAngle(OpenScene.GetCtx()) + End If ' Ricarico contorno lastra Dim bRawFound = False bOk = bOk AndAlso EgtImportDxf(sPath, dScale) diff --git a/SideAngle.vb b/SideAngle.vb new file mode 100644 index 0000000..0fa239d --- /dev/null +++ b/SideAngle.vb @@ -0,0 +1,300 @@ +Imports EgtUILib + +Module SideAngle + + Private m_MainWindow As MainWindow = DirectCast(Application.Current.MainWindow, MainWindow) + + + Friend Sub WriteSideAngleForNest(nCtx As Integer) + ' Imposto contesto corrente + EgtSetCurrentContext(nCtx) + Dim PartId As Integer = EgtGetFirstPart() + While PartId <> GDB_ID.NULL + ' Se richiesti lati paralleli con misura sul top come in TRF, verifico e aggiusto + If GetPrivateProfileInt( S_SIDES, K_PARSIDE_AS_TRF, 0, m_MainWindow.GetIniFile()) <> 0 Then + AdjustAsTrfParSides( PartId) + End If + ' Elimino eventuale precedente layer per testi + EgtErase(EgtGetFirstNameInGroup(PartId, SIDE_ANGLE_LAYER)) + ' Creo layer per testi nesting + Dim TextLayId As Integer = EgtCreateGroup(PartId) + EgtSetName(TextLayId, SIDE_ANGLE_LAYER) + EgtSetColor(TextLayId, New Color3d(0, 0, 128)) + ' Opero su geometria esterna pezzo + WriteSideAngleOnLoop(EgtGetFirstNameInGroup(PartId, NAME_OUTLOOP), TextLayId) + ' Ciclo su geometria interna pezzo + Dim LoopId As Integer = EgtGetFirstNameInGroup(PartId, NAME_INLOOP) + While LoopId <> GDB_ID.NULL + WriteSideAngleOnLoop(LoopId, TextLayId) + LoopId = EgtGetNextName(LoopId, NAME_INLOOP) + End While + PartId = EgtGetNextPart(PartId) + End While + End Sub + + Private Function AdjustAsTrfParSides( PartId As Integer) As Boolean + ' Recupero il loop esterno + Dim LoopId As Integer = EgtGetFirstNameInGroup(PartId, NAME_OUTLOOP) + If LoopId = GDB_ID.NULL Then Return False + ' Scansiono i lati + Dim LineId As Integer = EgtGetFirstInGroup(LoopId) + While LineId <> GDB_ID.NULL + ' Se non è linea con singolo angolo, vado oltre + If Not EgtExistsInfo(LineId, INFO_SIDE_ANGLE) OrElse + EgtExistsInfo(LineId, INFO_SIDE_ANGLE2) OrElse + EgtExistsInfo(LineId, INFO_HEEL) Then + LineId = EgtGetNext(LineId) + Continue While + End If + ' Recupero angolo di fianco e direzione + Dim dSideAng As Double = 0 : EgtGetInfo( LineId, INFO_SIDE_ANGLE, dSideAng) + Dim vtDir As new Vector3d : EgtStartVector( LineId, GDB_ID.ROOT, vtDir) + ' Confronto con le linee successive + Dim OthLId As Integer = EgtGetNext(LineId) + While OthLId <> GDB_ID.NULL + ' Se non è linea con singolo angolo, vado oltre + If Not EgtExistsInfo(OthLId, INFO_SIDE_ANGLE) OrElse + EgtExistsInfo(OthLId, INFO_SIDE_ANGLE2) OrElse + EgtExistsInfo(OthLId, INFO_HEEL) Then + OthLId = EgtGetNext(OthLId) + Continue While + End If + ' Recupero angolo di fianco e direzione + Dim dOthSAng As Double = 0 : EgtGetInfo( OthLId, INFO_SIDE_ANGLE, dOthSAng) + Dim vtOthDir As new Vector3d : EgtStartVector( OthLId, GDB_ID.ROOT, vtOthDir) + ' Se gli angoli sono opposti e le due linee sono controverse + If Math.Abs( dSideAng + dOthSAng) < 10 * EPS_ANG_SMALL AndAlso (vtDir + vtOthDir).IsSmall() Then + EgtSetInfo( LineId, INFO_SIDE_FIXED, 1) + EgtSetInfo( OthLId, INFO_SIDE_FIXED, 1) + Exit While + End If + OthLId = EgtGetNext(OthLId) + End While + LineId = EgtGetNext(LineId) + End While + Return True + End Function + + Private Function WriteSideAngleOnLoop(LoopId As Integer, TextLayId As Integer) As Boolean + ' Verifiche + If LoopId = GDB_ID.NULL Or TextLayId = GDB_ID.NULL Then Return False + ' Calcolo dimensione ingombro Loop + Dim ptMin, ptMax As Point3d + EgtGetBBoxGlob(LoopId, GDB_BB.STANDARD, ptMin, ptMax) + Dim dBBoxRad As Double = 0.5 * Point3d.DistXY(ptMin, ptMax) + ' Ciclo sulle linee di contorno, se hanno info con inclinazione aggiungo testo con angolo + Dim LineId As Integer = EgtGetFirstInGroup(LoopId) + While LineId <> GDB_ID.NULL + Dim dSideAngle As Double = 0 + Dim bSA As Boolean = EgtGetInfo(LineId, INFO_SIDE_ANGLE, dSideAngle) + Dim dSideAngle2 As Double = 0 + Dim bSA2 As Boolean = EgtGetInfo(LineId, INFO_SIDE_ANGLE2, dSideAngle2) + Dim dSideHeel As Double = 0 + Dim bSH As Boolean = EgtGetInfo(LineId, INFO_HEEL, dSideHeel) + If Math.Abs(dSideAngle) > EPS_ANG_SMALL Or ( bSA2 And Not bSH) Then + ' Creo testo con angolo di inclinazione + Dim sText As String = DoubleToString(dSideAngle, 1) & "°" + ' Se presente tallone, lo indico + If bSH then + If dSideHeel > 10 * EPS_SMALL Then + If dSideAngle > 0 Then + sText = sText & "; " & LenToString(dSideHeel, 1) + Else + sText = LenToString(dSideHeel, 1) & "; " & sText + End If + End If + ' se altrimenti presente secondo angolo, lo indico + ElseIf bSA2 then + sText = DoubleToString(dSideAngle2, 1) & "°" & "; " & sText + End If + AddTextToLine(sText, TextLayId, LineId, 15, dBBoxRad, False, True) + End If + LineId = EgtGetNext(LineId) + End While + Return True + End Function + + Friend Sub ColorToSideAngle(nCtx As Integer) + ' Leggo dati corrispondenza colore-angolo + Dim CurrCSA As New ColorSideAngs + CurrCSA.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 contorno + Dim bOutLoop As Boolean = True + Dim LoopId As Integer = EgtGetFirstNameInGroup(PartId, NAME_OUTLOOP) + While LoopId <> GDB_ID.NULL + ' Ciclo sulle curve + Dim EntId As Integer = EgtGetFirstInGroup( LoopId) + While EntId <> GDB_ID.NULL + If EgtGetType(EntId) = GDB_TY.CRV_LINE Then + Dim colEnt As Color3d + If EgtGetColor( EntId, colEnt) Then + Dim dAng As Double + Dim dHeel As Double + If CurrCSA.GetSideAngHeel( colEnt, dAng, dHeel) Then + EgtSetInfo( EntId, INFO_SIDE_ANGLE, dAng) + EgtSetInfo( EntId, INFO_ORIG_SIDE_ANGLE, dAng) + EgtSetInfo( EntId, INFO_HEEL, dHeel) + End If + End If + End If + EntId = EgtGetNext( EntId) + End While + If bOutLoop then + bOutLoop = False + LoopId = EgtGetFirstNameInGroup(PartId, NAME_INLOOP) + Else + LoopId = EgtGetNextName(LoopId, NAME_INLOOP) + End If + End While + PartId = EgtGetNextPart(PartId) + End While + ' Aggiorno scritte per angoli sui lati + WriteSideAngleForNest(nCtx) + End Sub + + ' Funzione che dato un segmento e una distanza, scrive il testo centrato alla sua sinistra (destra se bTextExt) + Friend Function AddTextToLine(sText As String, TextLayer As Integer, CurrLine As Integer, dDistance As Double, + dBBoxRad As Double, bTextExt As Boolean, Optional bRot As Boolean = False) As Integer + ' Calcolo altezza testo + Dim dH As Double = 0.05 * dBBoxRad + ' Creo testo + Dim nText As Integer = EgtCreateTextAdv(TextLayer, Point3d.ORIG(), 0, sText, "", 500, False, dH, 1, 0, INS_POS.MC) + ' Calcolo posizionamento + ' BBox del testo e suo centro + Dim ptMinBBox As Point3d + Dim ptMaxBBox As Point3d + EgtGetBBox(nText, GDB_BB.STANDARD, ptMinBBox, ptMaxBBox) + Dim ptMidBBox As Point3d + ptMidBBox = Point3d.Media(ptMinBBox, ptMaxBBox) + ' estremi della CurrLine + Dim ptLineStart As Point3d + EgtStartPoint(CurrLine, nText, ptLineStart) + Dim ptLineEnd As Point3d + EgtEndPoint(CurrLine, nText, ptLineEnd) + ' versore della CurrLine + Dim vtCurrLine As Vector3d = ptLineEnd - ptLineStart + vtCurrLine.Normalize() + ' versore perpendicolare alla CurrLine che punta verso il testo + Dim vtOrtoLine As New Vector3d(vtCurrLine) + If bTextExt Then + vtOrtoLine.Rotate(Vector3d.Z_AX(), -90) + Else + vtOrtoLine.Rotate(Vector3d.Z_AX(), 90) + End If + ' eventuale rotazione del testo + Dim dRotAng As Double = 0 + If bRot Then + dRotAng = Math.Atan2(vtCurrLine.y, vtCurrLine.x) * 180 / Math.PI + Dim dSpecRotAng = dRotAng + If dSpecRotAng > 91 Then + dSpecRotAng -= 180 + ElseIf dSpecRotAng < -89 Then + dSpecRotAng += 180 + End If + EgtRotate(nText, Point3d.ORIG(), Vector3d.Z_AX(), dSpecRotAng) + End If + ' vettore dal centro del BBox all'estremo più vicino + Dim vtptExtptMC As Vector3d + If bRot Then + vtptExtptMC = New Vector3d(0, ptMidBBox.y - ptMinBBox.y, 0) + vtptExtptMC.Rotate(Vector3d.Z_AX(), dRotAng) + Else + If bTextExt Then + If vtCurrLine.x > 0 Then + If vtCurrLine.y > 0 Then + vtptExtptMC = ptMidBBox - New Point3d(ptMinBBox.x, ptMaxBBox.y, 0) + Else + vtptExtptMC = ptMidBBox - ptMaxBBox + End If + Else + If vtCurrLine.y > 0 Then + vtptExtptMC = ptMidBBox - ptMinBBox + Else + vtptExtptMC = ptMidBBox - New Point3d(ptMaxBBox.x, ptMinBBox.y, 0) + End If + End If + Else + If vtCurrLine.x > 0 Then + If vtCurrLine.y > 0 Then + vtptExtptMC = ptMidBBox - New Point3d(ptMaxBBox.x, ptMinBBox.y, 0) + Else + vtptExtptMC = ptMidBBox - ptMinBBox + End If + Else + If vtCurrLine.y > 0 Then + vtptExtptMC = ptMidBBox - ptMaxBBox + Else + vtptExtptMC = ptMidBBox - New Point3d(ptMinBBox.x, ptMaxBBox.y, 0) + End If + End If + End If + End If + ' Calcolo il centro del testo + Dim ptTextMC As Point3d = Point3d.Media(ptLineStart, ptLineEnd) + vtOrtoLine * (dDistance + (vtOrtoLine * vtptExtptMC)) + EgtMove(nText, (ptTextMC - Point3d.ORIG())) + Return nText + End Function + + '-------------------------------------------------------------------------------------------------- + Friend Class ColorSideAngs + Class CTSA + Friend m_R As Integer + Friend m_G As Integer + Friend m_B As Integer + Friend m_dAng As Double + Friend m_dHeel As Double + End Class + Private m_ListCtsa As New List(Of CTSA) + Private m_nTol As Integer = 10 + + Friend Function Read( sIniFile As String) As Boolean + ' Lettura parametri di conversione + Dim nIndex As Integer = 1 + Dim OneCtsa As CTSA = GetPrivateProfileColorSideAng( S_COLORTOSIDEANG, K_CTSA & nIndex, sIniFile) + While Not IsNothing(OneCtsa) + m_ListCtsa.Add(OneCtsa) + nIndex += 1 + OneCtsa = GetPrivateProfileColorSideAng( S_COLORTOSIDEANG, K_CTSA & nIndex, sIniFile) + End While + ' Lettura tolleranza + m_nTol = GetPrivateProfileInt( S_COLORTOSIDEANG, K_CTSA_TOLERANCE, 10, sIniFile) + Return True + End Function + + Private Function GetPrivateProfileColorSideAng( sSect As String, sKey As String, sIniFile As String) As CTSA + Dim OneCtsa As New CTSA + Dim sVal As String = String.Empty + GetPrivateProfileString(sSect, sKey, "", sVal, sIniFile) + Dim sItems() As String = sVal.Split(",".ToCharArray) + If sItems.Count() = 5 Then + StringToInt( sItems(0), OneCtsa.m_R) + StringToInt( sItems(1), OneCtsa.m_G) + StringToInt( sItems(2), OneCtsa.m_B) + StringToDouble( sItems(3), OneCtsa.m_dAng) + StringToDouble( sItems(4), OneCtsa.m_dHeel) + Return OneCtsa + End If + Return Nothing + End Function + + Friend Function GetSideAngHeel( cCol As Color3d, ByRef dAng As Double, ByRef dHeel As Double) As Boolean + For Each Ctsa In m_ListCtsa + If 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 + dAng = Ctsa.m_dAng + dHeel = Ctsa.m_dHeel + Return True + End If + Next + Return False + End Function + + End Class + +End Module diff --git a/SideAngleUc.xaml.vb b/SideAngleUc.xaml.vb index 55e213e..77a2b52 100644 --- a/SideAngleUc.xaml.vb +++ b/SideAngleUc.xaml.vb @@ -441,13 +441,13 @@ Public Class SideAngleUC For Each Entity In m_SideAngleEntityList Dim sText As String = Entity.sEntityName & " = " & DoubleToString(Entity.dSideAngle, 1) & "°" If Entity.dSideHeel > 10 * EPS_SMALL Then sText += "; " & LenToString(Entity.dSideHeel, 1) - AddTextToLine(sText, Entity.nTextId, Entity.nGeomId, 20, dBBoxRad, True) + SideAngle.AddTextToLine(sText, Entity.nTextId, Entity.nGeomId, 20, dBBoxRad, True) Next ' Altrimenti modalità gocciolatoio Else ' Per ogni entità creo testo con nome For Each Entity In m_DripEntityList - AddTextToLine(Entity.sEntityName, Entity.nTextId, Entity.nGeomId, 20, dBBoxRad, True) + SideAngle.AddTextToLine(Entity.sEntityName, Entity.nTextId, Entity.nGeomId, 20, dBBoxRad, True) Next ' Creo le geometrie dei gocciolatoi CreateDripGeom(PartId) @@ -558,7 +558,7 @@ Public Class SideAngleUC ' Creo testo con angolo di inclinazione ed eventuale tallone Dim sText As String = sEntityName & " = " & DoubleToString(dSideAngleVal, 1) & "°" If dSideHeelVal > 10 * EPS_SMALL Then sText += "; " & LenToString(dSideHeelVal, 1) - AddTextToLine(sText, TextLayer, CurrLine, 20, dBBoxRad, True) + SideAngle.AddTextToLine(sText, TextLayer, CurrLine, 20, dBBoxRad, True) End Sub ' Funzione che gestisce le operazioni sull'entità con gocciolatoio @@ -573,92 +573,9 @@ Public Class SideAngleUC EgtGetName(CurrLine, sEntityName) m_DripEntityList.Add(New DripEntity(CurrLine, sEntityName, TextLayer, bHaveDripVal)) ' Creo testo con nome lato - AddTextToLine(sEntityName, TextLayer, CurrLine, 20, dBBoxRad, True) + SideAngle.AddTextToLine(sEntityName, TextLayer, CurrLine, 20, dBBoxRad, True) End Sub - ' Funzione che dato un segmento e una distanza, scrive il testo centrato alla sua sinistra (destra se bTextExt) - Friend Shared Function AddTextToLine(sText As String, TextLayer As Integer, CurrLine As Integer, dDistance As Double, - dBBoxRad As Double, bTextExt As Boolean, Optional bRot As Boolean = False) As Integer - ' Calcolo altezza testo - Dim dH As Double = 0.05 * dBBoxRad - ' Creo testo - Dim nText As Integer = EgtCreateTextAdv(TextLayer, Point3d.ORIG(), 0, sText, "", 500, False, dH, 1, 0, INS_POS.MC) - ' Calcolo posizionamento - ' BBox del testo e suo centro - Dim ptMinBBox As Point3d - Dim ptMaxBBox As Point3d - EgtGetBBox(nText, GDB_BB.STANDARD, ptMinBBox, ptMaxBBox) - Dim ptMidBBox As Point3d - ptMidBBox = Point3d.Media(ptMinBBox, ptMaxBBox) - ' estremi della CurrLine - Dim ptLineStart As Point3d - EgtStartPoint(CurrLine, nText, ptLineStart) - Dim ptLineEnd As Point3d - EgtEndPoint(CurrLine, nText, ptLineEnd) - ' versore della CurrLine - Dim vtCurrLine As Vector3d = ptLineEnd - ptLineStart - vtCurrLine.Normalize() - ' versore perpendicolare alla CurrLine che punta verso il testo - Dim vtOrtoLine As New Vector3d(vtCurrLine) - If bTextExt Then - vtOrtoLine.Rotate(Vector3d.Z_AX(), -90) - Else - vtOrtoLine.Rotate(Vector3d.Z_AX(), 90) - End If - ' eventuale rotazione del testo - Dim dRotAng As Double = 0 - If bRot Then - dRotAng = Math.Atan2(vtCurrLine.y, vtCurrLine.x) * 180 / Math.PI - Dim dSpecRotAng = dRotAng - If dSpecRotAng > 91 Then - dSpecRotAng -= 180 - ElseIf dSpecRotAng < -89 Then - dSpecRotAng += 180 - End If - EgtRotate(nText, Point3d.ORIG(), Vector3d.Z_AX(), dSpecRotAng) - End If - ' vettore dal centro del BBox all'estremo più vicino - Dim vtptExtptMC As Vector3d - If bRot Then - vtptExtptMC = New Vector3d(0, ptMidBBox.y - ptMinBBox.y, 0) - vtptExtptMC.Rotate(Vector3d.Z_AX(), dRotAng) - Else - If bTextExt Then - If vtCurrLine.x > 0 Then - If vtCurrLine.y > 0 Then - vtptExtptMC = ptMidBBox - New Point3d(ptMinBBox.x, ptMaxBBox.y, 0) - Else - vtptExtptMC = ptMidBBox - ptMaxBBox - End If - Else - If vtCurrLine.y > 0 Then - vtptExtptMC = ptMidBBox - ptMinBBox - Else - vtptExtptMC = ptMidBBox - New Point3d(ptMaxBBox.x, ptMinBBox.y, 0) - End If - End If - Else - If vtCurrLine.x > 0 Then - If vtCurrLine.y > 0 Then - vtptExtptMC = ptMidBBox - New Point3d(ptMaxBBox.x, ptMinBBox.y, 0) - Else - vtptExtptMC = ptMidBBox - ptMinBBox - End If - Else - If vtCurrLine.y > 0 Then - vtptExtptMC = ptMidBBox - ptMaxBBox - Else - vtptExtptMC = ptMidBBox - New Point3d(ptMinBBox.x, ptMaxBBox.y, 0) - End If - End If - End If - End If - ' Calcolo il centro del testo - Dim ptTextMC As Point3d = Point3d.Media(ptLineStart, ptLineEnd) + vtOrtoLine * (dDistance + (vtOrtoLine * vtptExtptMC)) - EgtMove(nText, (ptTextMC - Point3d.ORIG())) - Return nText - End Function - ' Funzione che crea le geometrie dei gocciolatoi Friend Sub CreateDripGeom(nPartId As Integer) ' Recupero Id layer di contorno esterno @@ -1004,115 +921,6 @@ Public Class SideAngleUC End If End Sub - Friend Sub WriteSideAngleForNest(nCtx As Integer) - ' Imposto contesto corrente - EgtSetCurrentContext(nCtx) - Dim PartId As Integer = EgtGetFirstPart() - While PartId <> GDB_ID.NULL - ' Se richiesti lati paralleli con misura sul top come in TRF, verifico e aggiusto - If GetPrivateProfileInt( S_SIDES, K_PARSIDE_AS_TRF, 0, m_MainWindow.GetIniFile()) <> 0 Then - AdjustAsTrfParSides( PartId) - End If - ' Elimino eventuale precedente layer per testi - EgtErase(EgtGetFirstNameInGroup(PartId, SIDE_ANGLE_LAYER)) - ' Creo layer per testi nesting - Dim TextLayId As Integer = EgtCreateGroup(PartId) - EgtSetName(TextLayId, SIDE_ANGLE_LAYER) - EgtSetColor(TextLayId, New Color3d(0, 0, 128)) - ' Opero su geometria esterna pezzo - WriteSideAngleOnLoop(EgtGetFirstNameInGroup(PartId, NAME_OUTLOOP), TextLayId) - ' Ciclo su geometria interna pezzo - Dim LoopId As Integer = EgtGetFirstNameInGroup(PartId, NAME_INLOOP) - While LoopId <> GDB_ID.NULL - WriteSideAngleOnLoop(LoopId, TextLayId) - LoopId = EgtGetNextName(LoopId, NAME_INLOOP) - End While - PartId = EgtGetNextPart(PartId) - End While - End Sub - - Private Function AdjustAsTrfParSides( PartId As Integer) As Boolean - ' Recupero il loop esterno - Dim LoopId As Integer = EgtGetFirstNameInGroup(PartId, NAME_OUTLOOP) - If LoopId = GDB_ID.NULL Then Return False - ' Scansiono i lati - Dim LineId As Integer = EgtGetFirstInGroup(LoopId) - While LineId <> GDB_ID.NULL - ' Se non è linea con singolo angolo, vado oltre - If Not EgtExistsInfo(LineId, INFO_SIDE_ANGLE) OrElse - EgtExistsInfo(LineId, INFO_SIDE_ANGLE2) OrElse - EgtExistsInfo(LineId, INFO_HEEL) Then - LineId = EgtGetNext(LineId) - Continue While - End If - ' Recupero angolo di fianco e direzione - Dim dSideAng As Double = 0 : EgtGetInfo( LineId, INFO_SIDE_ANGLE, dSideAng) - Dim vtDir As new Vector3d : EgtStartVector( LineId, GDB_ID.ROOT, vtDir) - ' Confronto con le linee successive - Dim OthLId As Integer = EgtGetNext(LineId) - While OthLId <> GDB_ID.NULL - ' Se non è linea con singolo angolo, vado oltre - If Not EgtExistsInfo(OthLId, INFO_SIDE_ANGLE) OrElse - EgtExistsInfo(OthLId, INFO_SIDE_ANGLE2) OrElse - EgtExistsInfo(OthLId, INFO_HEEL) Then - OthLId = EgtGetNext(OthLId) - Continue While - End If - ' Recupero angolo di fianco e direzione - Dim dOthSAng As Double = 0 : EgtGetInfo( OthLId, INFO_SIDE_ANGLE, dOthSAng) - Dim vtOthDir As new Vector3d : EgtStartVector( OthLId, GDB_ID.ROOT, vtOthDir) - ' Se gli angoli sono opposti e le due linee sono controverse - If Math.Abs( dSideAng + dOthSAng) < 10 * EPS_ANG_SMALL AndAlso (vtDir + vtOthDir).IsSmall() Then - EgtSetInfo( LineId, INFO_SIDE_FIXED, 1) - EgtSetInfo( OthLId, INFO_SIDE_FIXED, 1) - Exit While - End If - OthLId = EgtGetNext(OthLId) - End While - LineId = EgtGetNext(LineId) - End While - Return True - End Function - - Private Function WriteSideAngleOnLoop(LoopId As Integer, TextLayId As Integer) As Boolean - ' Verifiche - If LoopId = GDB_ID.NULL Or TextLayId = GDB_ID.NULL Then Return False - ' Calcolo dimensione ingombro Loop - Dim ptMin, ptMax As Point3d - EgtGetBBoxGlob(LoopId, GDB_BB.STANDARD, ptMin, ptMax) - Dim dBBoxRad As Double = 0.5 * Point3d.DistXY(ptMin, ptMax) - ' Ciclo sulle linee di contorno, se hanno info con inclinazione aggiungo testo con angolo - Dim LineId As Integer = EgtGetFirstInGroup(LoopId) - While LineId <> GDB_ID.NULL - Dim dSideAngle As Double = 0 - Dim bSA As Boolean = EgtGetInfo(LineId, INFO_SIDE_ANGLE, dSideAngle) - Dim dSideAngle2 As Double = 0 - Dim bSA2 As Boolean = EgtGetInfo(LineId, INFO_SIDE_ANGLE2, dSideAngle2) - Dim dSideHeel As Double = 0 - Dim bSH As Boolean = EgtGetInfo(LineId, INFO_HEEL, dSideHeel) - If Math.Abs(dSideAngle) > EPS_ANG_SMALL Or ( bSA2 And Not bSH) Then - ' Creo testo con angolo di inclinazione - Dim sText As String = DoubleToString(dSideAngle, 1) & "°" - ' Se presente tallone, lo indico - If bSH then - If dSideHeel > 10 * EPS_SMALL Then - If dSideAngle > 0 Then - sText = sText & "; " & LenToString(dSideHeel, 1) - Else - sText = LenToString(dSideHeel, 1) & "; " & sText - End If - End If - ' se altrimenti presente secondo angolo, lo indico - ElseIf bSA2 then - sText = DoubleToString(dSideAngle2, 1) & "°" & "; " & sText - End If - AddTextToLine(sText, TextLayId, LineId, 15, dBBoxRad, False, True) - End If - LineId = EgtGetNext(LineId) - End While - Return True - End Function - Friend Sub ReLoadSideAnglePage() SideAngleUC_Loaded(Me, New RoutedEventArgs) End Sub diff --git a/Utility.vb b/Utility.vb index 34c75a3..758ef07 100644 --- a/Utility.vb +++ b/Utility.vb @@ -117,42 +117,6 @@ Module Utility If bOldEnMod Then EgtEnableModified() End Sub - Friend Function AdjustFlatPart(nPartId As Integer) As Boolean - ' Ciclo sui layer - Dim nLayerId As Integer = EgtGetFirstLayer(nPartId) - While nLayerId <> GDB_ID.NULL - ' Recupero il layer successivo - Dim nNextLayerId As Integer = EgtGetNextLayer(nLayerId) - ' Recupero il nome del layer - Dim sLayName As String = String.Empty - If EgtGetName(nLayerId, sLayName) Then - ' Se layer OutLoop o InLoop - If String.Compare(sLayName, NAME_OUTLOOP, True) = 0 Or - String.Compare(sLayName, NAME_INLOOP, True) = 0 Then - ' Sistemo i layer per applicare facilmente le lavorazioni - EgtAdjustFlatPartLayer(nLayerId) - End If - ' Se senza nome, lo elimino - Else - EgtErase(nLayerId) - End If - ' Passo al layer successivo - nLayerId = nNextLayerId - End While - Return True - End Function - - Friend Sub AdjustFlatParts() - ' Ciclo sui pezzi - Dim nPartId As Integer = EgtGetFirstPart() - While nPartId <> GDB_ID.NULL - ' Sistemo il pezzo - AdjustFlatPart(nPartId) - ' Passo al pezzo successivo - nPartId = EgtGetNextPart(nPartId) - End While - End Sub - '-------------------------------------------------------------------------------------------------- Public Class Language @@ -184,11 +148,7 @@ Module Utility End Class - Public Function GetPrivateProfileLanguage( - ByVal lpAppName As String, - ByVal lpKeyName As String, - ByVal lpFileName As String) As Language - + 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) @@ -196,7 +156,6 @@ Module Utility Return New Language(sItems(0), sItems(1)) End If Return Nothing - End Function End Module