Форум программистов, компьютерный форум, киберфорум
CorelDRAW
Войти
Регистрация
Восстановить пароль
 
 
Рейтинг 4.64/11: Рейтинг темы: голосов - 11, средняя оценка - 4.64
3 / 2 / 1
Регистрация: 02.11.2016
Сообщений: 110
1

Массив из shape range

06.10.2018, 07:09. Просмотров 2222. Ответов 28
Метки vba (Все метки)

Все привет! Подскажите пожалуйста, пишу макрос для cdr и в процессе его создания, нужно сделать массив из shape range

Часть кода:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Dim gr2_fall As New ShapeRange 
 
For i = 1 To so.Count
        For Each s In gr2_f3
            If so(i).SizeHeight = s.SizeWidth Then
                For Each d In gr2_f1
                    If s.PositionY = d.PositionY Then
                gr2_fall.Add s
                gr2_fall.Add so(i)
                gr2_fall.Add d
                    End If
                Next
            End If
        Next
    Next
Все переменные тут - ShapeRange
Вот тут при выполнении всех условий мне нужно получить массив:

ar(( s1, so1, d1), (s2, so2, d2), и тд.) - можно ли такое реализовать?



Как вариант, пробовал группировать (s1, so1, d1), при выполнении условия, но цикл ошибку выдает, после группировки на след. итерации. Как то выход из цикла нужно сделать... Если с этим разобраться, то в принципе, gr2_fall - будет как бы ShapeRange с группами, такой вариант тоже подойдет.

Спасибо!
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
06.10.2018, 07:09
Ответы с готовыми решениями:

При вызове объекта Range, VBA самостоятельно меняет Range на rAnge
Всем доброго дня, у меня такой вопрос. По незнанию создал функцию rAnge(), теперь при вызове...

Сохранить свой shape как нормальный shape
Создаю свой shape в MS Office Word 2007 Скажите, есть ли возможность сохранить его как shape для...

shape/ layer shape в по заданному изображению
Не могу shape для использования в приложении: background Может кто поможет. <?xml...

Координаты Shape в массив
Создаю динамически Shape'ы и заношу их в массив. Как занести координаты каждого создаваемого шейпа...

28
3 / 2 / 1
Регистрация: 02.11.2016
Сообщений: 110
08.10.2018, 20:14  [ТС] 2
Поэкспериментировал, вот так оказывается нужно было сделать:
Visual Basic
1
2
Dim ar() As Object
ReDim ar(1 To so.Count, 1 To 3)
0
178 / 177 / 30
Регистрация: 11.10.2016
Сообщений: 567
15.10.2018, 12:23 3
как вариант, можно сделать три ShapeRange-а s, so, d и обращаться к их элементам по одному индексу: s(4), so(4), d(4). Получится что-то типа трех динамических массивов.
1
3 / 2 / 1
Регистрация: 02.11.2016
Сообщений: 110
17.10.2018, 06:27  [ТС] 4
_shark, здравствуйте, спасибо!

Не подскажите, как сделать следующее:
есть 2-х мерный массив, например arr1(1 to 2, 1 to 5)
заполнен например вот так arr1:
(1, 1) - shape (2, 1) - shape
(1, 2) - empty (2, 2) - empty
(1, 3) - empty (2, 3) - shape
(1, 4) - empty (2, 4) - shape
(1, 5) - shape (2, 5) - shape

Как тут подсчитать не пустые значения и вывести в другой массив, например:
arr2(1) = 2
arr2(2) = 4

C 1-мерным массивом вроде понятно, а с 2-мерным не могу разобраться..
Спасибо!
0
178 / 177 / 30
Регистрация: 11.10.2016
Сообщений: 567
17.10.2018, 09:21 5
Dimson_, я бы вам все-таки рекомендовал отказаться от двумерных массивов, не очень-то они удобные при работе с shape-ами. В вашем случае нужно делать два вложенных цикла по индексам массива ( for i = 1 to 2: for j = 1 to 5) и проверять содержит ли ячейка массива указатель на shape
Visual Basic
1
If Not arr1(i, j) Is Nothing Then 'shape имеется
Следует иметь в виду, что если вы удалили shape вручную или программно, то указатель на него в массиве все равно останется, поэтому удалять надо таким образом:
Visual Basic
1
arr1(i, j).Delete: Set arr(i, j) = Nothing
1
3 / 2 / 1
Регистрация: 02.11.2016
Сообщений: 110
18.10.2018, 07:02  [ТС] 6
С Nothing ошибку выдает, а вот так работает:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
    For i = 1 To 2
        For j = 1 To 5
            If Not IsEmpty(arr1(i, j)) Then
 
            count = count + 1
            arr2(i) = count
            
            If j = 5 Then ' - тут хотел сбросить счетчик, но он не сбрасывается почему-то...
                 count = 1
            End If
                
            End If
        Next
    Next
Получается arr2(1) - ок, arr2(2) - счетчик не сбрасывается и считает дальше, в итоге записывается общее кол-во совпадений, не подскажите, как можно исправить это?
0
178 / 177 / 30
Регистрация: 11.10.2016
Сообщений: 567
18.10.2018, 09:42 7
попробуйте написать count = 1 сразу после первого next. В этом случае по выходу из первого цикла счетчик станет равным единице. Кроме того, счетчик у вас сначала записывается в arr2, а потом уже сбрасывается
1
3 / 2 / 1
Регистрация: 02.11.2016
Сообщений: 110
19.10.2018, 10:36  [ТС] 8
_shark, отлично!, спасибо Вам большое!
0
3 / 2 / 1
Регистрация: 02.11.2016
Сообщений: 110
29.10.2018, 09:18  [ТС] 9
Снова немного застрял, пытаюсь из shape range в массив вытащить не одинаковые объекты
Ошибок не выдает и результат не правильный :

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Dim arr(10) As Variant
    
Set arr(1) = SR.Shapes(1)
 
    For i = 2 To SR.count
       
        For j = 1 To UBound(arr)
            If Not IsEmpty(arr(j)) Then
                If Round(arr(j).SizeWidth, 0) <> Round(SR(i).SizeWidth, 0) And Round(arr(j).SizeHeight, 0) <> Round(SR(i).SizeHeight, 0) Then
                    Set arr(i) = SR(i)
                End If
            End If
        Next
        
    Next
0
178 / 177 / 30
Регистрация: 11.10.2016
Сообщений: 567
29.10.2018, 13:19 10
не скажу, что ошибка именно в этом, но попробуйте так записать:
Visual Basic
1
If (Round(arr(j).SizeWidth, 0) <> Round(SR(i).SizeWidth, 0)) And (Round(arr(j).SizeHeight, 0) <> Round(SR(i).SizeHeight, 0)) Then
был у меня как-то похожий случай, когда несколько условий с And-ом неправильно выполнялись
1
3 / 2 / 1
Регистрация: 02.11.2016
Сообщений: 110
30.10.2018, 06:30  [ТС] 11
Нет, так тоже не работает, интересно, что не так. Мне по сути нужно, чтобы одинаковые объекты(размер) из первого shaperange не добавлялись в массив или другой shaperange
0
178 / 177 / 30
Регистрация: 11.10.2016
Сообщений: 567
30.10.2018, 19:45 12
у вас, по сути, все шейпы сравниваются с первым элементом и если они ему не равны, то заносятся в массив
1
3 / 2 / 1
Регистрация: 02.11.2016
Сообщений: 110
31.10.2018, 08:18  [ТС] 13
Оказывается не правильно сравнивал, у объектов может быть одинаковый размер у одной из сторон, по этому в массив и не записывался. Сравниваю через Curve.Length, тут вроде все хорошо!
Спасибо!
0
3 / 2 / 1
Регистрация: 02.11.2016
Сообщений: 110
01.11.2018, 10:15  [ТС] 14
Цитата Сообщение от _shark Посмотреть сообщение
все шейпы сравниваются с первым элементом
- точно, все правильно, так не пойдет
Не подскажите, как можно решить эту задачу?
0
178 / 177 / 30
Регистрация: 11.10.2016
Сообщений: 567
01.11.2018, 11:45 15
попробуйте так сделать:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
Dim arr(10) As Variant, Found As Boolean, z%
    
z = 1: Set arr(z) = SR(1)
For i = 2 To SR.count
    Found = True
    For j = 1 To z
        If Round(arr(j).SizeWidth, 0) = Round(SR(i).SizeWidth, 0) And Round(arr(j).SizeHeight, 0) = Round(SR(i).SizeHeight, 0) Then
            Found = False: Exit For
        End If
    Next j
    If Found Then  z = z + 1: Set arr(z) = SR(i)
Next i
Правда, если у вас будет больше 10 объектов, то код выдаст ошибку, поскольку зарезервировано всего лишь 10 элементов массива arr(10)
Проверять общую длину Curve.Length нет смысла, поскольку это длина периметра, а размеры сторон при этом могут быть различными. Кроме того, объекты могут быть повернуты на 90 градусов, при этом SizeWidth и SizeHeight будут возвращать прежние значения. Округлять до целого числа Round( ,0) тоже не самая лучшая идея, но тут уж сами определитесь с точностью
1
3 / 2 / 1
Регистрация: 02.11.2016
Сообщений: 110
03.11.2018, 07:34  [ТС] 16
_shark, спасибо, очень хорошо все работает! Хотел разобраться:
Цитата Сообщение от _shark Посмотреть сообщение
For j = 1 To z
- тут проверяются уже все добавленные в массив шейпы?, или весь массив?
Цитата Сообщение от _shark Посмотреть сообщение
Next j
- это обязательно или можно просто "next"?

Цитата Сообщение от _shark Посмотреть сообщение
Правда, если у вас будет больше 10 объектов, то код выдаст ошибку, поскольку зарезервировано всего лишь 10 элементов массива arr(10)
- буду 100 прописывать, точно знаю, что не ошибусь

Цитата Сообщение от _shark Посмотреть сообщение
Проверять общую длину Curve.Length нет смысла
- ок, согласен

Цитата Сообщение от _shark Посмотреть сообщение
Округлять до целого числа Round( ,0) тоже не самая лучшая идея
- работаю в мм, это нормально
0
178 / 177 / 30
Регистрация: 11.10.2016
Сообщений: 567
04.11.2018, 21:02 17
Цитата Сообщение от Dimson_ Посмотреть сообщение
- тут проверяются уже все добавленные в массив шейпы?, или весь массив?
проверяются уже добавленные, поэтому и нет проверки пустой ли это элемент массива
Цитата Сообщение от Dimson_ Посмотреть сообщение
- это обязательно или можно просто "next"?
можно, конечно и просто next. Без параметра это просто "закрытие" последнего цикла
1
3 / 2 / 1
Регистрация: 02.11.2016
Сообщений: 110
17.12.2018, 06:42  [ТС] 18
Снова всем привет! Сейчас столкнулся с такой проблемой:
В одном модуле несколько процедур sub1(), sub2(), sub3 () и еще одна общая subFinal (), в нее я вызываю например sub1(), при помощи call, тут все понятно. Теперь мне нужно чтобы одна переменная типа массив (из sub1) оставалась в памяти и я мог обращаться к ней из subFinal () после выполнения call sub1().
Пробовал Public, Global вместо Dim в declaration - тогда ошибку пишет, не подскажите как это можно сделать?
Ошибка - out of range, значит переменная все таки сохранилась, но пустая что ли...
Этот массив в sub1() проходит через ReDim, не знаю, может в этом трабл...
Спасибо!
0
178 / 177 / 30
Регистрация: 11.10.2016
Сообщений: 567
17.12.2018, 10:18 19
для того, чтобы все процедуры видели массив - нужно его определить вне этих процедур.

'модуль
Dim Massiv() as long

Sub sub1()
End Sub

Sub Sub2
End Sub
...

Процедуры Sub1 и Sub2 получают доступ к массиву Massiv

Ошибка "out of range" - означает, что идет обращение к элементу массива вне диапазона, то есть, например определен массив из пяти элементов, а идет обращение к шестому элементу
1
3 / 2 / 1
Регистрация: 02.11.2016
Сообщений: 110
18.12.2018, 06:17  [ТС] 20
_shark, как все просто, спасибо!

Нашел способ, как реализовать проверку массива на одинаковые элементы, не знаю на сколько он правильный, но пока по всем тестам все правильно делает:


Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
 'Проверяемый массив - Arr(1 to 100, 1 to 5) ' первое измерение - это номер, второе: (1-3) - это объекты, (4) - копии, (5) - "флажок" 
 
    Dim g(100) As Integer
    
    For i = 1 To UBound(Arr)
    
        If i <> g(i) Then
        
        If Not IsEmpty(Arr(i, 2)) Then
 
        For j = 1 To UBound(Arr)
        If Not IsEmpty(Arr(j, 2)) Then
 
            If Round(Arr(i, 2).SizeWidth, 0) = Round(Arr(j, 2).SizeWidth, 0) And Round(Arr(i, 2).SizeHeight, 0) = Round(Arr(j, 2).SizeHeight, 0) Then
                If i <> j Then
                    Arr(i, 4) = Arr(i, 4) + Arr(j, 4)  'подсчитываю копии
                End If 
                    Arr(i, 5) = 1 ' "флажок" для следующего цикла, в котором добавляются только объекты с ним
                    g(j) = j 
            End If
        End If
        Next
        End If
        End If
    Next
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
18.12.2018, 06:17

Заказываю контрольные, курсовые, дипломные и любые другие студенческие работы здесь.

Shape.top в массив
у меня на форме много shape,нужно top каждого записать в массив,можно ли это сделать как то с...

Массивы компонентов билдера. Массив Shape и StringGrid
Доброго времени суток Товарищи! Подскажите мне пожалуйста как правильно записать массив из...

питон shape вернул массив без второго аргумента
import numpy as np def vvod(nameF): dta = np.genfromtxt(nameF) return dta X =...

Range в многомерный массив
Всем привет, есть массив, с числами, хочу сделать проверку, дабы проверить что бы растояние между...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
20
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2020, vBulletin Solutions, Inc.