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

Массив из shape range

06.10.2018, 07:09. Просмотров 682. Ответов 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
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
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.top в массив
у меня на форме много shape,нужно top каждого записать в массив,можно ли это сделать как то с...

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

28
Dimson_
3 / 2 / 1
Регистрация: 02.11.2016
Сообщений: 69
08.10.2018, 20:14  [ТС] 2
Поэкспериментировал, вот так оказывается нужно было сделать:
Visual Basic
1
2
Dim ar() As Object
ReDim ar(1 To so.Count, 1 To 3)
0
_shark
171 / 171 / 29
Регистрация: 11.10.2016
Сообщений: 542
15.10.2018, 12:23 3
как вариант, можно сделать три ShapeRange-а s, so, d и обращаться к их элементам по одному индексу: s(4), so(4), d(4). Получится что-то типа трех динамических массивов.
1
Dimson_
3 / 2 / 1
Регистрация: 02.11.2016
Сообщений: 69
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
_shark
171 / 171 / 29
Регистрация: 11.10.2016
Сообщений: 542
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
Dimson_
3 / 2 / 1
Регистрация: 02.11.2016
Сообщений: 69
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
_shark
171 / 171 / 29
Регистрация: 11.10.2016
Сообщений: 542
18.10.2018, 09:42 7
попробуйте написать count = 1 сразу после первого next. В этом случае по выходу из первого цикла счетчик станет равным единице. Кроме того, счетчик у вас сначала записывается в arr2, а потом уже сбрасывается
1
Dimson_
3 / 2 / 1
Регистрация: 02.11.2016
Сообщений: 69
19.10.2018, 10:36  [ТС] 8
_shark, отлично!, спасибо Вам большое!
0
Dimson_
3 / 2 / 1
Регистрация: 02.11.2016
Сообщений: 69
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
_shark
171 / 171 / 29
Регистрация: 11.10.2016
Сообщений: 542
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
Dimson_
3 / 2 / 1
Регистрация: 02.11.2016
Сообщений: 69
30.10.2018, 06:30  [ТС] 11
Нет, так тоже не работает, интересно, что не так. Мне по сути нужно, чтобы одинаковые объекты(размер) из первого shaperange не добавлялись в массив или другой shaperange
0
_shark
171 / 171 / 29
Регистрация: 11.10.2016
Сообщений: 542
30.10.2018, 19:45 12
у вас, по сути, все шейпы сравниваются с первым элементом и если они ему не равны, то заносятся в массив
1
Dimson_
3 / 2 / 1
Регистрация: 02.11.2016
Сообщений: 69
31.10.2018, 08:18  [ТС] 13
Оказывается не правильно сравнивал, у объектов может быть одинаковый размер у одной из сторон, по этому в массив и не записывался. Сравниваю через Curve.Length, тут вроде все хорошо!
Спасибо!
0
Dimson_
3 / 2 / 1
Регистрация: 02.11.2016
Сообщений: 69
01.11.2018, 10:15  [ТС] 14
Цитата Сообщение от _shark Посмотреть сообщение
все шейпы сравниваются с первым элементом
- точно, все правильно, так не пойдет
Не подскажите, как можно решить эту задачу?
0
_shark
171 / 171 / 29
Регистрация: 11.10.2016
Сообщений: 542
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
Dimson_
3 / 2 / 1
Регистрация: 02.11.2016
Сообщений: 69
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
_shark
171 / 171 / 29
Регистрация: 11.10.2016
Сообщений: 542
04.11.2018, 21:02 17
Цитата Сообщение от Dimson_ Посмотреть сообщение
- тут проверяются уже все добавленные в массив шейпы?, или весь массив?
проверяются уже добавленные, поэтому и нет проверки пустой ли это элемент массива
Цитата Сообщение от Dimson_ Посмотреть сообщение
- это обязательно или можно просто "next"?
можно, конечно и просто next. Без параметра это просто "закрытие" последнего цикла
1
Dimson_
3 / 2 / 1
Регистрация: 02.11.2016
Сообщений: 69
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
_shark
171 / 171 / 29
Регистрация: 11.10.2016
Сообщений: 542
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
Dimson_
3 / 2 / 1
Регистрация: 02.11.2016
Сообщений: 69
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
18.12.2018, 06:17
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
18.12.2018, 06:17

Массивы компонентов билдера. Массив 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 - 2019, vBulletin Solutions, Inc.
Рейтинг@Mail.ru