Imports System.Collections.ObjectModel Imports EgtUILib Module SelData Private Class SelData Friend m_nId As Integer Friend m_nSub As Integer Friend m_nSel As Integer Sub New() m_nId = GDB_ID.NULL m_nSub = -1 m_nSel = GDB_ID.NULL End Sub Sub New(nId As Integer, nSub As Integer, nSel As Integer) m_nId = nId m_nSub = nSub m_nSel = nSel End Sub End Class Private m_IdSub As New List(Of SelData) Private m_SelGrpId As Integer = GDB_ID.NULL Private Const AUX_ID As String = "AuxId" Friend Sub ClearIdSub() RemoveSelGroup() m_IdSub.Clear() End Sub Friend Sub VerifyIdSub() ' Elimino i record con identificativi di entità non selezionate Dim i As Integer = 0 Do While i < m_IdSub.Count() - 1 If Not EgtIsSelectedObj( m_IdSub( i).m_nId) Then Dim nAuxId As Integer = GDB_ID.NULL If EgtGetInfo( m_IdSub( i).m_nSel, AUX_ID, nAuxId) Then EgtErase( nAuxId) EgtErase( m_IdSub( i).m_nSel) m_IdSub.RemoveAt( i) Else i += 1 End If Loop End Sub Friend Function AddIdSub(nId As Integer, nSub As Integer) As Boolean ' Verifico se la coppia Id,Sub è già in lista For i As Integer = 0 To m_IdSub.Count() - 1 If m_IdSub(i).m_nId = nId And m_IdSub(i).m_nSub = nSub Then Return True Next ' Visualizzo contorno faccia Dim nSelId As Integer = CreateFacetOrChunkOutline( nId, nSub) ' Non trovato, aggiungo un nuovo record m_IdSub.Add(New SelData( nId, nSub, nSelId)) Return True End Function Friend Function RemoveIdSub( nId As Integer, nSub As Integer) As Boolean ' Ricerca ed eliminazione del record con la coppia Id,Sub da rimuovere For i As Integer = 0 To m_IdSub.Count() - 1 If m_IdSub( i).m_nId = nId And m_IdSub( i).m_nSub = nSub Then Dim nAuxId As Integer = GDB_ID.NULL If EgtGetInfo( m_IdSub( i).m_nSel, AUX_ID, nAuxId) Then EgtErase( nAuxId) EgtErase( m_IdSub( i).m_nSel) m_IdSub.RemoveAt( i) Exit For End If Next Return True End Function Friend Function RemoveId( nId As Integer) As Boolean ' Ricerca ed eliminazione di record con identificativo da rimuovere For i As Integer = m_IdSub.Count() - 1 To 0 Step -1 If m_IdSub( i).m_nId = nId Then Dim nAuxId As Integer = GDB_ID.NULL If EgtGetInfo( m_IdSub( i).m_nSel, AUX_ID, nAuxId) Then EgtErase( nAuxId) EgtErase( m_IdSub( i).m_nSel) m_IdSub.RemoveAt( i) End If Next Return True End Function Friend Function FindIdSub( nId As Integer, nSub As Integer) As Boolean For i As Integer = 0 To m_IdSub.Count() - 1 If m_IdSub(i).m_nId = nId And m_IdSub(i).m_nSub = nSub Then Return True Next Return False End Function Friend Function FindId(nId As Integer) As Boolean For i As Integer = 0 To m_IdSub.Count() - 1 If m_IdSub(i).m_nId = nId Then Return True Next Return False End Function Friend Function GetAllSelectedGeom(ByRef vId() As Integer, ByRef vSub() As Integer) As Boolean VerifyIdSub() ' Recupero tutte le entità selezionate con le loro eventuali sotto-parti Dim MyId As New List(Of Integer) Dim MySub As New List(Of Integer) Dim nEntId As Integer = EgtGetFirstSelectedObj() While nEntId <> GDB_ID.NULL Dim MyEntSub As New List(Of Integer) GetSubFromId( nEntId, MyEntSub) For Each nEntSub As Integer In MyEntSub MyId.Add(nEntId) MySub.Add(nEntSub) Next nEntId = EgtGetNextSelectedObj() End While vId = MyId.ToArray() vSub = MySub.ToArray() Return True End Function Friend Function GetSubFromId(nId As Integer, ByRef vSub As List(Of Integer)) As Boolean For i As Integer = 0 To m_IdSub.Count() - 1 If m_IdSub(i).m_nId = nId Then vSub.Add(m_IdSub(i).m_nSub) End If Next If vSub.Count > 0 Then Return True vSub.Add(-1) Return False End Function Private Function VerifySelGroup() As Boolean If m_SelGrpId <> GDB_ID.NULL Then Return True Dim bEnMod As Boolean = EgtGetEnableModified() EgtDisableModified() m_SelGrpId = EgtCreateGroup( GDB_ID.ROOT) EgtSetName( m_SelGrpId, "$$SELDATA") EgtSetLevel( m_SelGrpId, GDB_LV.TEMP) EgtUnselectableAdd( m_SelGrpId) If bEnMod Then EgtEnableModified() Return ( m_SelGrpId <> GDB_ID.NULL) End Function Private Sub RemoveSelGroup() If m_SelGrpId = GDB_ID.NULL Then Return Dim bEnMod As Boolean = EgtGetEnableModified() EgtDisableModified() EgtUnselectableRemove(m_SelGrpId) EgtErase(m_SelGrpId) m_SelGrpId = GDB_ID.NULL If bEnMod Then EgtEnableModified() End Sub Private Function CreateFacetOrChunkOutline( nId As Integer, nFac As Integer) As Integer VerifySelGroup() Dim bEnMod As Boolean = EgtGetEnableModified() EgtDisableModified() Dim nCount As Integer Dim nFirstId As Integer = GDB_ID.NULL If EgtGetType( nId) = GDB_TY.SRF_MESH Then nFirstId = EgtExtractSurfTmFacetLoops( nId, nFac, m_SelGrpId, nCount) Else nFirstId = EgtExtractSurfFrChunkLoops( nId, nFac, m_SelGrpId, nCount) End If If nFirstId <> GDB_ID.NULL Then EgtSetColor( nFirstId, New Color3d( 255, 0,0)) For nCrvId As Integer = nFirstId + 1 To nFirstId + nCount - 1 EgtErase( nCrvId) Next Dim ptZM As New Point3d() EgtAtParamPoint( nFirstId, 0.5, m_SelGrpId, ptZM) Dim nSpheId = EgtCreateSurfTmSphere( m_SelGrpId, ptZM, 1, 0.1, GDB_RT.LOC) EgtSetColor( nSpheId, New Color3d( 255, 0,0)) EgtSetInfo( nFirstId, AUX_ID, nSpheId) End If If bEnMod Then EgtEnableModified() Return nFirstId End Function End Module