Imports EgtUILib Imports System.Collections.ObjectModel Imports EgtWPFLib5 Module SolidManagerM #Region "FIELDS & PROPERTIES" Public m_PartSolidList As New ObservableCollection(Of PartSolidM) ' lista dei PartSolid Public m_nVeinCtx As Integer = DirectCast(Map.refSceneHostV.DataContext, SceneHostVM).MainScene.GetCtx() #End Region ' Fields & Properties #Region "METHODS" Public Function GetPartSolid(nId As Integer) As PartSolidM ' se la lista non esiste la creo If m_PartSolidList.Count = 0 Then CreatePartSolid() End If ' se l'id è negativo allora sto applicando un disaccoppiamento e mi basta rendere l'id positivo If nId < 0 Then nId *= -1 ' cerco nella lista dei part quello con id uguale a nId, se non lo trovo allora nId era riferito ad un Part Solid Dim PartSolid As PartSolidM = m_PartSolidList.FirstOrDefault(Function(x) x.PartId = nId) If IsNothing(PartSolid) Then PartSolid = m_PartSolidList.FirstOrDefault(Function(x) x.PartSolidId = nId) ' se non l'ho trovato allora lo creo If IsNothing(PartSolid) Then AddPartSolid(nId, PartSolid) Return PartSolid End Function Public Function AddPartSolid(nPartId As Integer, ByRef Optional NewPart As PartSolidM = Nothing) EgtSetCurrentContext(m_nVeinCtx) If Not EgtIsPart(nPartId) Then Return False ' aggiungo alla lista già esistente il nuovo PartSolid NewPart = New PartSolidM(nPartId) m_PartSolidList.Add(NewPart) Return True End Function Public Sub RefreshPartSolid(nPartId As Integer) Dim PartSolidSel As PartSolidM = GetPartSolid(nPartId) ' rimuovo il part solid associato a questo part PartSolidSel.DeselectPart() m_PartSolidList.Remove(PartSolidSel) ' lo ricreo AddPartSolid(nPartId) End Sub Public Sub ClearPartSolidList() ' pulisco la lista dei part solid m_PartSolidList.Clear() End Sub Public Sub CreatePartSolid() EgtSetCurrentContext(m_nVeinCtx) 'inizializzo la lista dei PartSolid ClearPartSolidList() Dim nPart As Integer = EgtGetFirstPart() While nPart <> GDB_ID.NULL Dim sName As String = String.Empty EgtGetName(nPart, sName) If sName <> SOLID.ToUpper() And sName <> TERNA Then ' controllo che sia un Part di un pezzo e che quindi abbia un layer che si chiama "OutLoop" If EgtGetFirstNameInGroup(nPart, OUTLOOP) = GDB_ID.NULL Then nPart = EgtGetNextPart(nPart) Continue While End If Dim Part As New PartSolidM(nPart) m_PartSolidList.Add(Part) End If nPart = EgtGetNextPart(nPart) End While '' Aggiorno la TreeView 'UpdateTreeViewPart() End Sub Public Sub CreateSolidFromLoops(nPart As Integer) If nPart = GDB_ID.NULL Then Return Dim nChild As Integer = GDB_ID.NULL EgtGetInfo(nPart, "Child", nChild) ' proseguo solo nel caso in cui non sia già presente un solido associato al Part If nChild = GDB_ID.NULL Then ' ho ricevuto un part che contiene solo il layer OutLoop e qualche info Dim nOutLoopLay As Integer = EgtGetFirstNameInGroup(nPart, "OutLoop") Dim nLoops As New List(Of Integer)({EgtGetFirstInGroup(nOutLoopLay)}) Dim nInLay As Integer = EgtGetFirstNameInGroup(nPart, "InLoop") While nInLay <> GDB_ID.NULL nLoops.Add(EgtGetFirstInGroup(nInLay)) nInLay = EgtGetNextName(nInLay, "InLoop") End While ' creo la superficie piana Dim nRegLay As Integer = EgtCreateGroup(nPart) EgtSetName(nRegLay, "Region") EgtCreateSurfFlatRegion(nRegLay, nLoops.ToArray()) ' splitto le compo nei lati singoli For Each nLoopId In nLoops EgtLuaExecLine("TOOL.ExplodeAndNameEdges(" & nLoopId.ToString & "," & "false" & ")") Next ' Assegno valori ai parametri per lua (appartengono alla tabella SLD) EgtLuaSetGlobIntVar("SLD.CurrId", nPart) Dim dThick As Double = 20 EgtGetInfo(nPart, "Th", dThick) EgtLuaSetGlobNumVar("SLD.THICK", dThick) If Not EgtLuaCallFunction("SLD.Main") Then Dim sErr As String = "" EgtLuaGetGlobStringVar("SLD.ERR", sErr) EgtOutLog("Matching error: SLD.ERR=" & sErr) Return End If RefreshPartSolid(nPart) End If End Sub Public Sub UpdatePairInfo(nId1 As Integer, Optional nId2 As Integer = GDB_ID.NULL) If EgtLuaSetGlobIntVar("ASS.nPartId", nId1) Then AssLog("ASS.nPartId = " & nId1.ToString) If EgtLuaSetGlobIntVar("ASS.nPartToPair", nId2) Then AssLog("ASS.nPartToPair = " & nId2.ToString) If Not EgtLuaCallFunction("ASS.UpdatePairInfo") Then AssLog("fallita la chiamata a ASS.UpdatePairInfo") Dim sErr As String = "" EgtLuaGetGlobStringVar("ASS.ERR", sErr) EgtOutLog("Matching error: ASS.ERR=" & sErr) Return End If AssLog("ASS.UpdatePairInfo()") End Sub Public Sub UpdatePairInfoSingle(nId As Integer, sPaired As String, nGroup As Integer) EgtLuaSetGlobIntVar("ASS.nPartId", nId) AssLog("ASS.nPartId = " & nId.ToString) EgtLuaSetGlobStringVar("ASS.sPairList", sPaired) AssLog("ASS.sPairList = " & sPaired) EgtLuaSetGlobIntVar("ASS.nGroup", nGroup) AssLog("ASS.nGroup = " & nGroup.ToString) If Not EgtLuaCallFunction("ASS.UpdatePairInfoSingle") Then AssLog("fallita la chiamata a ASS.UpdatePairInfoSingle") Dim sErr As String = "" EgtLuaGetGlobStringVar("ASS.ERR", sErr) EgtOutLog("Matching error: ASS.ERR=" & sErr) Return End If AssLog("ASS.UpdatePairInfoSingle()") End Sub Public Function PairList(nId As Integer) As List(Of Integer) Dim sPaired = "" EgtGetInfo(nId, PAIRED, sPaired) Dim lPair As New List(Of Integer) If sPaired <> String.Empty Then Dim vPaired As Array = sPaired.Split(CChar(",")) For Each nPaired As Integer In vPaired lPair.Add(nPaired) Next End If Return lPair End Function Public Sub Unpair(nId As Integer) If nId = -1 Then Return If EgtLuaSetGlobIntVar("ASS.nPartId", nId) Then AssLog("ASS.nPartId = " & nId.ToString) If Not EgtLuaCallFunction("ASS.Unpair") Then AssLog("fallita la chiamata a ASS.Unpair") Return End If AssLog("ASS.Unpair()") Dim PartSolidSel As PartSolidM = GetPartSolid(nId) If IsNothing(PartSolidSel) Then Return SceneCmd.DeselectAll() PartSolidSel.SelectPart() Map.refSceneHostVM.m_nIdPart = nId Map.refSceneHostVM.nTime += 1 'UpdateTreeViewPart() EgtDraw() End Sub Public Function UndoTempTrasf() As Boolean If Not EgtLuaCallFunction("ASS.UndoTemp") Then AssLog("fallita la chiamata a Ass.UndoTemp") Dim sErr As String = "" EgtLuaGetGlobStringVar("ASS.ERR", sErr) EgtOutLog("Matching error: ASS.ERR=" & sErr) Return False End If AssLog("ASS.UndoTemp()") Return True End Function Public Sub Move(nId As Integer, vtMove As Vector3d, Optional bSaveHist As Boolean = True, Optional bTempTrf As Boolean = False) If nId = GDB_ID.NULL Then Return If EgtLuaSetGlobIntVar("ASS.nPartId", nId) Then AssLog("ASS.nPartId = " & nId.ToString) If EgtLuaSetGlobVectorVar("ASS.vtMove", vtMove) Then AssLog("ASS.vtMove = {" & vtMove.ToString & "}") If EgtLuaSetGlobBoolVar("ASS.bSaveHist", bSaveHist) Then AssLog("ASS.bSaveHist = " & bSaveHist.ToString) If EgtLuaSetGlobBoolVar("ASS.bSaveTemp", bTempTrf) Then AssLog("ASS.bSaveTemp = " & bTempTrf.ToString) If Not EgtLuaCallFunction("ASS.Move") Then AssLog("fallita la chiamata a ASS.Move") Dim sErr As String = "" EgtLuaGetGlobStringVar("ASS.ERR", sErr) EgtOutLog("Matching error: ASS.ERR=" & sErr) Return End If If bSaveHist Then Map.refSceneHostVM.nTime += 1 AssLog("ASS.Move()") End Sub Public Sub MoveSingle(nId As Integer, vtMove As Vector3d, Optional bSaveHist As Boolean = True, Optional bTempTrf As Boolean = False) EgtLuaSetGlobIntVar("ASS.nPartId", nId) AssLog("ASS.nPartId = " & nId.ToString) EgtLuaSetGlobVectorVar("ASS.vtMove", vtMove) AssLog("ASS.vtMove = {" & vtMove.ToString & "}") EgtLuaSetGlobBoolVar("ASS.bSaveHist", bSaveHist) AssLog("ASS.bSaveHist = " & bSaveHist.ToString) EgtLuaSetGlobBoolVar("ASS.bSaveTemp", bTempTrf) AssLog("ASS.bSaveTemp = " & bTempTrf.ToString) If Not EgtLuaCallFunction("ASS.MoveSingle") Then AssLog("fallita la chiamata a ASS.MoveSingle") Dim sErr As String = "" EgtLuaGetGlobStringVar("ASS.ERR", sErr) EgtOutLog("Matching error: ASS.ERR=" & sErr) Return End If If bSaveHist Then Map.refSceneHostVM.nTime += 1 AssLog("ASS.MoveSingle()") End Sub Public Sub Rotate(nId As Integer, ptAx As Point3d, vtAx As Vector3d, dAng As Double, Optional bSaveHist As Boolean = True, Optional bTempTrf As Boolean = False) If nId = GDB_ID.NULL Then Return Dim PartSolidSel As PartSolidM = GetPartSolid(nId) If IsNothing(PartSolidSel) Then Return ' ruoto il part e i suoi accoppiati EgtLuaSetGlobIntVar("ASS.nPartId", nId) AssLog("ASS.nPartId = " & nId.ToString) EgtLuaSetGlobPointVar("ASS.ptAx", ptAx) AssLog("ASS.ptAx = {" & ptAx.ToString & "}") EgtLuaSetGlobVectorVar("ASS.vtAx", vtAx) AssLog("ASS.vtAx = {" & vtAx.ToString & "}") EgtLuaSetGlobNumVar("ASS.dAng", dAng) AssLog("ASS.dAng = " & dAng.ToString) EgtLuaSetGlobBoolVar("ASS.bSaveHist", bSaveHist) AssLog("ASS.bSaveHist = " & bSaveHist.ToString) EgtLuaSetGlobBoolVar("ASS.bSaveTemp", bTempTrf) AssLog("ASS.bSaveTemp = " & bTempTrf.ToString) If Not EgtLuaCallFunction("ASS.Rotate") Then AssLog("fallita la chiamata a ASS.Rotate") Dim sErr As String = "" EgtLuaGetGlobStringVar("ASS.ERR", sErr) EgtOutLog("Matching error: ASS.ERR=" & sErr) Return End If If bSaveHist Then Map.refSceneHostVM.nTime += 1 AssLog("ASS.Rotate()") End Sub Public Sub RotateSingle(nId As Integer, ptAx As Point3d, vtAx As Vector3d, dAng As Double, Optional bSaveHist As Boolean = True, Optional bTempTrf As Boolean = False) If nId = GDB_ID.NULL Then Return Dim PartSolidSel As PartSolidM = GetPartSolid(nId) EgtLuaSetGlobIntVar("ASS.nPartId", nId) AssLog("ASS.nPartId = " & nId.ToString) EgtLuaSetGlobPointVar("ASS.ptAx", ptAx) AssLog("ASS.ptAx = {" & ptAx.ToString & "}") EgtLuaSetGlobVectorVar("ASS.vtAx", vtAx) AssLog("ASS.vtAx = {" & vtAx.ToString & "}") EgtLuaSetGlobNumVar("ASS.dAng", dAng) AssLog("ASS.dAng = " & dAng.ToString) EgtLuaSetGlobBoolVar("ASS.bSaveHist", bSaveHist) AssLog("ASS.bSaveHist = " & bSaveHist.ToString) EgtLuaSetGlobBoolVar("ASS.bSaveTemp", bTempTrf) AssLog("ASS.bSaveTemp = " & bTempTrf.ToString) If Not EgtLuaCallFunction("ASS.RotateSingle") Then AssLog("fallita la chiamata a ASS.RotateSingle") Dim sErr As String = "" EgtLuaGetGlobStringVar("ASS.ERR", sErr) EgtOutLog("Matching error: ASS.ERR=" & sErr) Return End If If bSaveHist Then Map.refSceneHostVM.nTime += 1 AssLog("ASS.RotateSingle()") End Sub Public Sub ResetRotation(Optional bEraseData As Boolean = False, Optional bDraw As Boolean = False) If Not Map.refSceneHostVM.m_bRotated Then Return Map.refSceneHostVM.m_dAngRot = 0 Dim nId As Integer = Map.refSceneHostVM.m_nIdPart If nId <> -1 Then Dim PartSolidSel As PartSolidM = GetPartSolid(nId) If Not IsNothing(PartSolidSel) Then UndoTempTrasf() If bEraseData Then PartSolidSel.ResetData() End If End If If bDraw Then EgtDraw() End If Map.refSceneHostVM.m_bRotated = False End Sub Public Function CalcInters(nPartId As Integer, Optional bKeepInters As Boolean = False) As ObservableCollection(Of PartSolidM) 'restituisce una lista dei part con cui c'è un'intersezione ' di default la lista contiene sempre il part corrente EgtSetCurrentContext(m_nVeinCtx) Dim PartSolidCurr As PartSolidM = GetPartSolid(nPartId) Dim vInters As New ObservableCollection(Of PartSolidM) If IsNothing(PartSolidCurr) Then Return vInters Dim nIdTempL = EgtGetFirstNameInGroup(PartSolidCurr.PartSolidId, TEMP) vInters.Add(PartSolidCurr) Dim nIdSolid As Integer = PartSolidCurr.SolidId Dim lPair As List(Of Integer) = PairList(nPartId) For Each PartSolidSel As PartSolidM In m_PartSolidList ' se sto guardando lo stesso solido vado oltre If PartSolidSel.SolidId = nIdSolid Then Continue For ' calcolo le intersezioni solo con part con cui non sono già accoppiato If lPair.FirstOrDefault(Function(x) x = PartSolidSel.PartId) <> 0 Then Continue For ' prima di fare le intersezioni tra mesh verifico che le bbox abbiano un'intersezione If Not PartSolidCurr.bbSolid.Overlaps(PartSolidSel.bbSolid) Then Continue For ' ho intersezione tra le bbox quindi proseguo con i conti Dim nIdSurfToCheck As Integer = PartSolidSel.SolidId If nIdSurfToCheck = -1 Then Continue For Dim nIdCopy As Integer = EgtCopy(nIdSolid, nIdTempL) EgtSurfTmIntersect(nIdCopy, nIdSurfToCheck) If EgtSurfTmFacetCount(nIdCopy) <> 0 Then EgtSetColor(nIdCopy, New Color3d(255, 0, 0)) vInters.Add(PartSolidSel) Else EgtErase(nIdCopy) End If Next If Not bKeepInters Then Dim nIdInters As Integer = EgtGetFirstInGroup(nIdTempL) While nIdInters <> GDB_ID.NULL Dim nIdNext As Integer = EgtGetNext(nIdInters) EgtErase(nIdInters) nIdInters = nIdNext End While End If Return vInters End Function Public Function CalcIntersAmong(ByRef vInters As ObservableCollection(Of PartSolidM)) As Integer ' calcolo le intersezioni tra il primo oggetto nel vettore e tutti i successivi Dim nInters As Integer = 0 EgtSetCurrentContext(m_nVeinCtx) Dim PartSolidMain As PartSolidM = vInters.Item(0) If IsNothing(PartSolidMain) Then Return nInters Dim nIdTempL = EgtGetFirstNameInGroup(PartSolidMain.PartSolidId, TEMP) Dim nIdSolid As Integer = PartSolidMain.SolidId For Each PartSolidSel As PartSolidM In vInters ' se sto guardando lo stesso solido vado oltre If PartSolidSel.SolidId = nIdSolid Then Continue For Dim nIdSurfToCheck As Integer = PartSolidSel.SolidId If nIdSurfToCheck = -1 Then Continue For Dim nIdCopy As Integer = EgtCopy(nIdSolid, nIdTempL) EgtSurfTmIntersect(nIdCopy, nIdSurfToCheck) If EgtSurfTmFacetCount(nIdCopy) <> 0 Then nInters += 1 EgtErase(nIdCopy) Next Return nInters End Function Private Function FindInters(nPartId As Integer) As Boolean Dim PartSolidCurr As PartSolidM = GetPartSolid(nPartId) If IsNothing(PartSolidCurr) Then Return False Dim nIdTempL = EgtGetFirstNameInGroup(PartSolidCurr.PartSolidId, TEMP) ' svuoto il layer prima di trovare le nuove intersezioni Dim nIdInters As Integer = EgtGetFirstInGroup(nIdTempL) While nIdInters <> GDB_ID.NULL Dim nIdNext As Integer = EgtGetNext(nIdInters) EgtErase(nIdInters) nIdInters = nIdNext End While Dim vInters As ObservableCollection(Of PartSolidM) = CalcInters(nPartId, True) nIdInters = EgtGetFirstInGroup(nIdTempL) ' se trovo delle intersezioni metto tutto in trasparenza tranne le intersezioni ' prima rimetto tutto opaco e poi eventualmente metto le trasparenze For Each PartSolidSel As PartSolidM In m_PartSolidList PartSolidSel.MakeOpaque() Next 'MyMsgTxBl.Foreground = Brushes.DarkKhaki If nIdInters <> -1 Then 'MyMsgTxBl.Text = MyMsgTxBl.Text & vbCrLf & "Inters!" 'ResetIntersBtn.IsEnabled = True 'MyMsgTxBl.Foreground = Brushes.Red For Each PartSolidSel As PartSolidM In vInters PartSolidSel.MakeTransparent() Next Return True End If 'ResetIntersBtn.IsEnabled = False Return False End Function Public Sub ResetInters() ' scorro tutti i part For Each PartSolidSel As PartSolidM In m_PartSolidList PartSolidSel.MakeOpaque() Dim nIdTempL = EgtGetFirstNameInGroup(PartSolidSel.PartSolidId, TEMP) Dim nIdInters As Integer = EgtGetFirstInGroup(nIdTempL) ' svuoto il layer temp While nIdInters <> GDB_ID.NULL Dim nIdNext As Integer = EgtGetNext(nIdInters) EgtErase(nIdInters) nIdInters = nIdNext End While Next 'MyMsgTxBl.Text = "" 'MyMsgTxBl.Foreground = Brushes.DarkKhaki 'ResetIntersBtn.IsEnabled = False EgtDraw() End Sub Public Function MaxApproach(PartSolidSel As PartSolidM, ByRef dCorr As Double, vInters As ObservableCollection(Of PartSolidM)) As Boolean Return True 'Dim nItMax As Integer = 20 'Dim nItCount As Integer = 0 '' identifico a qualche delle ultime trasformazioni ho iniziato ad avere un'intersezione '' scorro e annullo le ultime trasformazioni fino a che non ho più intersezioni e della trasformazione critica tengo solo la parte che mi manda in battuta 'UndoTempTrasf() 'Dim nRevert As Integer = 0 'Dim nTempTime = GetTempTime() 'While CalcIntersAmong(vInters) > 0 And nRevert < nTempTime ' nRevert += 1 ' Dim trf As Transformation = GetTempTansfFromLast(nRevert) ' ApplyTransf(PartSolidSel.PartId, -trf, False) 'End While 'ApplyTransf(PartSolidSel.PartId, GetTempTansfFromLast(nRevert), False) 'Dim trfStep As Transformation = (1.0 / nItMax) * GetTempTansfFromLast(nRevert) 'While vInters.Count() > 1 And nItCount < nItMax ' ' torno indietro progressivamente ' ApplyTransf(PartSolidSel.PartId, -trfStep, False) ' ' ricalcolo le intersezioni ' vInters = CalcInters(PartSolidSel.PartSolidId) ' nItCount += 1 'End While 'If vInters.Count() = 1 Then ' dCorr = nItCount / nItMax ' Return True 'Else ' dCorr = 1 ' Return False 'End If End Function Friend Sub FlipParallel_Changed(nId As Integer, ByRef bAlreadyFlipParal As Boolean) If nId = GDB_ID.NULL Then Return Dim PartSolidSel As PartSolidM = GetPartSolid(nId) If IsNothing(PartSolidSel) Then Return If PartSolidSel.nIdLineSecond = GDB_ID.NULL Then Return Dim vtNorm As New Vector3d If Not EgtLuaCallFunction("ASS.FlipParallel") Then AssLog("fallita la chiamata a ASS.FlipParallel") Dim sErr As String = "" EgtLuaGetGlobStringVar("ASS.ERR", sErr) EgtOutLog("Matching error: ASS.ERR=" & sErr) Return End If AssLog("ASS.FlipParallel()") bAlreadyFlipParal = Not bAlreadyFlipParal FindInters(nId) EgtDraw() End Sub Friend Sub FlipPerpendicular_Changed(nId As Integer, ByRef bAlreadyFlipPerp As Boolean) ' questa opzione funziona come inteso solo se l'edge selezionato per l'accoppiamento sta su un piano parallelo a quello della ' superficie del part del pezzo di destinazione dell'accoppiamento If nId = GDB_ID.NULL Then Return Dim PartSolidSel1 As PartSolidM = GetPartSolid(nId) If IsNothing(PartSolidSel1) Then Return If PartSolidSel1.nIdLineSecond = GDB_ID.NULL Then Return If Not EgtLuaCallFunction("ASS.FlipPerpendicular") Then AssLog("fallita la chiamata a ASS.FlipPerpendicular") Dim sErr As String = "" EgtLuaGetGlobStringVar("ASS.ERR", sErr) EgtOutLog("Matching error: ASS.ERR=" & sErr) Return End If AssLog("ASS.FlipPerpendicular()") bAlreadyFlipPerp = Not bAlreadyFlipPerp FindInters(nId) EgtDraw() End Sub Friend Sub FacePair(nId As Integer, ByRef nTransfNum As Integer) Dim PartSolidIdSel = GetPartSolid(nId) EgtSurfFrNormVersor(PartSolidIdSel.nIdSurfFirst, GDB_ID.ROOT, PartSolidIdSel.vtNormFirst) EgtSurfFrNormVersor(PartSolidIdSel.nIdSurfSecond, GDB_ID.ROOT, PartSolidIdSel.vtNormSecond) ' Assegno valori ai parametri per lua (appartengono alla tabella ASS) If EgtLuaSetGlobIntVar("ASS.nPartId", nId) Then AssLog("ASS.nPartId = " & nId.ToString) If EgtLuaSetGlobIntVar("ASS.nVeinCtx", m_nVeinCtx) Then AssLog("ASS.nVeinCtx = " & m_nVeinCtx.ToString) If EgtLuaSetGlobVectorVar("ASS.vtFirstNorm", PartSolidIdSel.vtNormFirst) Then AssLog("ASS.vtFirstNorm = {" & PartSolidIdSel.vtNormFirst.ToString & "}") Dim nIdToPair As Integer = EgtGetParent(EgtGetParent(PartSolidIdSel.nIdLineSecond)) Dim PartSolidToPair As PartSolidM = GetPartSolid(nIdToPair) If EgtLuaSetGlobVectorVar("ASS.vtSecondNorm", PartSolidIdSel.vtNormSecond) Then AssLog("ASS.vtSecondNorm = {" & PartSolidIdSel.vtNormSecond.ToString & "}") If Not EgtLuaCallFunction("ASS.FacePair") Then AssLog("fallita la chiamata a ASS.FacePair") Dim sErr As String = "" EgtLuaGetGlobStringVar("ASS.ERR", sErr) EgtOutLog("Matching error: ASS.ERR=" & sErr) Return End If AssLog("ASS.FacePair()") ' ricalcolo le intersezioni Dim sText As String = EgtMsg(110007) ' Conferma oppura annulla l'accoppiamento If FindInters(nId) Then 'MyMsgTxBl.Text = sText & vbCrLf & "Inters!" Else 'MyMsgTxBl.Text = sText End If nTransfNum += 1 End Sub Public Sub PairPart(nId As Integer, nOption As Integer, bFlipOption1 As Boolean, bFlipOption2 As Boolean, ByRef bAlreadyFlip1 As Boolean, ByRef bAlreadyFlip2 As Boolean, ByRef nTransfNum As Integer) ' Assegno valori ai parametri per lua (appartengono alla tabella ASS) If EgtLuaSetGlobIntVar("ASS.nPartId", nId) Then AssLog("ASS.nPartId = " & nId.ToString) If EgtLuaSetGlobIntVar("ASS.nVeinCtx", m_nVeinCtx) Then AssLog("ASS.nVeinCtx = " & m_nVeinCtx.ToString) Dim PartSolidIdSel = GetPartSolid(nId) If EgtLuaSetGlobIntVar("ASS.nIdFirstLine", PartSolidIdSel.nIdLineFirst) Then AssLog("ASS.nIdFirstLine = " & PartSolidIdSel.nIdLineFirst.ToString) Dim nIdToPair As Integer = EgtGetParent(EgtGetParent(PartSolidIdSel.nIdLineSecond)) Dim PartSolidToPair As PartSolidM = GetPartSolid(nIdToPair) If EgtLuaSetGlobIntVar("ASS.nIdSecondLine", PartSolidIdSel.nIdLineSecond) Then AssLog("ASS.nIdSecondLine = " & PartSolidIdSel.nIdLineSecond.ToString) 'Dim nOption As Integer = wnd_PairInputDataV.PairOption.SelectedIndex If EgtLuaSetGlobIntVar("ASS.nOption", nOption) Then AssLog("ASS.nOption = " & nOption.ToString) If Not EgtLuaCallFunction("ASS.EdgePair") Then AssLog("fallita la chiamata a ASS.EdgePair") Dim sErr As String = "" EgtLuaGetGlobStringVar("ASS.ERR", sErr) EgtOutLog("Matching error: ASS.ERR=" & sErr) Return End If AssLog("ASS.EdgePair()") 'If (wnd_PairInputDataV.FlipOption1.IsChecked And Not m_bFlippedParal) Or (Not wnd_PairInputDataV.FlipOption1.IsChecked And m_bFlippedParal) Then FlipParallel_Changed() 'If (wnd_PairInputDataV.FlipOption2.IsChecked And Not m_bFlippedPerp) Or (Not wnd_PairInputDataV.FlipOption2.IsChecked And m_bFlippedPerp) Then FlipPerpendicular_Changed() If (bFlipOption1 And Not bAlreadyFlip1) Or (Not bFlipOption1 And bAlreadyFlip1) Then FlipParallel_Changed(nId, bAlreadyFlip1) nTransfNum += 1 End If If (bFlipOption2 And Not bAlreadyFlip2) Or (Not bFlipOption2 And bAlreadyFlip2) Then FlipPerpendicular_Changed(nId, bAlreadyFlip2) nTransfNum += 1 End If ' leggo quante trasformazioni sono state fatte Dim nTransf As Integer = 0 If EgtLuaGetGlobIntVar("ASS.nTransf", nTransf) Then nTransfNum += nTransf FindInters(PartSolidIdSel.PartId) EgtDraw() End Sub Public Function IsAPartSelected() As Boolean For Each PartSolidSel As PartSolidM In m_PartSolidList If PartSolidSel.IsSelected() Then Return True Next Return False End Function Public Sub ResetOperationMarks(nId As Integer) Dim PartSolidSel As PartSolidM = GetPartSolid(nId) If Not IsNothing(PartSolidSel) Then PartSolidSel.DeselectSinglePart() Map.refSceneHostVM.m_nIdPart = GDB_ID.NULL For Each nMarkedId In Map.refSceneHostVM.m_MarkedPartsList EgtResetMark(nMarkedId) Next EgtSetAlpha(Map.refSceneHostVM.m_MarkedPartsList(2), Map.refSceneHostVM.m_nAlphaTransparent1) EgtSetAlpha(Map.refSceneHostVM.m_MarkedPartsList(3), Map.refSceneHostVM.m_nAlphaTransparent2) Map.refSceneHostVM.ResetMarkedPartsList() End Sub Public Function UndoEvent() As Boolean If Not EgtLuaCallFunction("ASS.Undo") Then Dim sErr As String = "" EgtLuaGetGlobStringVar("ASS.ERR", sErr) EgtOutLog("Matching error: ASS.ERR=" & sErr) Return False End If AssLog("ASS.Undo()") Map.refSceneHostVM.nTime -= 1 Dim nTypeTrf As Integer = -1 EgtLuaGetGlobIntVar("ASS.nTypeTrf", nTypeTrf) 'If nTypeTrf = 2 Then ' UpdateTreeViewPart() 'End If Return True End Function Public Function RedoEvent() As Boolean If Not EgtLuaCallFunction("ASS.Redo") Then Dim sErr As String = "" EgtLuaGetGlobStringVar("ASS.ERR", sErr) EgtOutLog("Matching error: ASS.ERR=" & sErr) Return False End If AssLog("ASS.Redo()") Map.refSceneHostVM.nTime += 1 Dim nTypeTrf As Integer = -1 EgtLuaGetGlobIntVar("ASS.nTypeTrf", nTypeTrf) 'If nTypeTrf = 2 Then ' UpdateTreeViewPart() 'End If Return True End Function Public Function GetAllSelected() As List(Of PartSolidM) Dim ListSelected As New List(Of PartSolidM) For Each PartSolidSel As PartSolidM In m_PartSolidList If PartSolidSel.IsSelected() Then ListSelected.Add(PartSolidSel) Next Return ListSelected End Function Public Sub ManageUndoRedo() Dim UndoBtn As SceneBtn = Map.refSceneButtonVM.GetButton("Undo") UndoBtn.IsEnabled = Map.refSceneHostVM.nTime > -1 UndoBtn.NotifyPropertyChanged(NameOf(UndoBtn.IsEnabled)) Dim RedoBtn As SceneBtn = Map.refSceneButtonVM.GetButton("Redo") Dim bRedoPossible As Boolean = False EgtLuaGetGlobBoolVar("ASS.bRedoPossible", bRedoPossible) RedoBtn.IsEnabled = bRedoPossible RedoBtn.NotifyPropertyChanged(NameOf(RedoBtn.IsEnabled)) End Sub Public Sub ShowLoopEdges() Dim nPart As Integer = EgtGetFirstPart() While nPart <> GDB_ID.NULL Dim sPartName As String = String.Empty EgtGetName(nPart, sPartName) If sPartName = "SOLID" Then nPart = EgtGetNext(nPart) Continue While End If EgtSetStatus(nPart, GDB_ST.ON_) Dim nLay As Integer = EgtGetFirstInGroup(nPart) While nLay <> GDB_ID.NULL Dim sLayName As String = String.Empty EgtGetName(nLay, sLayName) If sLayName <> "OutLoop" And sLayName <> "InLoop" Then EgtSetStatus(nLay, GDB_ST.OFF) nLay = EgtGetNext(nLay) End While nPart = EgtGetNext(nPart) End While End Sub Public Sub HideLoopEdges() Dim nPart As Integer = EgtGetFirstPart() While nPart <> GDB_ID.NULL Dim sPartName As String = String.Empty EgtGetName(nPart, sPartName) If sPartName = "SOLID" Then nPart = EgtGetNext(nPart) Continue While End If EgtSetStatus(nPart, GDB_ST.OFF) Dim nLay As Integer = EgtGetFirstInGroup(nPart) While nLay <> GDB_ID.NULL Dim sLayName As String = String.Empty EgtGetName(nLay, sLayName) If sLayName <> "OutLoop" And sLayName <> "InLoop" And sLayName <> "Ref" Then EgtSetStatus(nLay, GDB_ST.ON_) nLay = EgtGetNext(nLay) End While nPart = EgtGetNext(nPart) End While End Sub Public Sub RebuildPartFromInfo(nId As Integer) If nId = GDB_ID.NULL Then Return Dim PartSolidSel As PartSolidM = GetPartSolid(nId) nId = PartSolidSel.PartId ' recupero le info salvate nel Part EgtLuaExecLine("TOOL.FillInfoTableFromPart(" & nId.ToString() & ")") ' recupero l'id dell'edge che ha generato la paretina Dim nParent As Integer = GDB_ID.NULL EgtGetInfo(nId, "Parent", nParent) Dim nIn As Integer = 0 EgtGetInfo(nId, "nInLoop", nIn) Dim sLayName As String = "OutLoop" Dim nLayId As Integer = GDB_ID.NULL If nIn = 0 Then nLayId = EgtGetFirstNameInGroup(nParent, sLayName) Else sLayName = "InLoop" nLayId = EgtGetFirstNameInGroup(nParent, sLayName) Dim nInLays = 1 While nInLays <> nIn nLayId = EgtGetNextName(nLayId, sLayName) nInLays += 1 End While End If Dim nEdge As Integer = 0 EgtGetInfo(nId, "ParentEdge", nEdge) Dim sEdgeName As String = "A" & nEdge.ToString() Dim nEdgeId As Integer = EgtGetFirstNameInGroup(nLayId, sEdgeName) ' recupero le info e ricreo il pezzo If EgtLuaSetGlobIntVar("TOOL.nEdgeId", nEdgeId) Then AssLog("TOOL.nEdgeId = " & nEdgeId.ToString()) If EgtLuaCallFunction("TOOL.CreateParetinaFull") Then AssLog("TOOL.CreateParetinaFull()") SolidManagerM.RefreshPartSolid(nId) End Sub Public Sub Delete(nPartId) If nPartId = GDB_ID.NULL Then Return Dim PartSolidSel As PartSolidM = GetPartSolid(nPartId) ' cancello tutte le info che riguardano il pezzo che sono in altri pezzi Unpair(PartSolidSel.PartId) Dim sPairToRef As String = String.Empty EgtGetInfo(PartSolidSel.PartId, "PairToRef", sPairToRef) If sPairToRef <> String.Empty Then Dim vPairToRef As Array = sPairToRef.Split(CChar(",")) Dim sPartToPair As String = vPairToRef(0) Dim nPartToPair As Integer = EgtGetFirstNameInGroup(GDB_ID.ROOT, sPartToPair) Dim nRefLay As Integer = EgtGetFirstNameInGroup(nPartToPair, "Ref") Dim nRef As Integer = EgtGetFirstNameInGroup(nRefLay, vPairToRef(1)) EgtErase(nRef) End If ' elimino l'info nel parent Dim nEdge As Integer = 0 EgtGetInfo(PartSolidSel.PartId, "ParentEdge", nEdge) Dim nParentId As Integer = GDB_ID.NULL EgtGetInfo(PartSolidSel.PartId, "Parent", nParentId) Dim sEdgeName As String = "A" & nEdge.ToString() Dim nIn As Integer = 0 EgtGetInfo(PartSolidSel.PartId, "nInLoop", nIn) If nIn <> 0 Then sEdgeName = sEdgeName & "_I" & nIn.ToString() EgtSetInfo(nParentId, sEdgeName, "") ' recupero gli eventuali vicini Dim sPrev As String = String.Empty Dim sNext As String = String.Empty EgtGetInfo(PartSolidSel.PartId, "Prev", sPrev) EgtGetInfo(PartSolidSel.PartId, "Next", sNext) Dim PrevId As Integer = EgtGetFirstNameInGroup(GDB_ID.ROOT, sPrev) Dim NextId As Integer = EgtGetFirstNameInGroup(GDB_ID.ROOT, sNext) ' elimino il part e il suo solido PartSolidSel.DeselectPart() EgtErase(PartSolidSel.PartId) EgtErase(PartSolidSel.PartSolidId) ' elimino il PartSolid dalla lista m_PartSolidList.Remove(PartSolidSel) ' ricostruisco eventuali vicini e modifico le loro info EgtSetInfo(PrevId, "Next", "") EgtSetInfo(NextId, "Prev", "") RebuildPartFromInfo(PrevId) RebuildPartFromInfo(NextId) EgtDraw() End Sub #End Region ' Methods End Module