Кольца и т.п.

[One_more_user]

День добрый господа!
Не так давно встала проблема обработки и экспорта большого количества объектов из корела в pcx. Помогите, пожалуйста, написать макрос Делать он должен вот что. У меня есть 3 группы объектов. 1 - просто полосочки на равном расстоянии друг от друга, 2 - кольца увеличивающегося диаметра, 3 - такие же кольца, но немного меньшего диаметра, чем предыдущие. Немного запутанно, согласен. Ссылка на файл внизу. Вот что я делаю. Беру кольцо сверху, опускаю его на полосочки, жму Intersect Target, получаю объект пересечения - полоски, обрезанные по кругу. Этот файлик экспортирую в pcx, потом беру второй кружок меньшего диаметра чем первый, переношу на полоски и жму Trim Target. Получаю "дырку в полосках". Затем процесс повторяется пока не закончатся колечки. То есть мне нужно нарезать мои полоски на такие вот сегменты. Сегменты получаются с небольшим перекрытием, поэтому кольца которые делают пересечение немного больше тех, которые отрезают. Не подумайте что я из секты какой-нить, это такие необычные макеты для гравировки одного изделия... Я записывал макрос по этапам, смотрел что меняется, хотел сам разобраться... Вроде более менее понятно, но есть нюансы) Вот например строка выбора кольца и его перемещения на полоски:
ActivePage.Layers("Layer 2").Shapes(1).Move 0#, -10.23622
Я так понимаю Shapes(1) - это номер кольца. Но кольца почему-то идут не по-порядку, цифра один для самого маленького, для второго по размеру это почему-то кольцо с номером 3, потом № 2, потом № 29. Почему номера этих колец идут не по порядку? Как сделать чтоб шли по-порядку? =) И вообще, я 1й раз пытаюсь писать макросы в кореле, может кто что посоветует?
Заранее благодарю за помощь! Готов за написанный макрос помочь чем смогу - разбираюсь в лазерах, занимаюсь лазерной гравировкой, кто в Питере - велком)))

http://narod.ru/disk/44528664001.e236582a72cf84d048e05a5422eab69d/Help.cdr.html

 

[_MBK_]

Ответ: Срочно нужна помощь с макросом...

Почему номера этих колец идут не по порядку? Как сделать чтоб шли по-порядку

Естественно, будут идти не по порядку - вы же их не упорядочивали по размеру?
По идее, вам надо взять массив Shapes и упорядочить его по диаметру.

 

[One_more_user]

Ответ: Срочно нужна помощь с макросом...

А если я не сильно разбираюсь в макросах, и немного не понятно где взять этот массив, и как его упорядочить, вас не затруднит адаптировать тот кусочек кода для моей задачи? Если бы у меня был макрос, который эти элементы отсортирует, я бы дальше наверно смог дописать макрос который будет по очереди брать элементы и делать все что нужно (Trim, ...)

 

[_MBK_]

Ответ: Срочно нужна помощь с макросом...

Где взять этот массив

В том куске кода это есть, к примеру:

Set gb = ActivePage.FindShapes(, cdrEllipseShape)

вернет массив из всех шейпов, которые кружочки. Затем их можно упорядочивать по размеру, если в функции collStuffSorted заменить PositionX на OriginalWidth

 

[One_more_user]

Ответ: Срочно нужна помощь с макросом...

Я тут накопипастил вот такой код:

Sub Sort()
ActiveDocument.Unit = cdrMillimeter
Dim s As Shape
Set gb = ActivePage.FindShapes(, cdrEllipseShape)
Dim coll As Collection: Set coll = New Collection

For Each s In gb
collStuffSorted coll, s, -1
Next

End Sub

Function collStuffSorted&(coll As Collection, sh As Shape, ByVal Direction&)

Dim a&, b&, C&, rel&
a = 1: b = coll.Count: C = 0: rel = 0
Dim key0 As Double: key0 = sh.OriginalWidth
Do While b - a >= 0
C = (a + b) \ 2: rel = (key0 - coll(C).OriginalWidth) * Direction
Select Case rel
Case Is < 0: If C = a Then Exit Do Else b = C
Case 0: Exit Do
Case Is > 0: If b = a Then Exit Do Else If a = C Then a = b Else a = C
End Select
Loop
If C = 0 Then coll.Add sh Else If rel = -1 Then coll.Add s, , C Else coll.Add s, , , C

End Function

Компилятор выдает ошибку в строке "C = (a + b) \ 2: rel = (key0 - coll(C).OriginalWidth) * Direction" говорит мол "Run-time Error '424', Object required"... Он не нашел объектов, я правильно понимаю? Отладить пытаюсь набросав десяток окружностей разного диаметра. OriginalWidth даст именно сортировку по диаметру, или по толщине линий (немного смущает слово width...)? И еще один нюанс. В задаче, которую мне надо решить не совсем окружности. Объекты вверху - половинки окружности, и к тому же, долго объяснять зачем так сделано, но у меня там объект окружность с маленькими квадратиками по углам. Каждый обект имеет одинаковые размеры, кот. определяются положением квадратиков (для всех половинок они в одном и том же месте), а во внутренней области окружности разного размера. То есть для всех окружностей+квадраты габариты одинаковые - 250х250 мм. Как объяснить макросу что нужно отсортировать и эти объекты тоже? Может использовать как параметр для сортировки не диаметр, а периметр кривой? На что тогда нужно заменить PositionX?

Сорри за столько вопросов, и спасибо вам за помощь! 'Beer'

 

[_MBK_]

Ответ: Срочно нужна помощь с макросом...

Учите доки, они - рулез! (с) Не ленитесь жать F1 и F2 в Visual Basic editor - большая часть вопросов решится сама.
OriginalWidth - это именно ширина объекта. То же самое можно получить через RightX-LeftX

но у меня там объект окружность с маленькими квадратиками по углам.

Непонятно. Это группа (окружность и квадратики) или такая специальная комбинированная фигура из бывшей окружности с выступающими углами? В любом случае, это уже, действительно , не окружность, и искать ее через cdrEllipseShape , бессмысленно. Искать нужно, получается, все объекты (я так понимаю, cdrCurveShape), однако, потом вам придется фильтровать их, способ фильтровки я слабо себе представляю из вашего объяснения. То же самое касается критерия упорядочивания. По чем их упорядочивать, если размеры одинаковые и при чем здесь периметр?

If C = 0 Then coll.Add sh Else If rel = -1 Then coll.Add s, , C Else coll.Add s, , , C

Ой, совсем забыл, разгильдяй wOxxOm тут ошибку пропустил (я сам даже как-то нарвался) Конечно же

If C = 0 Then coll.Add sh Else If rel = -1 Then coll.Add sh, , C Else coll.Add sh, , , C

Тогда и Runtime Error уйдет. Вообще, учитесь пользоваться отладчиком, если бы в нем внимательно посмотрели, то увидели бы, что идет обращение за границу массива coll

 

[One_more_user]

Ответ: Срочно нужна помощь с макросом...

По чем их упорядочивать, если размеры одинаковые и при чем здесь периметр?

У этих объектов одинаковые габариты. Квадратики по углам одинаковые (в плане размера и местоположения) для всех таких объектов, а вот окружности разные. То есть получается имеем пол окружности диаметром 10 мм + квадратики, потом пол окружности диаметром 15 мм + такие же квадратики, ... У каждой такой фигуры разный периметр (пол окружности + квадратики), но одинаковые габариты (квадраты на одном и том же месте - справа вверху и слева внизу, габариты 250х250 мм).

Что нужно написать вместо PositionX, чтоб сортировать по периметру?

 

[_MBK_]

Ответ: Срочно нужна помощь с макросом...

Что нужно написать вместо PositionX, чтоб сортировать по периметру?

.Curve.Length

 

[One_more_user]

Ответ: Кольца и т.п.

Sub Sort()ActiveDocument.Unit = cdrMillimeter
Dim s As Shape
Set gb = ActivePage.FindShapes(, cdrCurveShape)
Dim coll As Collection: Set coll = New Collection


For Each s In gb
collStuffSorted coll, s, -1
Next


ActiveLayer.Shapes(4).Move 200#, 0#


End Sub




Function collStuffSorted&(coll As Collection, sh As Shape, ByVal Direction&)


ActiveLayer.Shapes(4).Move 50#, 50#


Dim a&, b&, C&, rel&
a = 1: b = coll.Count: C = 0: rel = 0
Dim key0 As Double: key0 = sh.Curve.Length
Do While b - a >= 0
C = (a + b) \ 2: rel = (key0 - coll(C).Curve.Length) * Direction
Select Case rel
Case Is < 0: If C = a Then Exit Do Else b = C
Case 0: Exit Do
Case Is > 0: If b = a Then Exit Do Else If a = C Then a = b Else a = C
End Select
Loop
If C = 0 Then coll.Add sh Else If rel = -1 Then coll.Add sh, , C Else coll.Add sh, , , C


End Function

Код сейчас вот так выглядит. Сортировки не происходит... Я внутри функции поставил "ActiveLayer.Shapes(4).Move 50#, 50#" Чтобы видеть что программа заходит в функцию, и выполняет ее. Но этот объект не двигается. Он сдвигается только один раз на 200 мм (в основном теле программы "ActiveLayer.Shapes(4).Move 200#, 0#"). Где ошибочка закралась?

В функцию "collStuffSorted" передаются параметры "coll, s, -1". В том примере говориться что "-1" это направление сортировки. Что это значит? Перебор объектов с последнего к первому? И еще немного нелепый вопрос. Каким методом здесь происходит сортировка?

 

[_MBK_]

Ответ: Кольца и т.п.

Сортировки не происходит..

Ну правильно, вы же сортируете массив coll, а проверяете ActiveLayer.Shapes

Чтобы видеть что программа заходит в функцию,

Опять же, учите матчасть! Чтобы определить что программа заходит в функцию и отрабатывает ее есть дебагер - в редакторе жмете F8 или Ctrl F8 или Shift F8

Каким методом здесь происходит сортировка?

Насколько я понял - метод простого включения с двоичным поиском.
http://citforum.ru/programming/theory/sorting/sorting1.shtml

 

[One_more_user]

Ответ: Кольца и т.п.

Ну правильно, вы же сортируете массив coll, а проверяете ActiveLayer.Shapes

Не понял Что нужно сделать сделать чтоб сортировка происходила и окружности встали на свои места?

По F8 указатель после строчки "For Each s In gb" перепрыгивает сразу на "ActiveLayer.Shapes(4).Move 200#, 0#", и потом на "End Sub" - программа отработала пропустив обращение к функции... Я просто не знаком с ВБА, писал на С++/VC++, для микроконтроллеров писал на С, а тут синтаксис совсем незнаком, вот и не могу понять что к чему...

 

[_MBK_]

Ответ: Кольца и т.п.

У вас отсортированные значения должны заполнять массив coll.
По правой кнопке мыши Add Watch - показывает значение для переменной. Судя по всему у вас gb пустой. Не пойму, как такое может быть. Хотите, выбросьте вообще findShapes, а сразу делайте перебор элементов не gb, а ActiveLayer.Shapes - в вашем случае это то же самое.
Синтаксис с C++ очень схож и отладка тоже.

 

[One_more_user]

Ответ: Кольца и т.п.

Выдает ошибку в строке "key0 = sh.Curve.Length" говорит что "Object is of incorrect type for this operarion"

 

[_MBK_]

Ответ: Кольца и т.п.

Ну может быть попался какой нибудь шейп, у которого нет границы или незамкнутый? Посмотрите значение sh через Watch, а так же значения его свойств Curve и Curve.Length
Не пойму, вы же программист, как вы сишные программы отлаживаете?

 

[One_more_user]

Ответ: Кольца и т.п.

Была глупая ошибка - объекты были не в кривых... Заработало с "Set gb = ActiveLayer.FindShapes(, cdrCurveShape)", он нашел 7 шейпов (все правильно у меня как раз 7 окружностей), но сортировки массива все равно не происходит Окружности как стояли не по порядку, так и стоят...

Я не совсем программист по образованию физик, и с программированием сталкивался решая не очень сложные задачи (численное моделирование, простенькие windows forms, ...), в которых имея под рукой книги можно более менее за приемлемое время разобраться, а тут надо завтра, и времени чето совсем мало =(

 

[_MBK_]

Ответ: Кольца и т.п.

Ну ту тоже все элементарно - F1-F2 лучше всяких книг
То есть, по выходу из процедуры сортировки коллекция coll все равно не упорядочена? Вы точно проверили?

 

[One_more_user]

Ответ: Кольца и т.п.

То есть, по выходу из процедуры сортировки коллекция coll все равно не упорядочена? Вы точно проверили?

Да, проверил. В этой коллекции 7 элементов, если посмотреть Curve->Length то длинна у них разная, и по этой длине элементы не упорядочены...

 

[One_more_user]

Ответ: Кольца и т.п.

Итоговый код выглядит так:

Sub Sort()
ActiveDocument.Unit = cdrMillimeter
Dim s As Shape

Set gb = ActiveLayer.FindShapes(, cdrCurveShape)
Dim coll As Collection: Set coll = New Collection

For Each s In gb
collStuffSorted coll, s, -1
Next s

End Sub

Function collStuffSorted&(coll As Collection, sh As Shape, ByVal Direction&)

Dim a&, b&, C&, rel&
a = 1: b = coll.Count: C = 0: rel = 0
Dim key0 As Double: key0 = sh.Curve.Length
Do While b - a >= 0
C = (a + b) \ 2: rel = (key0 - coll(C).Curve.Length) * Direction
Select Case rel
Case Is < 0: If C = a Then Exit Do Else b = C
Case 0: Exit Do
Case Is > 0: If b = a Then Exit Do Else If a = C Then a = b Else a = C
End Select
Loop
If C = 0 Then coll.Add sh Else If rel = -1 Then coll.Add sh, , C Else coll.Add sh, , , C

End Function

 

[_MBK_]

Ответ: Кольца и т.п.

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

If C = 0 Then coll.Add sh Else If rel <0 Then coll.Add sh, , C Else coll.Add sh, , , C

 

[One_more_user]

Ответ: Кольца и т.п.

Да, сейчас заработало - элементы отсортированы по убыванию длины. Как мне теперь эту коллекцию "применить" к объектам в документе? coll отсортирована правильно, а вот окружности (Object Manager->Layer 1) идут в том порядке в котором они "появились" в документе, с ними после выполнения макроса ничего не произошло...