Imports System.Collections.ObjectModel Imports EgtUILib Imports EgtWPFLib5 Public Class SideEntityControlVM Inherits VMBase Public Enum ModeOpt As Integer SIDEANGLE = 0 ' inclina lato DRIP = 1 ' incidi da sotto ENGRAVE = 2 ' incidi da sopra FILOTOP = 3 ' filo top ALZANDFRONT = 4 ' alzatine e frontalini End Enum Public Enum CallingWindowOpt As Integer COMPO = 0 DXFIMPORT = 1 End Enum ' Variabile che indica se sono in sideangle o drip Friend m_Mode As ModeOpt Friend Shared m_SideAngleCheck As Boolean = False ' Lista di tutte le entità (inclinabili) presenti nel progetto Private m_SideEntityList As ObservableCollection(Of SideEntity) Public Property SideEntityList As ObservableCollection(Of SideEntity) Get Return m_SideEntityList End Get Set(value As ObservableCollection(Of SideEntity)) m_SideEntityList = value End Set End Property ' stampa il nome delle colonne Public ReadOnly Property Legenda_Visibility As Visibility Get If m_Mode = SideEntityControlVM.ModeOpt.FILOTOP OrElse m_SideEntityList.Count() = 0 Then Return Visibility.Collapsed Else Return Visibility.Visible End If End Get End Property Public ReadOnly Property FirstColumnMsg As String Get Dim sMsg As String = "" If m_Mode = SideEntityControlVM.ModeOpt.DRIP OrElse m_Mode = SideEntityControlVM.ModeOpt.ENGRAVE Then ' Start sMsg = EgtMsg(91655) ElseIf m_Mode = SideEntityControlVM.ModeOpt.SIDEANGLE Then ' A° sMsg = EgtMsg(91653) ElseIf m_Mode = SideEntityControlVM.ModeOpt.ALZANDFRONT Then ' Alz sMsg = "Alz." End If Return sMsg End Get End Property Public ReadOnly Property SecondColumnMsg As String Get Dim sMsg As String = "" If m_Mode = SideEntityControlVM.ModeOpt.DRIP OrElse m_Mode = SideEntityControlVM.ModeOpt.ENGRAVE Then ' End sMsg = EgtMsg(91656) ElseIf m_Mode = SideEntityControlVM.ModeOpt.SIDEANGLE Then ' T sMsg = EgtMsg(91654) ElseIf m_Mode = SideEntityControlVM.ModeOpt.ALZANDFRONT Then ' Front sMsg = "Front." End If Return sMsg End Get End Property Private m_Parameter23_Visibility As Visibility Public Property Parameter23_Visibility As Visibility Get Return m_Parameter23_Visibility End Get Set(value As Visibility) m_Parameter23_Visibility = value NotifyPropertyChanged("Parameter23_Visibility") End Set End Property Private m_Parameter4_Visibility As Visibility Public Property Parameter4_Visibility As Visibility Get Return m_Parameter4_Visibility End Get Set(value As Visibility) m_Parameter4_Visibility = value NotifyPropertyChanged(NameOf(Parameter4_Visibility)) End Set End Property Private m_Parameter1_Visibility As Visibility Public ReadOnly Property Parameter1_Visibility As Visibility Get If m_Mode = ModeOpt.SIDEANGLE Then If m_SideAngleCheck Then Return Visibility.Visible Else Return Visibility.Collapsed End If Else Return Visibility.Visible End If End Get End Property Private m_Parameter1 As Double Public Property Parameter1 As String Get If m_Mode = ModeOpt.SIDEANGLE Then Return DoubleToString(m_Parameter1, 2) Else Return LenToString(m_Parameter1, -2) End If End Get Set(value As String) If m_Mode = ModeOpt.SIDEANGLE Then StringToDouble(value, m_Parameter1) SideAngleEntity.m_Parameter1 = m_Parameter1 ' ciclo sui checkbox calcolati sul numero di lati inclinabili presenti For Index As Integer = 0 To m_SideEntityList.Count - 1 ' Nuovo angolo di inclinazione Dim dSideAngle As Double ' Se checked lo imposto al valore letto dalla TxBx If m_SideEntityList(Index).bIsChecked Then StringToDouble(value, dSideAngle) ' altrimenti lo imposto a zero Else dSideAngle = 0 End If ' Lo modifico nella geometria e nella lista inclinazioni ModifySideAngle(m_SideEntityList(Index).sEntityName, dSideAngle) Next ' Aggiorno tutti i testi RefreshSideAngleText() Else StringToLen(value, m_Parameter1) ' Recupero il valore StringToLen(value, m_dDripOffset) ' Creo le geometrie dei gocciolatoi RefreshSideAngleText() End If End Set End Property Private Sub SetParameter1(value As Double) m_Parameter1 = value SideAngleEntity.m_Parameter1 = value NotifyPropertyChanged("Parameter1") End Sub Private m_Parameter2_Visibility As Visibility = Visibility.Visible Public Property Parameter2_Visibility As Visibility Get Return m_Parameter2_Visibility End Get Set(value As Visibility) m_Parameter2_Visibility = value NotifyPropertyChanged("Parameter2_Visbility") End Set End Property Private m_Parameter2 As Double Public Property Parameter2 As String Get If m_Mode = ModeOpt.SIDEANGLE Then Return LenToString(m_Parameter2, 2) Else Return LenToString(m_Parameter2, -2) End If End Get Set(value As String) StringToLen(value, m_Parameter2) If m_Mode = ModeOpt.SIDEANGLE Then SideAngleEntity.m_Parameter2 = m_Parameter2 ' ciclo sui checkbox calcolati sul numero di lati inclinabili presenti For Index As Integer = 0 To m_SideEntityList.Count - 1 ' Nuovo angolo di inclinazione Dim dSideHeel As Double ' Se checked lo imposto al valore letto dalla TxBx If m_SideEntityList(Index).bIsChecked Then dSideHeel = m_Parameter2 ' altrimenti lo imposto a zero Else dSideHeel = 0 End If ' Lo modifico nella geometria e nella lista inclinazioni ModifySideHeel(m_SideEntityList(Index).sEntityName, dSideHeel) Next ' Aggiorno tutti i testi RefreshSideAngleText() Else m_dDripOffset2 = m_Parameter2 ' Creo le geometrie dei gocciolatoi RefreshSideAngleText() End If 'If m_Mode <> ModeOpt.SIDEANGLE Then ' StringToLen(value, m_Parameter2) ' m_dDripOffset2 = m_Parameter2 ' ' Creo le geometrie dei gocciolatoi ' RefreshSideAngleText() 'End If End Set End Property Private Sub SetParameter2(value As Double) m_Parameter2 = value NotifyPropertyChanged("Parameter2") End Sub Private m_Parameter2ab_Visibility As Visibility = Visibility.Visible Public Property Parameter2ab_Visibility As Visibility Get Return m_Parameter2ab_Visibility End Get Set(value As Visibility) m_Parameter2ab_Visibility = value NotifyPropertyChanged("Parameter2ab_Visbility") End Set End Property Private m_Parameter2a As Integer Public Property Parameter2a As String Get Return DoubleToString(m_Parameter2a, 2) End Get Set(value As String) StringToInt(value, m_Parameter2a) ' Recupero il valore StringToInt(value, m_nEngrNbr2) ' Creo le geometrie dei gocciolatoi RefreshSideAngleText() End Set End Property Private Sub SetParameter2a(value As Integer) m_Parameter2a = value SideAngleEntity.m_Parameter2a = value NotifyPropertyChanged("Parameter2a") End Sub Private m_Parameter2b As Double Public Property Parameter2b As String Get Return DoubleToString(m_Parameter2b, 2) End Get Set(value As String) StringToLen(value, m_Parameter2b) ' Recupero il valore StringToLen(value, m_dDripOffset2) ' Creo le geometrie dei gocciolatoi RefreshSideAngleText() End Set End Property Private Sub SetParameter2b(value As Double) m_Parameter2b = value SideAngleEntity.m_Parameter2b = value NotifyPropertyChanged("Parameter2b") End Sub Private m_Parameter3 As Double Public Property Parameter3 As String Get Return LenToString(m_Parameter3, -2) End Get Set(value As String) If m_Mode <> ModeOpt.SIDEANGLE Then StringToLen(value, m_Parameter3) m_dDripDepth = m_Parameter3 ' Creo le geometrie dei gocciolatoi RefreshSideAngleText() End If End Set End Property Private Sub SetParameter3(value As Double) m_Parameter3 = value NotifyPropertyChanged("Parameter3") End Sub Private m_Parameter4 As Double Public Property Parameter4 As String Get Return LenToString(m_Parameter4, -2) End Get Set(value As String) If m_Mode <> ModeOpt.SIDEANGLE Then StringToLen(value, m_Parameter4) m_dDripShort = m_Parameter4 ' Creo le geometrie dei gocciolatoi RefreshSideAngleText() End If End Set End Property Private Sub SetParameter4(value As Double) m_Parameter4 = value NotifyPropertyChanged("Parameter4") End Sub Private m_dSideAngle As Double = 0 Private m_dOffsetFiloTop As Double = 5 Private m_dDepthFiloTop As Double = 5 Private m_dDripOffset As Double = 10 Private m_dDripOffset2 As Double = 0 Private m_nEngrNbr2 As Integer = 1 Private m_dDripDepth As Double = 10 Private m_dDripShort As Double = 0 Private m_CallingWndScene As Scene Private m_CallingWindow As CallingWindowOpt #Region "Messages" Private m_Parameter1Msg As String Public Property Parameter1Msg As String Get Return m_Parameter1Msg End Get Set(value As String) m_Parameter1Msg = value NotifyPropertyChanged("Parameter1Msg") End Set End Property Private m_Parameter2Msg As String Public Property Parameter2Msg As String Get Return m_Parameter2Msg End Get Set(value As String) m_Parameter2Msg = value NotifyPropertyChanged("Parameter2Msg") End Set End Property Public ReadOnly Property Parameter3Msg As String Get Return EgtMsg(MSG_IMPORTPAGEUC + 11) ' Affondamento End Get End Property Public ReadOnly Property Parameter4Msg As String Get Return EgtMsg(MSG_IMPORTPAGEUC + 12) ' Accorciamento End Get End Property #End Region ' Messages #Region "CONSTRUCTOR" Sub New(CallingWindow As CallingWindowOpt, CallingWndScene As Scene, Mode As ModeOpt) SideAngleEntity.m_ModifySideAngle = AddressOf ModifySideAngle SideAngleEntity.m_ModifySideHeel = AddressOf ModifySideHeel SideAngleEntity.m_RefreshSideAngleText = AddressOf RefreshSideAngleText DripEntity.m_ModifyDrip = AddressOf ModifyDrip DripEntity.m_RefreshSideAngleText = AddressOf RefreshSideAngleText m_CallingWindow = CallingWindow m_CallingWndScene = CallingWndScene m_Mode = Mode m_SideEntityList = New ObservableCollection(Of SideEntity) NotifyPropertyChanged("SideEntityList") m_SideAngleCheck = If(GetMainPrivateProfileInt(S_COMPO, K_SIDEMODE, 0) = 0, True, False) SideAngleEntity.dMaxSideAng = GetMainPrivateProfileDouble(S_SIDES, K_MAXSIDEANGLE, SideAngleEntity.STD_MAXSIDEANG) If CallingWindow = CallingWindowOpt.COMPO Then ' Imposto contesto corrente EgtSetCurrentContext(CallingWndScene.GetCtx()) ' Inizializzo lati per angoli (ne compilo la lista e aggiungo la scritta nel disegno) InitSides() RefreshSideAngleText() ElseIf CallingWindow = CallingWindowOpt.DXFIMPORT Then ' Imposto contesto corrente EgtSetCurrentContext(CallingWndScene.GetCtx()) ' Inizializzo lati per angoli (ne compilo la lista e aggiungo la scritta nel disegno) InitSides() RefreshSideAngleText() End If ' Gestisco visualizzazione dei parametri (sotto l'elenco dei parametri) If m_Mode = ModeOpt.SIDEANGLE Or m_Mode = ModeOpt.FILOTOP Then Parameter23_Visibility = Windows.Visibility.Hidden Parameter2_Visibility = Visibility.Visible Parameter2ab_Visibility = Visibility.Hidden Else ' Temporaneamente lo disabilito Parameter23_Visibility = Windows.Visibility.Visible Parameter4_Visibility = Visibility.Collapsed Parameter2ab_Visibility = Visibility.Visible Parameter2_Visibility = Visibility.Hidden End If ' Aggiorno valori delle TextBlock che indicano i titoli delle colonne If m_Mode = ModeOpt.SIDEANGLE Then Parameter1Msg = EgtMsg(MSG_IMPORTPAGEUC + 9) ' Angolo Parameter2Msg = EgtMsg(91002) ' Tallone m_dSideAngle = GetMainPrivateProfileDouble(S_SIDES, K_SIDEANGLE, 45) SetParameter1(m_dSideAngle) ElseIf m_Mode = ModeOpt.FILOTOP Then Parameter1Msg = EgtMsg(MSG_IMPORTPAGEUC + 10) ' Offset Dim x As String = EgtMsg(MSG_IMPORTPAGEUC + 11) Parameter2Msg = EgtMsg(MSG_IMPORTPAGEUC + 11) ' Depth m_dOffsetFiloTop = GetMainPrivateProfileDouble(S_SIDES, K_FILOTOPOFFSET, 5) m_dDepthFiloTop = GetMainPrivateProfileDouble(S_SIDES, K_FILOTOPDEPTH, 5) SetParameter1(m_dOffsetFiloTop) SetParameter2(m_dDepthFiloTop) ElseIf m_Mode <> ModeOpt.ALZANDFRONT Then Parameter1Msg = EgtMsg(MSG_IMPORTPAGEUC + 10) ' Offset Parameter2Msg = EgtMsg(MSG_IMPORTPAGEUC + 16) ' Offset 2 m_dDripOffset = GetMainPrivateProfileDouble(S_SIDES, K_DRIPOFFSET, 20) m_dDripOffset2 = GetMainPrivateProfileDouble(S_SIDES, K_DRIPOFFSET2, 0) m_nEngrNbr2 = GetMainPrivateProfileInt(S_SIDES, K_ENGRAVENUMBER2, 1) m_dDripDepth = GetMainPrivateProfileDouble(S_SIDES, K_DRIPDEPTH, 10) m_dDripShort = GetMainPrivateProfileDouble(S_SIDES, K_DRIPSHORT, 0) SetParameter1(m_dDripOffset) SetParameter2(m_dDripOffset2) SetParameter2a(m_nEngrNbr2) SetParameter2b(m_dDripOffset2) SetParameter3(m_dDripDepth) SetParameter4(m_dDripShort) End If ' imposto la pagina per la gestione delle Alzatine e dei frontalini If m_Mode = ModeOpt.ALZANDFRONT Then Parameter23_Visibility = Windows.Visibility.Hidden Parameter2_Visibility = Visibility.Visible Parameter2ab_Visibility = Visibility.Hidden Parameter1Msg = EgtMsg(MSG_IMPORTPAGEUC + 9) ' Angolo Parameter2Msg = EgtMsg(91002) ' Tallone m_dSideAngle = GetMainPrivateProfileDouble(S_SIDES, K_SIDEANGLE, 45) SetParameter1(m_dSideAngle) End If ' Aggiorno visualizzazione If CallingWindow = CallingWindowOpt.COMPO Then EgtZoom(ZM.ALL) Else EgtDraw() End If End Sub #End Region ' CONSTRUCTOR #Region "METHODS" Private Sub RefreshSideAngleText() ' Imposto contesto corrente EgtSetCurrentContext(m_CallingWndScene.GetCtx()) Dim PartId As Integer = GDB_ID.NULL Dim LoopId As Integer = GDB_ID.NULL If m_CallingWindow = CallingWindowOpt.COMPO Then ' Ricavo nome primo pezzo PartId = If(CompoWindowMap.refCompoSceneHostV.SelectedLayer <> GDB_ID.NULL, EgtGetFirstInGroup(GDB_ID.ROOT), GDB_ID.NULL) ' Recupero nome layer con geometria di contorno (esterno o interno) del pezzo LoopId = CompoWindowMap.refCompoSceneHostV.SelectedLayer ElseIf m_CallingWindow = CallingWindowOpt.DXFIMPORT Then ' Recupero nome pezzo PartId = DxfImportWindowMap.refDxfImportSceneHostV.SelectedPart ' Recupero nome layer con geometria di contorno (esterno o interno) del pezzo LoopId = DxfImportWindowMap.refDxfImportSceneHostV.SelectedLayer End If ' 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) ' Preparo layer con testi inclinazioni (svuotandolo o creandolo) Dim TextLayer As Integer = EgtGetFirstNameInGroup(PartId, SIDE_ANGLE_LAYER) If TextLayer <> GDB_ID.NULL Then EgtEmptyGroup(TextLayer) Else TextLayer = EgtCreateGroup(PartId) EgtSetName(TextLayer, SIDE_ANGLE_LAYER) EgtSetColor(TextLayer, New Color3d(0, 0, 0)) End If ' Se modalità angoli di inclinazione... If m_Mode = ModeOpt.SIDEANGLE Then ' Per ogni entità, creo testo con nome e angolo di inclinazione For Each Entity In m_SideEntityList Dim SideEntity As SideAngleEntity = TryCast(Entity, SideAngleEntity) Dim sText As String = Entity.sEntityName & " = " & DoubleToString(SideEntity.dSideAngle, 1) & "°" If SideEntity.dSideHeel > 10 * EPS_SMALL Then sText += "; " & LenToString(SideEntity.dSideHeel, 1) 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_SideEntityList AddTextToLine(Entity.sEntityName, Entity.nTextId, Entity.nGeomId, 20, dBBoxRad, True) Next ' Creo le geometrie dei gocciolatoi CreateDripGeom(PartId) End If ' Aggiorno visualizzazione EgtDraw() End Sub Private Sub InitSides() Dim PartId As Integer = GDB_ID.NULL Dim LoopId As Integer = GDB_ID.NULL ' Imposto contesto corrente EgtSetCurrentContext(m_CallingWndScene.GetCtx()) If m_CallingWindow = CallingWindowOpt.COMPO Then ' Ricavo nome primo pezzo PartId = If(CompoWindowMap.refCompoSceneHostV.SelectedLayer <> GDB_ID.NULL, EgtGetFirstInGroup(GDB_ID.ROOT), GDB_ID.NULL) ' Ricavo nome layer con geometria esterna pezzo LoopId = CompoWindowMap.refCompoSceneHostV.SelectedLayer ElseIf m_CallingWindow = CallingWindowOpt.DXFIMPORT Then ' Recupero nome pezzo PartId = DxfImportWindowMap.refDxfImportSceneHostV.SelectedPart ' Recupero nome layer con geometria di contorno (esterno o interno) del pezzo LoopId = DxfImportWindowMap.refDxfImportSceneHostV.SelectedLayer End If ' Determino se loop esterno o interno Dim sLoopName As String = "" Dim bOutLoop As Boolean = ( EgtGetName( LoopId, sLoopName) AndAlso sLoopName = NAME_OUTLOOP) ' 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) ' Creo layer per testi se non esiste già Dim TextLayer As Integer = EgtGetFirstNameInGroup(PartId, SIDE_ANGLE_LAYER) If TextLayer = GDB_ID.NULL Then TextLayer = EgtCreateGroup(PartId) EgtSetName(TextLayer, SIDE_ANGLE_LAYER) EgtSetColor(TextLayer, New Color3d(0, 0, 0)) End If Dim PrevLine As Integer = EgtGetLastInGroup(LoopId) Dim CurrLine As Integer = EgtGetFirstInGroup(LoopId) ' Creo indice per numerare le entità in ImportPage Dim nEntityIndex As Integer = 1 Dim nOtherIndex As Integer = 1 ' Ciclo che verifica se possibile inclinare la curva corrente While CurrLine <> GDB_ID.NULL Dim NextLine As Integer = EgtGetNext(CurrLine) If NextLine = GDB_ID.NULL Then NextLine = EgtGetFirstInGroup( LoopId) If m_Mode = ModeOpt.SIDEANGLE Then If VerifySideAnglePossible(PrevLine, CurrLine, NextLine, bOutLoop) Then ' Aggiungo il lato alla lista di quelli inclinabili e ne azzero l'inclinazione AddSideAngle(CurrLine, TextLayer, dBBoxRad, nEntityIndex) nEntityIndex += 1 Else EgtSetName(CurrLine, "B" & nOtherIndex.ToString()) nOtherIndex += 1 End If ElseIf m_Mode = ModeOpt.FILOTOP Then Else If VerifyIsSideDripPossible(PrevLine, CurrLine, NextLine) Then ' Aggiungo il lato alla lista di quelli su cui è possibile mettere il gocciolatoio AddDripSide(CurrLine, TextLayer, dBBoxRad, nEntityIndex) Dim CurrEntity As DripEntity = DirectCast(m_SideEntityList.Last, DripEntity) If m_Mode = ModeOpt.ENGRAVE Then CurrEntity.dShortStart = GetMainPrivateProfileDouble(S_SIDES, K_ENGRAVESHORT & "A" & nEntityIndex.ToString & "_Start", 0) CurrEntity.dShortEnd = GetMainPrivateProfileDouble(S_SIDES, K_ENGRAVESHORT & "A" & nEntityIndex.ToString & "_End", 0) Else CurrEntity.dShortStart = GetMainPrivateProfileDouble(S_SIDES, K_DRIPSHORT & "A" & nEntityIndex.ToString & "_Start", 0) CurrEntity.dShortEnd = GetMainPrivateProfileDouble(S_SIDES, K_DRIPSHORT & "A" & nEntityIndex.ToString & "_End", 0) End If nEntityIndex += 1 Else EgtSetName( CurrLine, "B" & nOtherIndex.ToString()) nOtherIndex += 1 End If End If PrevLine = CurrLine CurrLine = EgtGetNext(CurrLine) End While ' Se non ci sono lati su cui operare, messaggio utente If LoopId <> GDB_ID.NULL Then If m_SideEntityList.Count() = 0 Then If m_CallingWindow = CallingWindowOpt.COMPO Then CompoWindowMap.refCompoListPageVM.SetOutputMessage(EgtMsg(MSG_DRAWPAGEUC + 7), MSG_TYPE.WARNING) ' Non ci sono lati modificabili Else DxfImportWindowMap.refDxfImportWindowVM.SetOutputMessage(EgtMsg(MSG_DRAWPAGEUC + 7), MSG_TYPE.WARNING) ' Non ci sono lati modificabili End If Else If m_CallingWindow = CallingWindowOpt.COMPO Then CompoWindowMap.refCompoListPageVM.ClearOutputMessage() Else DxfImportWindowMap.refDxfImportWindowVM.ClearOutputMessage() End If End If End If ' Aggiorno interfaccia If m_CallingWindow = CallingWindowOpt.DXFIMPORT Then If m_Mode = ModeOpt.SIDEANGLE Then For Each Entity In m_SideEntityList If DirectCast(Entity, SideAngleEntity).dSideAngle <> 0 Then Dim nI As Integer = 0 StringToInt(Entity.sEntityName.Substring(1), nI) CheckSide(nI) End If Next Else For Each Entity In m_SideEntityList If DirectCast(Entity, DripEntity).bHaveDrip Then Dim nI As Integer = 0 StringToInt(Entity.sEntityName.Substring(1), nI) CheckSide(nI) End If Next End If End If End Sub 'Funzione che checka i lati Private Sub CheckSide(nIndex As Integer) '' Seleziono checkbox 'If m_Mode = ModeOpt.SIDEANGLE Then ' GetChBxFromIndex(10 - (m_SideEntityList.Count - nIndex)).IsChecked = True 'Else ' GetChBxFromIndex(10 - (m_SideEntityList.Count - nIndex)).IsChecked = True 'End If End Sub ' Funzione che verifica se alla linea corrente è associabile un canalino Private Function VerifyIsSideDripPossible(LastLine As Integer, CurrLine As Integer, NextLine As Integer) As Boolean ' Verifico se CurrLine è una linea If EgtGetType(CurrLine) <> GDB_TY.CRV_LINE Then Return False End If Return True End Function ' Funzione che gestisce le operazioni sull'entità da inclinare Private Sub AddSideAngle(CurrLine As Integer, TextLayer As Integer, dBBoxRad As Double, nEntityIndex As Integer) ' Imposto nome del lato EgtSetName(CurrLine, "A" & nEntityIndex.ToString()) ' Ricavo angolo dell'entità Dim dSideAngleVal As Double If Not EgtGetInfo(CurrLine, INFO_SIDE_ANGLE, dSideAngleVal) Then dSideAngleVal = 0 ' Ricavo tallone dell'entità Dim dSideHeelVal As Double If Not EgtGetInfo(CurrLine, INFO_HEEL, dSideHeelVal) Then dSideHeelVal = 0 ' Aggiungo entità all'elenco di quelle inclinabili Dim sEntityName As String = String.Empty EgtGetName(CurrLine, sEntityName) m_SideEntityList.Add(New SideAngleEntity(CurrLine, sEntityName, TextLayer, dSideAngleVal, dSideHeelVal, m_Mode)) NotifyPropertyChanged("Legenda_Visibility") ' 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) End Sub ' Funzione che gestisce le operazioni sull'entità con gocciolatoio Private Sub AddDripSide(CurrLine As Integer, TextLayer As Integer, dBBoxRad As Double, nEntityIndex As Integer) ' Imposto nome del lato EgtSetName(CurrLine, "A" & nEntityIndex.ToString()) ' Ricavo info dell'entità Dim bHaveDripVal As Boolean If Not EgtGetInfo(CurrLine, INFO_HAVE_DRIP, bHaveDripVal) Then bHaveDripVal = False ' Aggiungo entità all'elenco di quelle che possono avere il gocciolatoio Dim sEntityName As String = String.Empty EgtGetName(CurrLine, sEntityName) Dim CurrEntity As DripEntity = New DripEntity(CurrLine, sEntityName, TextLayer, bHaveDripVal, m_Mode) m_SideEntityList.Add(CurrEntity) NotifyPropertyChanged("Legenda_Visibility") ' Creo testo con angolo di inclinazione 0 AddTextToLine(sEntityName, TextLayer, CurrLine, 20, dBBoxRad, True) End Sub ' Funzione che dato un segmento e una distanza, scrive il testo centrato alla sua destra 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, New Point3d(0, 0, 0), 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) ' Punto medio della curva Dim ptMid As Point3d EgtMidPoint( CurrLine, nText, ptMid) ' Versore sul punto medio della curva Dim vtMid As Vector3d EgtMidVector( CurrLine, nText, vtMid) ' versore perpendicolare alla CurrLine che punta verso il testo Dim vtOrto As New Vector3d(vtMid) If bTextExt Then vtOrto.Rotate(Vector3d.Z_AX(), -90) Else vtOrto.Rotate(Vector3d.Z_AX(), 90) End If ' eventuale rotazione del testo Dim dRotAng As Double = 0 If bRot Then dRotAng = Math.Atan2(vtMid.y, vtMid.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 vtMid.x > 0 Then If vtMid.y > 0 Then vtptExtptMC = ptMidBBox - New Point3d(ptMinBBox.x, ptMaxBBox.y, 0) Else vtptExtptMC = ptMidBBox - ptMaxBBox End If Else If vtMid.y > 0 Then vtptExtptMC = ptMidBBox - ptMinBBox Else vtptExtptMC = ptMidBBox - New Point3d(ptMaxBBox.x, ptMinBBox.y, 0) End If End If Else If vtMid.x > 0 Then If vtMid.y > 0 Then vtptExtptMC = ptMidBBox - New Point3d(ptMaxBBox.x, ptMinBBox.y, 0) Else vtptExtptMC = ptMidBBox - ptMinBBox End If Else If vtMid.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 = ptMid + vtOrto * (dDistance + (vtOrto * vtptExtptMC)) EgtMove(nText, (ptTextMC - Point3d.ORIG)) Return nText End Function ' Funzione che crea le geometrie dei gocciolatoi Friend Sub CreateDripGeomAll(nPartId As Integer) ' Recupero Id layer di contorno esterno Dim nOutLoopId = EgtGetFirstNameInGroup(nPartId, NAME_OUTLOOP) ' Preparo layer con geometria gocciolatoi (svuotandolo o creandolo) Dim DripName As String = If(m_Mode = ModeOpt.DRIP, NAME_DRIPCUT, NAME_ONPATH) Dim DripLayer As Integer = EgtGetFirstNameInGroup(nPartId, DripName) If DripLayer <> GDB_ID.NULL Then EgtEmptyGroup(DripLayer) Else DripLayer = EgtCreateGroup(nPartId) EgtSetName(DripLayer, DripName) End If ' Per ogni entità con gocciolatoio, ne inserisco una copia nel layer Dim vSelId As New List(Of Integer) For Each Entity In m_SideEntityList If DirectCast(Entity, DripEntity).bHaveDrip Then Dim nSouId As Integer = EgtGetFirstNameInGroup(nOutLoopId, Entity.sEntityName) Dim nNewId As Integer = EgtCopyGlob(nSouId, DripLayer) EgtSetName(nNewId, Entity.sEntityName) vSelId.Add(nNewId) End If Next ' Eseguo eventuali allungamenti iniziali e finali Dim nCrvId As Integer = EgtGetFirstInGroup(DripLayer) While nCrvId <> GDB_ID.NULL If m_dDripShort < -EPS_SMALL Then EgtExtendCurveStartByLen(nCrvId, -m_dDripShort) EgtExtendCurveEndByLen(nCrvId, -m_dDripShort) End If nCrvId = EgtGetNext(nCrvId) End While ' Concateno le curve EgtCreateCurveCompoByReorder(DripLayer, vSelId.Count(), vSelId.ToArray(), New Point3d(), True) ' Eseguo eventuali accorciamenti iniziali e finali nCrvId = EgtGetFirstInGroup(DripLayer) While nCrvId <> GDB_ID.NULL If m_dDripShort > EPS_SMALL AndAlso Not EgtCurveIsClosed(nCrvId) Then Dim dLen As Double EgtCurveLength(nCrvId, dLen) EgtTrimCurveEndAtLen(nCrvId, dLen - m_dDripShort) EgtTrimCurveStartAtLen(nCrvId, m_dDripShort) End If nCrvId = EgtGetNext(nCrvId) End While ' Eseguo offset dei risultati nCrvId = EgtGetFirstInGroup(DripLayer) While nCrvId <> GDB_ID.NULL EgtOffsetCurve(nCrvId, -m_dDripOffset, OFF_TYPE.EXTEND) nCrvId = EgtGetNext(nCrvId) End While ' Eventuali curve aggiuntive con offset2 If m_nEngrNbr2 > 0 And m_dDripOffset2 > EPS_SMALL Then nCrvId = EgtGetFirstInGroup(DripLayer) While nCrvId <> GDB_ID.NULL Dim nNextCrvId As Integer = EgtGetNext(nCrvId) For i As Integer = 1 To m_nEngrNbr2 Dim nNewId As Integer = EgtCopy(nCrvId, nCrvId, GDB_POS.AFTER) EgtOffsetCurve(nNewId, -i * m_dDripOffset2, OFF_TYPE.EXTEND) Next nCrvId = nNextCrvId End While End If If m_Mode = ModeOpt.DRIP Then ' Esplodo nelle curve componenti nCrvId = EgtGetFirstInGroup(DripLayer) While nCrvId <> GDB_ID.NULL Dim nNextCrvId = EgtGetNext(nCrvId) Dim nCount As Integer EgtExplodeCurveCompo(nCrvId, nCount) nCrvId = nNextCrvId End While ' Assegno colore e attributi nCrvId = EgtGetFirstInGroup(DripLayer) While nCrvId <> GDB_ID.NULL EgtSetColor(nCrvId, COL_MCH_DRIPCUT()) EgtSetInfo(nCrvId, INFO_DEPTH, m_dDripDepth) If m_dDripShort > EPS_SMALL Then EgtSetInfo(nCrvId, INFO_STRICT, "1") nCrvId = EgtGetNext(nCrvId) End While Else ' Assegno colore e attributi nCrvId = EgtGetFirstInGroup(DripLayer) While nCrvId <> GDB_ID.NULL EgtSetColor(nCrvId, COL_MCH_DRIPCUT()) EgtSetInfo(nCrvId, INFO_DEPTH, m_dDripDepth) EgtSetInfo(nCrvId, INFO_STRICT, If(m_dDripShort > EPS_SMALL, "3", "0")) nCrvId = EgtGetNext(nCrvId) End While End If End Sub Friend Sub CreateDripGeom(nPartId As Integer) If nPartId = GDB_ID.NULL Then Return ' Recupero Id layer di contorno esterno Dim nOutLoopId = EgtGetFirstNameInGroup(nPartId, NAME_OUTLOOP) ' Preparo layer con geometria gocciolatoi (svuotandolo o creandolo) Dim DripName As String = If(m_Mode = ModeOpt.DRIP, NAME_DRIPCUT, NAME_ONPATH) Dim DripLayer As Integer = EgtGetFirstNameInGroup(nPartId, DripName) If DripLayer <> GDB_ID.NULL Then EgtEmptyGroup(DripLayer) Else DripLayer = EgtCreateGroup(nPartId) EgtSetName(DripLayer, DripName) End If ' Per ogni entità con gocciolatoio, ne inserisco una copia nel layer Dim vSelId As New List(Of Integer) Dim vTempSelId As New List(Of Integer) Dim nIndex As Integer = 0 Dim vJoint As New List(Of Boolean) Dim bJointStart As Boolean = False For Each Entity In m_SideEntityList If DirectCast(Entity, DripEntity).bHaveDrip Then vJoint.Add(True) Else vJoint.Add(False) End If Next If vJoint(0) And vJoint(vJoint.Count - 1) Then bJointStart = True End If For Each Entity In m_SideEntityList Dim objDripEtity As DripEntity = DirectCast(Entity, DripEntity) If objDripEtity.bHaveDrip Then Dim nSouId As Integer = EgtGetFirstNameInGroup(nOutLoopId, objDripEtity.sEntityName) Dim nNewId As Integer = EgtCopyGlob(nSouId, DripLayer) EgtSetName(nNewId, objDripEtity.sEntityName) vSelId.Add(nNewId) vTempSelId.Add(nNewId) End If ' devo distingure i casi in cui inserisco un valore positivo ed uno negativo! For Each IdCurve In vTempSelId ' accorcio entrmabi i lati Dim dLen As Double EgtCurveLength(IdCurve, dLen) If nIndex = vJoint.Count - 1 And (Not bJointStart Or objDripEtity.dShortEnd <> 0) Then ' se l'ultimo segmento non è collegato al primo If objDripEtity.dShortEnd > -EPS_SMALL Then EgtTrimCurveEndAtLen(IdCurve, dLen - objDripEtity.dShortEnd) Else EgtExtendCurveEndByLen(IdCurve, -objDripEtity.dShortEnd) End If ElseIf nIndex < vJoint.Count - 1 Then ' se l'elemento corrente non è collegato al precedente allora accorcio la coda If Not vJoint(nIndex + 1) Or objDripEtity.dShortEnd <> 0 Then If objDripEtity.dShortEnd > -EPS_SMALL Then EgtTrimCurveEndAtLen(IdCurve, dLen - objDripEtity.dShortEnd) Else EgtExtendCurveEndByLen(IdCurve, -objDripEtity.dShortEnd) End If End If End If If nIndex = 0 And (Not bJointStart Or objDripEtity.dShortStart <> 0) Then ' se il primo elemento non è collegato all'ultimo If objDripEtity.dShortStart > -EPS_SMALL Then EgtTrimCurveStartAtLen(IdCurve, objDripEtity.dShortStart) Else EgtExtendCurveStartByLen(IdCurve, -objDripEtity.dShortStart) End If ElseIf nIndex > 0 Then ' se l'elemento precedente non è collegato al corrente allora accorcio la testa If Not vJoint(nIndex - 1) Or objDripEtity.dShortStart <> 0 Then If objDripEtity.dShortStart > -EPS_SMALL Then EgtTrimCurveStartAtLen(IdCurve, objDripEtity.dShortStart) Else EgtExtendCurveStartByLen(IdCurve, -objDripEtity.dShortStart) End If End If End If Next vTempSelId.Clear() nIndex = nIndex + 1 Next ' se tutti i lati sono accorciati allora eseguo il collegamento EgtCreateCurveCompoByReorder(DripLayer, vSelId.Count(), vSelId.ToArray(), New Point3d(), True) ' Eseguo offset dei risultati Dim nCrvId = EgtGetFirstInGroup(DripLayer) While nCrvId <> GDB_ID.NULL EgtOffsetCurve(nCrvId, -m_dDripOffset, OFF_TYPE.EXTEND) nCrvId = EgtGetNext(nCrvId) End While ' Eventuali curve aggiuntive con offset2 If m_nEngrNbr2 > 0 And m_dDripOffset2 > EPS_SMALL Then nCrvId = EgtGetFirstInGroup(DripLayer) While nCrvId <> GDB_ID.NULL Dim nNextCrvId As Integer = EgtGetNext(nCrvId) For i As Integer = 1 To m_nEngrNbr2 Dim nNewId As Integer = EgtCopy(nCrvId, nCrvId, GDB_POS.AFTER) EgtOffsetCurve(nNewId, -i * m_dDripOffset2, OFF_TYPE.EXTEND) Next nCrvId = nNextCrvId End While End If If m_Mode = ModeOpt.DRIP Then ' Esplodo nelle curve componenti nCrvId = EgtGetFirstInGroup(DripLayer) While nCrvId <> GDB_ID.NULL Dim nNextCrvId = EgtGetNext(nCrvId) Dim nCount As Integer EgtExplodeCurveCompo(nCrvId, nCount) nCrvId = nNextCrvId End While ' Assegno colore e attributi nCrvId = EgtGetFirstInGroup(DripLayer) While nCrvId <> GDB_ID.NULL EgtSetColor(nCrvId, COL_MCH_DRIPCUT()) EgtSetInfo(nCrvId, INFO_DEPTH, m_dDripDepth) If m_dDripShort > EPS_SMALL Then EgtSetInfo(nCrvId, INFO_STRICT, "1") nCrvId = EgtGetNext(nCrvId) End While Else ' Assegno colore e attributi nCrvId = EgtGetFirstInGroup(DripLayer) While nCrvId <> GDB_ID.NULL EgtSetColor(nCrvId, COL_MCH_DRIPCUT()) EgtSetInfo(nCrvId, INFO_DEPTH, m_dDripDepth) EgtSetInfo(nCrvId, INFO_STRICT, If(m_dDripShort > EPS_SMALL, "3", "0")) nCrvId = EgtGetNext(nCrvId) End While End If End Sub ' Funzione che modifica l'inclinazione di un lato Friend Function ModifySideAngle(sEntityName As String, dSideAngle As Double) As Boolean ' Ricavo CurrEntity dal nome Dim CurrEntity As SideAngleEntity = SideAngleEntity.FindEntity(sEntityName, m_SideEntityList) If IsNothing(CurrEntity) Then EgtOutLog("Error in side angle definition: selected line not found in SideAngleList") Return False End If ' Scrivo nuovo angolo nelle info If dSideAngle <> 0 Then EgtSetInfo(CurrEntity.nGeomId, INFO_SIDE_ANGLE, dSideAngle) EgtSetInfo(CurrEntity.nGeomId, INFO_ORIG_SIDE_ANGLE, dSideAngle) ' Cancello inclinazione nell'apposito campo info Else EgtRemoveInfo(CurrEntity.nGeomId, INFO_SIDE_ANGLE) EgtRemoveInfo(CurrEntity.nGeomId, INFO_ORIG_SIDE_ANGLE) End If ' Aggiorno lista entità con nuova inclinazione CurrEntity.dSideAngle = dSideAngle Return True End Function ' Funzione che modifica il tallone di un lato Friend Function ModifySideHeel(sEntityName As String, dSideHeel As Double) As Boolean ' Ricavo CurrEntity dal nome Dim CurrEntity As SideAngleEntity = SideAngleEntity.FindEntity(sEntityName, m_SideEntityList) If IsNothing(CurrEntity) Then EgtOutLog("Error in side angle definition: selected line not found in SideAngleList") Return False End If ' Scrivo nuovo tallone nelle info If dSideHeel > 10 * EPS_SMALL Then EgtSetInfo(CurrEntity.nGeomId, INFO_HEEL, dSideHeel) ' Cancello inclinazione nell'apposito campo info Else EgtRemoveInfo(CurrEntity.nGeomId, INFO_HEEL) End If ' Aggiorno lista entità con nuova inclinazione CurrEntity.dSideHeel = dSideHeel Return True End Function ' Funzione che modifica l'inclinazione di un lato Friend Function ModifyDrip(sEntityName As String, bVal As Boolean) As Boolean ' Ricavo CurrEntity dal nome Dim CurrEntity As DripEntity = DripEntity.FindEntity(sEntityName, m_SideEntityList) If IsNothing(CurrEntity) Then EgtOutLog("Error in drip definition: selected line not found in DripEntity") Return False End If ' Scrivo nuovo angolo nelle info If bVal Then EgtSetInfo(CurrEntity.nGeomId, INFO_HAVE_DRIP, "1") ' Cancello inclinazione nell'apposito campo info Else EgtRemoveInfo(CurrEntity.nGeomId, INFO_HAVE_DRIP) End If ' Aggiorno lista entità con nuova inclinazione CurrEntity.bHaveDrip = bVal Return True End Function Friend Sub ReLoadSideAnglePage(CallingWindow As CallingWindowOpt) m_SideEntityList.Clear() NotifyPropertyChanged("Legenda_Visibility") If CallingWindow = CallingWindowOpt.COMPO Then ' Imposto contesto corrente EgtSetCurrentContext(m_CallingWndScene.GetCtx()) ' Inizializzo lati per angoli (ne compilo la lista e aggiungo la scritta nel disegno) InitSides() RefreshSideAngleText() ElseIf CallingWindow = CallingWindowOpt.DXFIMPORT Then ' Imposto contesto corrente EgtSetCurrentContext(m_CallingWndScene.GetCtx()) ' Inizializzo lati per angoli (ne compilo la lista e aggiungo la scritta nel disegno) InitSides() RefreshSideAngleText() End If ' Gestisco visualizzazione dei parametri If m_Mode = ModeOpt.SIDEANGLE Then Parameter23_Visibility = Windows.Visibility.Hidden Else Parameter23_Visibility = Windows.Visibility.Visible End If ' Aggiorno valori If m_Mode = ModeOpt.SIDEANGLE Then Parameter1Msg = EgtMsg(MSG_IMPORTPAGEUC + 9) ' Angolo Dim dVal As Double = GetMainPrivateProfileDouble(S_SIDES, K_SIDEANGLE, 45) SetParameter1(dVal) Else Parameter1Msg = EgtMsg(MSG_IMPORTPAGEUC + 10) ' Offset m_dDripOffset = GetMainPrivateProfileDouble(S_SIDES, K_DRIPOFFSET, 20) m_dDripOffset2 = GetMainPrivateProfileDouble(S_SIDES, K_DRIPOFFSET2, 0) m_nEngrNbr2 = GetMainPrivateProfileInt(S_SIDES, K_ENGRAVENUMBER2, 0) m_dDripDepth = GetMainPrivateProfileDouble(S_SIDES, K_DRIPDEPTH, 10) m_dDripShort = GetMainPrivateProfileDouble(S_SIDES, K_DRIPSHORT, 0) SetParameter1(m_dDripOffset) SetParameter2(m_dDripOffset2) SetParameter2a(m_nEngrNbr2) SetParameter2b(m_dDripOffset2) SetParameter3(m_dDripDepth) SetParameter4(m_dDripShort) End If End Sub Friend Sub Close() If m_CallingWindow = CallingWindowOpt.COMPO Then ' Svuoto layer in cui sono presenti i testi con le inclinazioni dei lati Dim PartId As Integer = EgtGetFirstInGroup(GDB_ID.ROOT) EgtEmptyGroup(EgtGetFirstNameInGroup(PartId, SIDE_ANGLE_LAYER)) ElseIf m_CallingWindow = CallingWindowOpt.DXFIMPORT Then ' Nessuna azione necessaria End If ' salvo le modifiche nel file config If m_Mode = ModeOpt.SIDEANGLE Then WriteMainPrivateProfileString(S_SIDES, K_SIDEANGLE, DoubleToString(m_Parameter1, 3)) ElseIf m_Mode = ModeOpt.FILOTOP Then WriteMainPrivateProfileString(S_SIDES, K_FILOTOPOFFSET, DoubleToString(m_Parameter1, 3)) WriteMainPrivateProfileString(S_SIDES, K_FILOTOPDEPTH, DoubleToString(m_Parameter2, 3)) ' Aggiorno affondamento del profilo Dim nPartId As Integer = EgtGetFirstPart() While nPartId <> GDB_ID.NULL Dim nLayId As Integer = EgtGetFirstLayer(nPartId) While nLayId <> GDB_ID.NULL Dim sLayName As String = "" If EgtGetName(nLayId, sLayName) AndAlso sLayName = NAME_INLOOP AndAlso EgtExistsInfo(nLayId, INFO_FILOTOP) Then EgtSetInfo(nLayId, INFO_OFFSET, m_Parameter1) EgtSetInfo(nLayId, INFO_DEPTH, m_Parameter2) End If nLayId = EgtGetNextLayer(nLayId) End While nPartId = EgtGetNextPart(nPartId) End While ElseIf m_Mode = ModeOpt.DRIP Then WriteMainPrivateProfileString(S_SIDES, K_DRIPOFFSET, DoubleToString(m_dDripOffset, 3)) WriteMainPrivateProfileString(S_SIDES, K_DRIPOFFSET2, DoubleToString(m_dDripOffset2, 3)) WriteMainPrivateProfileString(S_SIDES, K_DRIPDEPTH, DoubleToString(m_dDripDepth, 3)) WriteMainPrivateProfileString(S_SIDES, K_DRIPSHORT, DoubleToString(m_dDripShort, 3)) For Each objEntity In m_SideEntityList If TypeOf objEntity Is DripEntity Then Dim CurrEntity As DripEntity = DirectCast(objEntity, DripEntity) WriteMainPrivateProfileString(S_SIDES, K_DRIPSHORT & CurrEntity.sEntityName & "_Start", LenToString(CurrEntity.dShortStart, 3)) WriteMainPrivateProfileString(S_SIDES, K_DRIPSHORT & CurrEntity.sEntityName & "_End", LenToString(CurrEntity.dShortEnd, 3)) End If Next ElseIf m_Mode = ModeOpt.ENGRAVE Then WriteMainPrivateProfileString(S_SIDES, K_ENGRAVEOFFSET, DoubleToString(m_dDripOffset, 3)) WriteMainPrivateProfileString(S_SIDES, K_ENGRAVEOFFSET2, DoubleToString(m_dDripOffset2, 3)) WriteMainPrivateProfileString(S_SIDES, K_ENGRAVENUMBER2, m_nEngrNbr2.ToString) WriteMainPrivateProfileString(S_SIDES, K_ENGRAVEDEPTH, DoubleToString(m_dDripDepth, 3)) WriteMainPrivateProfileString(S_SIDES, K_ENGRAVESHORT, DoubleToString(m_dDripShort, 3)) For Each objEntity In m_SideEntityList If TypeOf objEntity Is DripEntity Then Dim CurrEntity As DripEntity = DirectCast(objEntity, DripEntity) WriteMainPrivateProfileString(S_SIDES, K_ENGRAVESHORT & CurrEntity.sEntityName & "_Start", LenToString(CurrEntity.dShortStart, 3)) WriteMainPrivateProfileString(S_SIDES, K_ENGRAVESHORT & CurrEntity.sEntityName & "_End", LenToString(CurrEntity.dShortEnd, 3)) End If Next End If EgtDraw() End Sub Shared 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 GetMainPrivateProfileInt( S_SIDES, K_PARSIDE_AS_TRF, 0) <> 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 ' Funzione che verifica se la linea corrente è inclinabile in base al tipo della precedente e successiva Shared Function VerifySideAnglePossible(LastLine As Integer, CurrLine As Integer, NextLine As Integer, bOutLoop As Boolean) As Boolean ' Se WaterJet si tolgono i limiti Dim bSideFree As Boolean = CurrentMachine.bWaterJetting ' Analisi del tipo Select Case EgtGetType(CurrLine) Case GDB_TY.CRV_LINE ' Le linee vanno bene di per sè Case GDB_TY.CRV_ARC If Not bSideFree Then ' Gli archi devono essere lavorati sul lato esterno Dim dAngCen As Double : EgtArcAngCenter(CurrLine, dAngCen) If (bOutLoop And dAngCen < 0) Or (Not bOutLoop And dAngCen > 0) Then Return False End If Case GDB_TY.CRV_COMPO If Not bSideFree Then ' Gli archi componenti devono essere lavorati sul lato esterno Dim nCopyId As Integer = EgtCopy(CurrLine, CurrLine, GDB_POS.AFTER) If nCopyId = GDB_ID.NULL Then Return False Dim bOk As Boolean = True Dim nCount As Integer = 0 Dim nNewId As Integer = EgtExplodeCurveCompo(nCopyId, nCount) For nI As Integer = 0 To nCount - 1 Dim nEntId As Integer = nNewId + nI If EgtGetType(nEntId) = GDB_TY.CRV_ARC Then Dim dAngCen As Double : EgtArcAngCenter(nEntId, dAngCen) If (bOutLoop And dAngCen < 0) Or (Not bOutLoop And dAngCen > 0) Then bOk = False End If EgtErase(nEntId) Next If Not bOk Then Return False End If Case Else Return False End Select ' Se curva chiusa va bene solo se loop esterno If Not bSideFree AndAlso EgtCurveIsClosed(CurrLine) Then Return bOutLoop ' Delta angolare limite per tangenza Const DELTA_ANG_TG_DEF As Double = 5.0 Dim dDeltaAngTg As Double = GetMainPrivateProfileDouble(S_SIDES, K_DELTA_ANG_TG, DELTA_ANG_TG_DEF) If bSideFree Then dDeltaAngTg = 0 ' Verifico se curva precedente mi permette di inclinare Dim bLastOk As Boolean = False Select Case EgtGetType(LastLine) Case GDB_TY.CRV_LINE, GDB_TY.CRV_ARC, GDB_TY.CRV_COMPO ' Ricavo direzione finale linea precedente Dim vtLastEnd As Vector3d EgtEndVector(LastLine, vtLastEnd) ' Ricavo direzione iniziale linea corrente Dim vtCurrStart As Vector3d EgtStartVector(CurrLine, vtCurrStart) ' Confronto direzioni per vedere se sono tangenti Dim dAngDeg As Double = GetAngle(vtLastEnd, vtCurrStart) ' verifico se l'angolo è significativo bLastOk = (dDeltaAngTg < EPS_ANG_SMALL Or dAngDeg > dDeltaAngTg) Case Else EgtOutLog("Error in Compo Outloop: found an entity that is not a line or a arc") End Select ' Verifico se curva successiva mi permette di inclinare Dim bNextOk As Boolean = False Select Case EgtGetType(NextLine) Case GDB_TY.CRV_LINE, GDB_TY.CRV_ARC, GDB_TY.CRV_COMPO ' Ricavo direzione finale linea corrente Dim vtCurrEnd As Vector3d EgtEndVector(CurrLine, vtCurrEnd) ' Ricavo direzione iniziale linea successiva Dim vtNextStart As Vector3d EgtStartVector(NextLine, vtNextStart) ' Confronto direzioni per vedere se sono tangenti Dim dAngDeg As Double = GetAngle(vtCurrEnd, vtNextStart) ' verifico se l'angolo è significativo bNextOk = (dDeltaAngTg < EPS_ANG_SMALL Or dAngDeg > dDeltaAngTg) Case Else EgtOutLog("Error in Compo Outloop: found an entity that is not a line or a arc") End Select ' Se entrambe me lo permettono restituisco vero Return (bLastOk And bNextOk) End Function Shared 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 Shared 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 SideEntityControlVM.AddTextToLine(sText, TextLayId, LineId, 15, dBBoxRad, False, True) End If LineId = EgtGetNext(LineId) End While Return True End Function Shared Sub ColorToSideAngle(nCtx As Integer) ' Leggo dati corrispondenza colore-angolo Dim CurrCSA As New ColorSideAngs CurrCSA.Read(IniFile.m_sIniFile) ' 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 PrevId As Integer = EgtGetLastInGroup(LoopId) Dim EntId As Integer = EgtGetFirstInGroup(LoopId) While EntId <> GDB_ID.NULL Dim NextId As Integer = EgtGetNext(EntId) If NextId = GDB_ID.NULL Then NextId = EgtGetFirstInGroup(LoopId) If VerifySideAnglePossible(PrevId, EntId, NextId, bOutLoop) 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 PrevId = EntId 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 Shared Sub ColorToEngrave(nCtx As Integer) ' Leggo dati corrispondenza colore-angolo Dim CurrCE As New ColorEngrave CurrCE.Read(IniFile.m_sIniFile) ' 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 #End Region ' METHODS End Class Public MustInherit Class SideEntity Inherits VMBase Private m_nGeomId As Integer Public Property nGeomId As Integer Get Return m_nGeomId End Get Set(value As Integer) m_nGeomId = value End Set End Property Private m_sEntityName As String Public ReadOnly Property sEntityName As String Get Return m_sEntityName End Get End Property Private m_nTextId As Integer Public ReadOnly Property nTextId As Integer Get Return m_nTextId End Get End Property Private m_Mode As SideEntityControlVM.ModeOpt Public ReadOnly Property Value_Visibility As Visibility Get If m_Mode = SideEntityControlVM.ModeOpt.SIDEANGLE Then If SideEntityControlVM.m_SideAngleCheck Then Return Visibility.Collapsed Else Return Visibility.Visible End If ElseIf m_Mode = SideEntityControlVM.ModeOpt.ALZANDFRONT Then Return Visibility.Collapsed Else Return Visibility.Collapsed End If End Get End Property Public ReadOnly Property Check_Visibility As Visibility Get If m_Mode = SideEntityControlVM.ModeOpt.SIDEANGLE Then If SideEntityControlVM.m_SideAngleCheck Then Return Visibility.Visible Else Return Visibility.Collapsed End If ElseIf m_Mode = SideEntityControlVM.ModeOpt.ALZANDFRONT Then Return Visibility.Collapsed Else Return Visibility.Visible End If End Get End Property ' imposto la visibilità delle TextBox per Drip ed Engrave Public ReadOnly Property Value_Visibility_DE As Visibility Get If m_Mode = SideEntityControlVM.ModeOpt.ALZANDFRONT Then Return Visibility.Collapsed Else Return Visibility.Visible End If End Get End Property '--------------------------ALZ AND FRONT ----------------------------- Public ReadOnly Property CheckAlz_Visibility As Visibility Get If m_Mode = SideEntityControlVM.ModeOpt.ALZANDFRONT Then Return Visibility.Visible Else Return Visibility.Collapsed End If End Get End Property Public ReadOnly Property CheckFront_Visibility As Visibility Get If m_Mode = SideEntityControlVM.ModeOpt.ALZANDFRONT Then Return Visibility.Visible Else Return Visibility.Collapsed End If End Get End Property Private m_bIsCheckedAlz As Boolean = False Public Property bIsCheckedAlz As Boolean Get Return m_bIsCheckedAlz End Get Set(value As Boolean) If value Then m_bIsCheckedAlz = True m_bIsCheckedFront = False Else m_bIsCheckedAlz = False End If NotifyPropertyChanged("bIsCheckedAlz") NotifyPropertyChanged("bIsCheckedFront") End Set End Property Private m_bIsCheckedFront As Boolean = False Public Property bIsCheckedFront As Boolean Get Return m_bIsCheckedFront End Get Set(value As Boolean) If value Then m_bIsCheckedAlz = False m_bIsCheckedFront = True Else m_bIsCheckedFront = False End If NotifyPropertyChanged("bIsCheckedAlz") NotifyPropertyChanged("bIsCheckedFront") End Set End Property '--------------------------ALZ AND FRONT ----------------------------- Public MustOverride Property bIsChecked As Boolean Sub New(nId As Integer, sEntityName As String, nTextId As Integer, Mode As SideEntityControlVM.ModeOpt) m_nGeomId = nId m_sEntityName = sEntityName m_nTextId = nTextId m_Mode = Mode End Sub End Class Friend Class SideAngleEntity Inherits SideEntity Public Const STD_MAXSIDEANG As Double = 50.0 Public Const MAX_MAXSIDEANG As Double = 75.0 Private Shared m_dMaxSideAng As Double = STD_MAXSIDEANG Friend Shared WriteOnly Property dMaxSideAng As Double Set(value As Double) m_dMaxSideAng = Math.Max(Math.Min(value, MAX_MAXSIDEANG), 0) End Set End Property Friend Shared m_Parameter1 As Double Friend Shared m_Parameter2 As Double Friend Shared m_Parameter2a As Integer Friend Shared m_Parameter2b As Double Friend Shared m_ModifySideAngle As Action(Of String, Double) Friend Shared m_ModifySideHeel As Action(Of String, Double) Friend Shared m_RefreshSideAngleText As Action Private m_dSideAngle As Double Public Property GrphSideAngle As String Get Return DoubleToString(m_dSideAngle, 2) End Get Set(value As String) Dim dVal As Double = 0 If Not String.IsNullOrWhiteSpace(value) Then StringToDouble(value, dVal) If dVal <> m_dSideAngle Then ' Assegno controllando i limiti If dVal < -m_dMaxSideAng Then m_dSideAngle = -m_dMaxSideAng NotifyPropertyChanged("GrphSideAngle") ElseIf dVal > m_dMaxSideAng Then m_dSideAngle = m_dMaxSideAng NotifyPropertyChanged("GrphSideAngle") Else m_dSideAngle = dVal End If ' Lo modifico nella geometria e nella lista inclinazioni m_ModifySideAngle(sEntityName, dSideAngle) ' Aggiorno tutti i testi m_RefreshSideAngleText() End If End Set End Property Public Property dSideAngle As Double Get Return m_dSideAngle End Get Set(value As Double) ' Assegno controllando i limiti If value < -m_dMaxSideAng Then m_dSideAngle = -m_dMaxSideAng ElseIf value > m_dMaxSideAng Then m_dSideAngle = m_dMaxSideAng Else m_dSideAngle = value End If End Set End Property Private m_dSideHeel As Double Public Property GrphSideHeel As String Get Return LenToString(m_dSideHeel, 2) End Get Set(value As String) Dim dVal As Double = 0 If Not String.IsNullOrWhiteSpace(value) Then StringToLen(value, dVal) If Math.Abs( dVal - m_dSideHeel) > EPS_SMALL Then ' Verifico stia nei limiti If dVal < 0 Then m_dSideHeel = 0 NotifyPropertyChanged("GrphSideHeel") Else m_dSideHeel = dVal End If ' Lo modifico nella geometria e nella lista inclinazioni m_ModifySideHeel(sEntityName, dSideHeel) ' Aggiorno tutti i testi m_RefreshSideAngleText() End If End Set End Property Public Property dSideHeel As Double Get Return m_dSideHeel End Get Set(value As Double) ' Verifico stia nei limiti If value < 0 Then m_dSideHeel = 0 Else m_dSideHeel = value End If End Set End Property Public Overrides Property bIsChecked As Boolean Get Return Not m_dSideAngle = 0 End Get Set(value As Boolean) If value Then m_dSideAngle = m_Parameter1 m_dSideHeel = m_Parameter2 Else m_dSideAngle = 0 m_dSideHeel = 0 End If ' '' Converto nome checkbox in nome elemento tenendo conto dello slittamento verso il basso ''Dim nCurrSide As Integer = m_SideAngleEntityList.Count() - (10 - CInt(CurrCheckBox.Name.Substring(1))) ''Dim sCurrSide As String = "A" & nCurrSide.ToString() ' Lo modifico nella geometria e nella lista inclinazioni m_ModifySideAngle(sEntityName, m_dSideAngle) m_ModifySideHeel(sEntityName, m_dSideHeel) ' Aggiorno tutti i testi m_RefreshSideAngleText() NotifyPropertyChanged("bIsChecked") End Set End Property Sub New(nId As Integer, sEntityName As String, nTextId As Integer, dSideAngle As Double, dSideHeel As Double, Mode As SideEntityControlVM.ModeOpt) MyBase.New(nId, sEntityName, nTextId, Mode) m_dSideAngle = dSideAngle m_dSideHeel = dSideHeel End Sub Friend Shared Function FindEntity(sEntityName As String, EntityList As ObservableCollection(Of SideEntity)) As SideAngleEntity If IsNothing(EntityList) Then Return Nothing End If For Each Entity In EntityList If Entity.sEntityName = sEntityName Then Return DirectCast(Entity, SideAngleEntity) End If Next Return Nothing End Function End Class Friend Class DripEntity Inherits SideEntity Friend Shared m_ModifyDrip As Action(Of String, Boolean) Friend Shared m_RefreshSideAngleText As Action Private m_bHaveDrip As Boolean Public Property bHaveDrip As Boolean Get Return m_bHaveDrip End Get Set(value As Boolean) m_bHaveDrip = value End Set End Property Private m_dShortStart As Double Public Property GrphShortStart As String Get Return LenToString(m_dShortStart, 2) End Get Set(value As String) Dim dVal As Double = 0 If Not String.IsNullOrWhiteSpace(value) Then StringToLen(value, dVal) m_dShortStart = dVal NotifyPropertyChanged(NameOf(GrphShortStart)) ' Aggiorno tutti i testi m_RefreshSideAngleText() End Set End Property Public Property dShortStart As Double Get Return m_dShortStart End Get Set(value As Double) m_dShortStart = value End Set End Property Private m_dShortEnd As Double Public Property GrphShortEnd As String Get Return LenToString(m_dShortEnd, 2) End Get Set(value As String) Dim dVal As Double = 0 If Not String.IsNullOrWhiteSpace(value) Then StringToLen(value, dVal) m_dShortEnd = dVal NotifyPropertyChanged(NameOf(GrphShortEnd)) ' Aggiorno tutti i testi m_RefreshSideAngleText() End Set End Property Public Property dShortEnd As Double Get Return m_dShortEnd End Get Set(value As Double) m_dShortEnd = value End Set End Property Public Overrides Property bIsChecked As Boolean Get Return m_bHaveDrip End Get Set(value As Boolean) If value <> m_bHaveDrip Then m_bHaveDrip = value ' Lo modifico nella geometria e nella lista inclinazioni m_ModifyDrip(sEntityName, m_bHaveDrip) ' Aggiorno tutti i testi m_RefreshSideAngleText() NotifyPropertyChanged("bIsChecked") End If End Set End Property Sub New(nId As Integer, sEntityName As String, nTextId As Integer, bHaveDrip As Boolean, Mode As SideEntityControlVM.ModeOpt) MyBase.New(nId, sEntityName, nTextId, Mode) m_bHaveDrip = bHaveDrip End Sub Friend Shared Function FindEntity(sEntityName As String, EntityList As ObservableCollection(Of SideEntity)) As DripEntity If IsNothing(EntityList) Then Return Nothing End If For Each Entity In EntityList If Entity.sEntityName = sEntityName Then Return DirectCast(Entity, DripEntity) End If Next Return Nothing End Function End Class Friend Class FiloTopEntity Inherits SideEntity Friend Shared m_ModifyDrip As Action(Of String, Boolean) Friend Shared m_RefreshSideAngleText As Action Private m_bHaveDrip As Boolean Public Property bHaveDrip As Boolean Get Return m_bHaveDrip End Get Set(value As Boolean) m_bHaveDrip = value End Set End Property Public Overrides Property bIsChecked As Boolean Get Return m_bHaveDrip End Get Set(value As Boolean) If value <> m_bHaveDrip Then m_bHaveDrip = value ' Lo modifico nella geometria e nella lista inclinazioni m_ModifyDrip(sEntityName, m_bHaveDrip) ' Aggiorno tutti i testi m_RefreshSideAngleText() NotifyPropertyChanged("bIsChecked") End If End Set End Property Sub New(nId As Integer, sEntityName As String, nTextId As Integer, bHaveDrip As Boolean, Mode As SideEntityControlVM.ModeOpt) MyBase.New(nId, sEntityName, nTextId, Mode) m_bHaveDrip = bHaveDrip End Sub Friend Shared Function FindEntity(sEntityName As String, EntityList As ObservableCollection(Of SideEntity)) As DripEntity If IsNothing(EntityList) Then Return Nothing End If For Each Entity In EntityList If Entity.sEntityName = sEntityName Then Return DirectCast(Entity, DripEntity) End If Next Return Nothing End Function End Class Friend Class ColorSideAngs Class CTSA Friend m_bOk As Boolean 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) OneCtsa.m_bOk = If( sItems.Count() = 6, ( sItems(5).Trim() <> "0"), True) 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 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 dAng = Ctsa.m_dAng dHeel = Ctsa.m_dHeel Return True End If Next Return False End Function End Class 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 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 Friend Class AlzAndFrontEntity Inherits SideEntity Public Const STD_MAXSIDEANG As Double = 50.0 Public Const MAX_MAXSIDEANG As Double = 75.0 Private Shared m_dMaxSideAng As Double = STD_MAXSIDEANG Friend Shared WriteOnly Property dMaxSideAng As Double Set(value As Double) m_dMaxSideAng = Math.Max(Math.Min(value, MAX_MAXSIDEANG), 0) End Set End Property Friend Shared m_Parameter1 As Double Friend Shared m_Parameter2 As Double Friend Shared m_Parameter2a As Integer Friend Shared m_Parameter2b As Double Friend Shared m_ModifySideAngle As Action(Of String, Double) Friend Shared m_ModifySideHeel As Action(Of String, Double) Friend Shared m_RefreshSideAngleText As Action Private m_dSideAngle As Double Public Property GrphSideAngle As String Get Return DoubleToString(m_dSideAngle, 2) End Get Set(value As String) Dim dVal As Double = 0 If Not String.IsNullOrWhiteSpace(value) Then StringToDouble(value, dVal) If dVal <> m_dSideAngle Then ' Assegno controllando i limiti If dVal < -m_dMaxSideAng Then m_dSideAngle = -m_dMaxSideAng NotifyPropertyChanged("GrphSideAngle") ElseIf dVal > m_dMaxSideAng Then m_dSideAngle = m_dMaxSideAng NotifyPropertyChanged("GrphSideAngle") Else m_dSideAngle = dVal End If ' Lo modifico nella geometria e nella lista inclinazioni m_ModifySideAngle(sEntityName, dSideAngle) ' Aggiorno tutti i testi m_RefreshSideAngleText() End If End Set End Property Public Property dSideAngle As Double Get Return m_dSideAngle End Get Set(value As Double) ' Assegno controllando i limiti If value < -m_dMaxSideAng Then m_dSideAngle = -m_dMaxSideAng ElseIf value > m_dMaxSideAng Then m_dSideAngle = m_dMaxSideAng Else m_dSideAngle = value End If End Set End Property Private m_dSideHeel As Double Public Property GrphSideHeel As String Get Return LenToString(m_dSideHeel, 2) End Get Set(value As String) Dim dVal As Double = 0 If Not String.IsNullOrWhiteSpace(value) Then StringToLen(value, dVal) If Math.Abs(dVal - m_dSideHeel) > EPS_SMALL Then ' Verifico stia nei limiti If dVal < 0 Then m_dSideHeel = 0 NotifyPropertyChanged("GrphSideHeel") Else m_dSideHeel = dVal End If ' Lo modifico nella geometria e nella lista inclinazioni m_ModifySideHeel(sEntityName, dSideHeel) ' Aggiorno tutti i testi m_RefreshSideAngleText() End If End Set End Property Public Property dSideHeel As Double Get Return m_dSideHeel End Get Set(value As Double) ' Verifico stia nei limiti If value < 0 Then m_dSideHeel = 0 Else m_dSideHeel = value End If End Set End Property Public Overrides Property bIsChecked As Boolean Get Return Not m_dSideAngle = 0 End Get Set(value As Boolean) If value Then m_dSideAngle = m_Parameter1 m_dSideHeel = m_Parameter2 Else m_dSideAngle = 0 m_dSideHeel = 0 End If ' '' Converto nome checkbox in nome elemento tenendo conto dello slittamento verso il basso ''Dim nCurrSide As Integer = m_SideAngleEntityList.Count() - (10 - CInt(CurrCheckBox.Name.Substring(1))) ''Dim sCurrSide As String = "A" & nCurrSide.ToString() ' Lo modifico nella geometria e nella lista inclinazioni m_ModifySideAngle(sEntityName, m_dSideAngle) m_ModifySideHeel(sEntityName, m_dSideHeel) ' Aggiorno tutti i testi m_RefreshSideAngleText() NotifyPropertyChanged("bIsChecked") End Set End Property Sub New(nId As Integer, sEntityName As String, nTextId As Integer, dSideAngle As Double, dSideHeel As Double, Mode As SideEntityControlVM.ModeOpt) MyBase.New(nId, sEntityName, nTextId, Mode) m_dSideAngle = dSideAngle m_dSideHeel = dSideHeel End Sub Friend Shared Function FindEntity(sEntityName As String, EntityList As ObservableCollection(Of SideEntity)) As SideAngleEntity If IsNothing(EntityList) Then Return Nothing End If For Each Entity In EntityList If Entity.sEntityName = sEntityName Then Return DirectCast(Entity, SideAngleEntity) End If Next Return Nothing End Function End Class