Как удалить повторяющиеся фигуры в контейнере типа List

Tim Umix

Подскажите , как можно удалить повторяющиеся фигуры в контейнере типа list. Например если в контейнере несколько фигур с одинаковыми значениями , то нужно их удалить оставив одну фигуру. Для удаления использую такой код, но никак не могу сообразить, как внутри контейнера сравнивать между собой фигуры. :wall:

Код:

Dim arr() As Long
    Dim i As Integer
    Dim listMemberShape As Visio.Shape
    Dim listMemberShape2 As Visio.Shape
    Dim containerShape As Visio.Shape
    Dim n As Integer
      
    Set containerShape = Application.ActiveWindow.Selection(1)
    
    If containerShape.ContainerProperties.ContainerType = visContainerTypeList Then
        
        arr = containerShape.ContainerProperties.GetListMembers
        For i = 0 To UBound(arr)
            Set listMemberShape = ActivePage.Shapes.ItemFromID(arr(i))
            
            containerShape.ContainerProperties.RemoveMember listMemberShape

            listMemberShape.Delete
            
        Next
    End If

Tumanov

Цитата:

как можно удалить повторяющиеся фигуры в контейнере типа list. Например если в контейнере несколько фигур с одинаковыми значениями

Тут два момента:
1. Не бывает повторяющихся шейпов (фигур). У них может быть одинаковое значение какого-то свойства. Какого?
2. Контейнер, в отличие от группы, это только привязка. Сами шейпы находятся на странице. Удаление не отличается от удаления любых других шейпов.

Tim Umix

Tumanov писал(а):

Цитата:

как можно удалить повторяющиеся фигуры в контейнере типа list. Например если в контейнере несколько фигур с одинаковыми значениями

Тут два момента:
1. Не бывает повторяющихся шейпов (фигур). У них может быть одинаковое значение какого-то свойства. Какого?
2. Контейнер, в отличие от группы, это только привязка. Сами шейпы находятся на странице. Удаление не отличается от удаления любых других шейпов.

Да например в окне данных Prop.Name у них есть одинаковые значения. Например 5 фигур со значением Prop.Name=1 нужно удалить все одинаковые, но чтобы осталась одна фигура с таким значением. К примеру в контейнере 3 фигуры со значением 1 , 2 со значением 2 , и нужно чтобы в контейнере осталась по одной фигуре каждого значения. Пробовал помещать в коллекцию, но в коллекции тоже не получилось отсортировать таким способом.

Tumanov

Вот так пойдет?

Код:

Sub ttt()
    Dim arr() As Long
    Dim i As Integer
    Dim listMemberShape As Visio.Shape
    Dim listMemberShape2 As Visio.Shape
    Dim containerShape As Visio.Shape
    Dim n As Integer
     
    Set containerShape = Application.ActiveWindow.Selection(1)
        arr = containerShape.ContainerProperties.GetListMembers
        Set Coll = New Collection
        For i = 0 To UBound(arr)
            Set listMemberShape = ActivePage.Shapes.ItemFromID(arr(i))
            n = listMemberShape.Cells("Prop.Name").ResultInt(32, 0)
            For j = i + 1 To UBound(arr)
                Set shpForDel = ActivePage.Shapes.ItemFromID(arr(j))
                n1 = shpForDel.Cells("Prop.Name").ResultInt(32, 0)
                On Error Resume Next
                    If n = n1 Then Coll.Add shpForDel, shpForDel.NameID
                On Error GoTo 0
            Next
        Next
        For Each Nid In Coll
            Nid.Delete
            'Debug.Print Nid.NameID
        Next
End Sub

Tumanov

Извиняюсь. Точнее будет сначала исключить их из контейнера, а только потом удалить.

Код:

Sub ttt_2()
    Dim arr() As Long
    Dim i As Integer
    Dim listMemberShape As Visio.Shape
    Dim listMemberShape2 As Visio.Shape
    Dim containerShape As Visio.Shape
    Dim n As Integer
     
    Set containerShape = Application.ActiveWindow.Selection(1)
        arr = containerShape.ContainerProperties.GetListMembers
        Set Coll = New Collection
        For i = 0 To UBound(arr)
            Set listMemberShape = ActivePage.Shapes.ItemFromID(arr(i))
            n = listMemberShape.Cells("Prop.Name").ResultInt(32, 0)
            For j = i + 1 To UBound(arr)
                Set shpForDel = ActivePage.Shapes.ItemFromID(arr(j))
                n1 = shpForDel.Cells("Prop.Name").ResultInt(32, 0)
                On Error Resume Next
                    If n = n1 Then Coll.Add shpForDel, shpForDel.NameID
                On Error GoTo 0
            Next
        Next
        ActiveWindow.DeselectAll
        For Each Nid In Coll
            ActiveWindow.Select Nid, visSelect
        Next
        containerShape.ContainerProperties.RemoveMember ActiveWindow.Selection
        ActiveWindow.Selection.Delete
End Sub

Tim Umix

Tumanov писал(а):

Извиняюсь. Точнее будет сначала исключить их из контейнера, а только потом удалить.

Спасибо. То что нужно

Форум пользователей Visio

Правила форума

Как удалить повторяющиеся фигуры в контейнере типа List

Кто сейчас на конференции