Imports System.ComponentModel Imports System.Collections.ObjectModel Imports EgtUILib Public Class FixtureParametersVM Inherits ViewModelBase Friend Const USED As String = "USED" Private m_FixtureTypeList As ObservableCollection(Of FixtureListItem) Public ReadOnly Property FixtureTypeList As ObservableCollection(Of FixtureListItem) Get If IsNothing(m_FixtureTypeList) Then m_FixtureTypeList = New ObservableCollection(Of FixtureListItem)(FixtureType.ReadFixtureTypeFromMachIni()) End If Return m_FixtureTypeList End Get End Property Private m_SelectedFixtureType As FixtureListItem Public Property SelectedFixtureType As FixtureListItem Get Return m_SelectedFixtureType End Get Set(value As FixtureListItem) m_SelectedFixtureType = value End Set End Property #Region "Messages" Private m_FixtureErrorMsg As String Public ReadOnly Property FixtureErrorMsg As String Get Return m_FixtureErrorMsg End Get End Property Public ReadOnly Property OkMsg As String Get Return EgtMsg(MSG_DISPOSITION + 1) End Get End Property #End Region ' Messages Sub New(ByRef ExpandFixtureFunction As Action) ' Creo riferimento a questa classe in EgtCAM5Map Map.SetRefFixtureParametersVM(Me) ExpandFixtureFunction = AddressOf UpdateFixtureCount ' seleziono secondo elemento se presente perchè primo è categoria SelectedFixtureType = Nothing End Sub Private Sub UpdateFixtureCount() ' resetto tutto For Index = 0 To m_FixtureTypeList.Count - 1 If TypeOf m_FixtureTypeList(Index) Is FixtureType Then Dim CurrFixtureType As FixtureType = DirectCast(m_FixtureTypeList(Index), FixtureType) CurrFixtureType.UsedNumber = 0 End If Next ' calcolo i sottopezzi utilizzati in questa fase Dim nUsedFixtureId As Integer = EgtGetFirstFixture() While nUsedFixtureId <> GDB_ID.NULL Dim sUsedFixtureName As String = String.Empty For Index = 0 To m_FixtureTypeList.Count - 1 EgtGetName(nUsedFixtureId, sUsedFixtureName) If sUsedFixtureName = m_FixtureTypeList(Index).Name Then Dim CurrFixtureType As FixtureType = DirectCast(m_FixtureTypeList(Index), FixtureType) CurrFixtureType.UsedNumber += 1 Exit For End If Next nUsedFixtureId = EgtGetNextFixture(nUsedFixtureId) End While End Sub Friend Sub UpdateFixtureTypeList() m_FixtureTypeList = New ObservableCollection(Of FixtureListItem)(FixtureType.ReadFixtureTypeFromMachIni()) OnPropertyChanged("FixtureTypeList") End Sub ' Definizione comandi Private m_cmdAdd As ICommand Private m_cmdRemove As ICommand #Region "COMMANDS" #Region "AddCommand" ''' ''' Returns a command that do Done. ''' Public ReadOnly Property AddCommand As ICommand Get If m_cmdAdd Is Nothing Then m_cmdAdd = New RelayCommand(AddressOf Add) End If Return m_cmdAdd End Get End Property ''' ''' Execute the Point. This method is invoked by the DoneCommand. ''' Public Sub Add(ByVal param As Object) ' resetto il messaggio di errore m_FixtureErrorMsg = String.Empty ' verifico se è stato selezionato un sottopezzo nella lista Dim SelectedFixture As FixtureType If TypeOf param Is FixtureType Then SelectedFixture = DirectCast(param, FixtureType) Else Return End If ' recupero area della tavola Dim ptTableMin As Point3d Dim ptTableMax As Point3d if Not EgtGetTableArea(1, ptTableMin, ptTableMax) Then m_FixtureErrorMsg = "Tavola non definita" OnPropertyChanged("FixtureErrorMsg") Return End If ' calcolo il centro della tavola Dim ptTableMid As New Point3d((ptTableMax.x - ptTableMin.x) / 2, (ptTableMax.y - ptTableMin.y) / 2, (ptTableMax.z - ptTableMin.z) / 2) ' posiziono il nuovo sottopezzo al centro della tavola Dim nAddedFixtureId As Integer = EgtAddFixture(SelectedFixture.Name, ptTableMid, 0, 0) If nAddedFixtureId = GDB_ID.NULL Then m_FixtureErrorMsg = "Impossibile posizionare la ventosa sulla tavola" OnPropertyChanged("FixtureErrorMsg") Return End If ' verifico se la ventosa ha punti di hook da ancorare If IsFixtureWithHook(nAddedFixtureId) Then If Not PositionFixtureOnNearestHook(nAddedFixtureId) Then ' non ci sono punti liberi, quindi rimuovo la ventosa e segnalo EgtRemoveFixture(nAddedFixtureId) MessageBox.Show("No free hook point!", "ERROR") Return End If Else ' se non ha punti di ancoraggio ' verifico se è in una posizione valida If Not DispositionUtility.VerifyFixturePosition(nAddedFixtureId, New Vector3d) Then ' se non trovo una posizione valida, esco If Not SearchOkFixturePosition(nAddedFixtureId, ptTableMin, ptTableMax, ptTableMid) Then Return End If End If End If ' sottraggo la ventosa aggiunta dal conto di quelle disponibili SelectedFixture.UsedNumber += 1 EgtDraw() OnPropertyChanged("FixtureErrorMsg") End Sub ' Funzione che cerca una posizione valida per la ventosa libera di muoversi Private Function SearchOkFixturePosition(nAddedFixtureId As Integer, ptTableMin As Point3d, ptTableMax As Point3d, ptTableMid As Point3d) As Boolean ' creo un gruppo temporaneo Dim nTempGroupId As Integer = EgtCreateGroup(GDB_ID.ROOT) EgtSetLevel(nTempGroupId, GDB_LV.USER) EgtSetMode(nTempGroupId, GDB_MD.STD) ' calcolo ingombro sottopezzo aggiunto Dim bboxAddedFixture As New BBox3d EgtGetBBoxGlob(nAddedFixtureId, GDB_BB.STANDARD, bboxAddedFixture) ' calcolo bbox tavolo Dim bboxTableArea As New BBox3d(ptTableMin, ptTableMax) bboxTableArea.Expand(-bboxAddedFixture.DimX / 2, -bboxAddedFixture.DimY / 2, 0) ' creo superficie delle misure della tavola Dim nTableFrId As Integer = EgtCreateSurfFrRectangle(nTempGroupId, bboxTableArea.Min, bboxTableArea.Max) ' ciclo su tutti i pezzi di questa fase Dim nFixtureId As Integer = EgtGetFirstFixture() While nFixtureId <> GDB_ID.NULL ' creo il bbox del sottopezzo Dim bboxFixture As New BBox3d EgtGetBBoxGlob(nFixtureId, GDB_BB.STANDARD, bboxFixture) ' faccio offset del bbox del sottopezzo per includere metà del sottopezzo da aggiungere bboxFixture.Expand(bboxAddedFixture.DimX / 2, bboxAddedFixture.DimY / 2, 0) ' lo porto all'altezza della tavola Dim ptMinFixtureFr As New Point3d(bboxFixture.Min) Dim ptMaxFixtureFr As New Point3d(bboxFixture.Max) ptMinFixtureFr.z = ptTableMin.z ptMaxFixtureFr.z = ptTableMin.z ' creo la regione occupata dal bbox del sottopezzo Dim nFixtureFrId As Integer = EgtCreateSurfFrRectangle(nTempGroupId, ptMinFixtureFr, ptMaxFixtureFr) ' sottraggo la regione del sottopezzo da quella della tavola Dim x = EgtSurfFrSubtract(nTableFrId, nFixtureFrId) nFixtureId = EgtGetNextFixture(nFixtureId) End While ' creo gruppo con i bordi della regione di tavola avanzata Dim TableFrBorderGroupId As Integer = EgtCreateGroup(nTempGroupId) Dim nTableFrBorderCount As Integer = 0 Dim nChunk As Integer = EgtSurfFrChunkCount(nTableFrId) For Index = 0 To nChunk - 1 EgtExtractSurfFrChunkLoops(nTableFrId, Index, TableFrBorderGroupId, nTableFrBorderCount) Next ' verifico se c'è almeno un bordo If nTableFrBorderCount = 0 Then m_FixtureErrorMsg = "Impossibile posizionare la ventosa sulla tavola" OnPropertyChanged("FixtureErrorMsg") Return False End If ' converto il punto medio della tavola in coordinate globali Dim PtTableRef As Point3d EgtGetTableRef(1, PtTableRef) Dim frTableRef As New Frame3d(PtTableRef) ptTableMid.ToGlob(frTableRef) ' ciclo sui bordi per trovare il punto più vicino Dim dMinDist As Double = (bboxTableArea.Max - bboxTableArea.Min).SqLenXY Dim ptMinAbs As Point3d Dim BorderId As Integer = EgtGetFirstInGroup(TableFrBorderGroupId) While BorderId <> GDB_ID.NULL Dim dDist As Double = 0 Dim ptMinRel As Point3d Dim nSide As Integer = 0 EgtPointCurveDistSide(ptTableMid, BorderId, Vector3d.Z_AX, GDB_ID.ROOT, dDist, ptMinRel, nSide) If dDist < dMinDist Then dMinDist = dDist ptMinAbs = ptMinRel End If BorderId = EgtGetNext(BorderId) End While ' sposto il sottopezzo nel punto trovato Dim vtFixtureMove As Vector3d = ptMinAbs - ptTableMid vtFixtureMove.z = 0 EgtMoveFixture(nAddedFixtureId, vtFixtureMove) ' cancello il gruppo temporaneo EgtErase(nTempGroupId) Return True End Function ' Funzione che dice se c'è un punto di aggancio sulla ventosa Private Function IsFixtureWithHook(nFixtureId As Integer) As Boolean ' cerco punto hook sulla ventosa Dim nFixtSolidId As Integer = EgtGetFirstNameInGroup(nFixtureId, SOLID) Dim nFixtHookId As Integer = EgtGetFirstNameInGroup(nFixtSolidId, DispositionUtility.HOOK) If nFixtHookId = GDB_ID.NULL Then Return False ' leggo tipo Dim sType As String = "" EgtGetInfo(nFixtHookId, DispositionUtility.TYPE, sType) If sType.Equals(DispositionUtility.FREE) Then Return False ElseIf sType.Equals(DispositionUtility.POINT) Then Return True ElseIf sType.Equals(DispositionUtility.LINE) Then Return True Else Return False End If End Function ' Funzione che aggancia la ventosa al più vicino hook libero Friend Shared Function PositionFixtureOnNearestHook(nFixtureId As Integer) As Boolean ' cerco punto hook sulla ventosa Dim nFixtSolidId As Integer = EgtGetFirstNameInGroup(nFixtureId, SOLID) Dim nFixtHookId As Integer = EgtGetFirstNameInGroup(nFixtSolidId, DispositionUtility.HOOK) ' recupero punto di hook Dim ptFixtHook As Point3d EgtStartPoint(nFixtHookId, GDB_ID.ROOT, ptFixtHook) ' leggo tipo e classe Dim nFixtHookType As DispositionUtility.HOOKTYPE = DispositionUtility.HOOKTYPE.FREE Dim sType As String = "" EgtGetInfo(nFixtHookId, DispositionUtility.TYPE, sType) If sType.Equals(DispositionUtility.FREE) Then nFixtHookType = DispositionUtility.HOOKTYPE.FREE ' esco perchè non devo cercare alcun punto Return True ElseIf sType.Equals(DispositionUtility.POINT) Then nFixtHookType = DispositionUtility.HOOKTYPE.POINT ElseIf sType.Equals(DispositionUtility.LINE) Then nFixtHookType = DispositionUtility.HOOKTYPE.LINE Else nFixtHookType = DispositionUtility.HOOKTYPE.FREE ' esco perchè non devo cercare alcun punto Return True End If Dim nFixtHookClass As Integer = 0 EgtGetInfo(nFixtHookId, DispositionUtility.CLASS_, nFixtHookClass) ' cerco id tavola Dim sTableName As String = "" EgtGetTableName(sTableName) Dim nTableId As Integer = EgtGetTableId(sTableName) ' cerco hook su tavola macchina Dim nTableSolidId As Integer = EgtGetFirstNameInGroup(nTableId, SOLID) Dim nCurrHookId As Integer = EgtGetFirstNameInGroup(nTableSolidId, DispositionUtility.HOOK) ' Punto di hook a cui spostare la ventosa Dim ptCurrHook As Point3d = Nothing While nCurrHookId <> GDB_ID.NULL ' se punto di aggancio valido If HookAnalyzer(nCurrHookId, nFixtHookType, nFixtHookClass, ptFixtHook, ptCurrHook) Then ' sposto la ventosa EgtMoveFixture(nFixtureId, ptCurrHook - ptFixtHook) ' verifico se è in una posizione valida If DispositionUtility.VerifyFixturePosition(nFixtureId, New Vector3d) Then EgtSetInfo(nCurrHookId, used, nFixtureId) Return True End If End If nCurrHookId = EgtGetNextName(nCurrHookId, DispositionUtility.HOOK) End While ' cerco hook su barra fissa Dim nTableFixedId As Integer = EgtGetFirstNameInGroup(nTableId, DispositionUtility.FIXED) nCurrHookId = EgtGetFirstNameInGroup(nTableFixedId, DispositionUtility.HOOK) While nCurrHookId <> GDB_ID.NULL ' se punto di aggancio valido If HookAnalyzer(nCurrHookId, nFixtHookType, nFixtHookClass, ptFixtHook, ptCurrHook) Then ' sposto la ventosa EgtMoveFixture(nFixtureId, ptCurrHook - ptFixtHook) ' verifico se è in una posizione valida If DispositionUtility.VerifyFixturePosition(nFixtureId, New Vector3d) Then EgtSetInfo(nCurrHookId, USED, nFixtureId) Return True End If End If nCurrHookId = EgtGetNextName(nCurrHookId, DispositionUtility.HOOK) End While ' cerco hook su barre mobili Dim nMobileInd As Integer = 1 Dim nMobile As Integer = EgtGetFirstNameInGroup(nTableId, DispositionUtility.MOBILE & nMobileInd) While nMobile <> GDB_ID.NULL nCurrHookId = EgtGetFirstNameInGroup(nMobile, DispositionUtility.HOOK) While nCurrHookId <> GDB_ID.NULL ' se punto di aggancio valido If HookAnalyzer(nCurrHookId, nFixtHookType, nFixtHookClass, ptFixtHook, ptCurrHook) Then ' sposto la ventosa EgtMoveFixture(nFixtureId, ptCurrHook - ptFixtHook) ' verifico se è in una posizione valida If DispositionUtility.VerifyFixturePosition(nFixtureId, New Vector3d) Then EgtSetInfo(nCurrHookId, USED, nFixtureId) Return True End If End If nCurrHookId = EgtGetNextName(nCurrHookId, DispositionUtility.HOOK) End While nMobileInd += 1 nMobile = EgtGetFirstNameInGroup(nTableId, DispositionUtility.MOBILE & nMobileInd) End While Return False End Function ' Funzione che analizza l'hook e se valido ne prestituisce lo posizione(punto) Private Shared Function HookAnalyzer(nCurrHookId As Integer, nFixtHookType As Integer, nFixtHookClass As Integer, ptFixtHook As Point3d, ByRef ptCurrHook As Point3d) As Boolean ' verifico se del tipo giusto Dim nTableHookType As GDB_TY = EgtGetType(nCurrHookId) If (nTableHookType = GDB_TY.GEO_POINT And nFixtHookType = DispositionUtility.HOOKTYPE.POINT) OrElse (nTableHookType = GDB_TY.CRV_LINE And nFixtHookType = DispositionUtility.HOOKTYPE.LINE) Then ' verifico se della stessa classe Dim nTableHookClass As Integer = 0 EgtGetInfo(nCurrHookId, DispositionUtility.CLASS_, nTableHookClass) If nTableHookClass = nFixtHookClass Then Dim dDist As Double = 0 ' punto a distanza minima sull'hook If nTableHookType = GDB_TY.GEO_POINT Then ' verifico se utilizzato Dim nTableHookUsed As Boolean = False If Not EgtGetInfo(nCurrHookId, DispositionUtility.USED, nTableHookUsed) Then ' calcolo distanza punto hook tavola dal punto hook della ventosa EgtStartPoint(nCurrHookId, GDB_ID.ROOT, ptCurrHook) Return True End If ElseIf nTableHookType = GDB_TY.CRV_LINE Then ' calcolo distanza linea hook tavola dal punto hook della ventosa Dim nRefId As Integer = 0 Dim dU As Double = 0 EgtPointCurveDist(ptFixtHook, nCurrHookId, nRefId, dDist, dU) EgtAtParamPoint(nCurrHookId, dU, GDB_ID.ROOT, ptCurrHook) Return True End If End If End If Return False End Function #End Region ' AddCommand #Region "RemoveCommand" ''' ''' Returns a command that do Done. ''' Public ReadOnly Property RemoveCommand As ICommand Get If m_cmdRemove Is Nothing Then m_cmdRemove = New RelayCommand(AddressOf Remove) End If Return m_cmdRemove End Get End Property ''' ''' Execute the Point. This method is invoked by the DoneCommand. ''' Public Sub Remove() Dim SelectedFixtureId As Integer = EgtGetFirstSelectedObj() While SelectedFixtureId <> GDB_ID.NULL Dim NextSelectedId As Integer = EgtGetNextSelectedObj() If EgtVerifyFixture(SelectedFixtureId) Then EgtRemoveFixture(SelectedFixtureId) For Index = 0 To FixtureTypeList.Count - 1 Dim SelFixtureName As String = String.Empty EgtGetName(SelectedFixtureId, SelFixtureName) If SelFixtureName = FixtureTypeList(Index).Name Then Dim CurrFixtureType As FixtureType = DirectCast(FixtureTypeList(Index), FixtureType) CurrFixtureType.UsedNumber -= 1 End If Next End If SelectedFixtureId = NextSelectedId End While EgtDraw() End Sub #End Region ' RemoveCommand #End Region End Class Public Class FixtureType Inherits FixtureListItem Private m_TotalNumber As Integer Private m_UsedNumber As Integer Private m_IsEnabled As Boolean = True Private m_IsSelected As Boolean = False Public Property TotalNumber As Integer Get Return m_TotalNumber End Get Set(value As Integer) If value <> m_TotalNumber Then m_TotalNumber = value NotifyPropertyChanged("UsedTotalRatio") End If End Set End Property Public Property UsedNumber As Integer Get Return m_UsedNumber End Get Set(value As Integer) If value <> m_UsedNumber Then m_UsedNumber = value NotifyPropertyChanged("UsedTotalRatio") If UsedNumber >= TotalNumber Then m_IsEnabled = False m_IsSelected = False NotifyPropertyChanged("IsSelected") Else m_IsEnabled = True End If NotifyPropertyChanged("IsEnabled") End If End Set End Property Public ReadOnly Property UsedTotalRatio As String Get Return (TotalNumber - UsedNumber).ToString & " / " & TotalNumber.ToString End Get End Property Public ReadOnly Property IsEnabled As Boolean Get Return m_IsEnabled End Get End Property Public Property IsSelected As Boolean Get Return m_IsSelected End Get Set(value As Boolean) m_IsSelected = value End Set End Property Sub New(sName As String, sCat As DispositionUtility.FIX_TYPE, nTot As Integer) MyBase.New(sName, sCat) TotalNumber = nTot m_IsEnabled = True End Sub Public Shared Function ReadFixtureTypeFromMachIni() As List(Of FixtureListItem) ' creo la lista locale Dim FixtureTypeList As New List(Of FixtureListItem) ' aggiungo le ventose se presenti Dim sName As String = String.Empty Dim nTot As Integer = 0 Dim bFirst As Boolean = True Dim nIndex As Integer = 1 While GetPrivateProfileFixture(S_FIXTURES, System.Globalization.CultureInfo.InvariantCulture.TextInfo.ToTitleCase(FIX_VAC) & nIndex, sName, nTot) If bFirst Then FixtureTypeList.Add(New FixtureListItem(FIX_VAC, DispositionUtility.FIX_TYPE.VACUUM)) bFirst = False End If FixtureTypeList.Add(New FixtureType(sName, DispositionUtility.FIX_TYPE.VACUUM, nTot)) nIndex += 1 End While ' aggiungo i riferimenti se presenti bFirst = True nIndex = 1 While GetPrivateProfileFixture(S_FIXTURES, FIX_REF & nIndex, sName, nTot) If bFirst Then FixtureTypeList.Add(New FixtureListItem(FIX_REF, DispositionUtility.FIX_TYPE.REFERENCE)) bFirst = False End If FixtureTypeList.Add(New FixtureType(sName, DispositionUtility.FIX_TYPE.REFERENCE, nTot)) nIndex += 1 End While ' aggiungo le morse se presenti bFirst = True nIndex = 1 While GetPrivateProfileFixture(S_FIXTURES, FIX_VIS & nIndex, sName, nTot) If bFirst Then FixtureTypeList.Add(New FixtureListItem(FIX_VIS, DispositionUtility.FIX_TYPE.VISE)) bFirst = False End If FixtureTypeList.Add(New FixtureType(sName, DispositionUtility.FIX_TYPE.VISE, nTot)) nIndex += 1 End While Return FixtureTypeList End Function End Class Public Class FixtureListItem Implements INotifyPropertyChanged Private m_Name As String Private m_Cathegory As DispositionUtility.FIX_TYPE Private m_Focusable As Boolean Public Property Name As String Get Return m_Name End Get Set(value As String) m_Name = value End Set End Property Public Property Cathegory As DispositionUtility.FIX_TYPE Get Return m_Cathegory End Get Set(value As DispositionUtility.FIX_TYPE) m_Cathegory = value End Set End Property Public ReadOnly Property Focusable As Boolean Get Return m_Focusable End Get End Property Public ReadOnly Property CathegoryName As String Get Select Case Cathegory Case DispositionUtility.FIX_TYPE.VACUUM Return "Vacuum" Case DispositionUtility.FIX_TYPE.REFERENCE Return "Reference" Case DispositionUtility.FIX_TYPE.VISE Return "Vise" Case Else Return String.Empty End Select End Get End Property Sub New(sName As String, Cathegory As DispositionUtility.FIX_TYPE) Me.Name = sName Me.Cathegory = Cathegory If TypeOf Me Is FixtureType Then m_Focusable = True Else m_Focusable = False End If End Sub Public Event PropertyChanged As PropertyChangedEventHandler Implements INotifyPropertyChanged.PropertyChanged Public Sub NotifyPropertyChanged(propName As String) RaiseEvent PropertyChanged(Me, New PropertyChangedEventArgs(propName)) End Sub End Class