[CDR 2017-2021] Эффект Упрощение с помощью макроса.

tohaa

Участник
Топикстартер
Сообщения
229
Реакции
8
Здравствуйте.
В выделении несколько наложенных друг на друга. частично перекрывающихся, объектов.
Как с помощью макроса выполнить упрощение этих объектов? Упрощение- подгонка пересекающихся частей объектов.
 

qsedftghk

фея
15 лет на форуме
Сообщения
2 028
Реакции
1 197
имхо, с такими запросами тему нужно создавать здесь
 

_MBK_

Пикирующий бомбардировщик
15 лет на форуме
Сообщения
33 138
Реакции
10 835

_MBK_

Пикирующий бомбардировщик
15 лет на форуме
Сообщения
33 138
Реакции
10 835
Дык чем логические операции с обьектами не устраивают (trim, intersect,...) ?
 

~RA~

Одарённая.
12 лет на форуме
Сообщения
11 808
Реакции
3 434
Интересно, зачем это вам? Для последующей печати это не нужно, а если вырезать, то такие обрезки потом ровно не наклеишь.
 

tohaa

Участник
Топикстартер
Сообщения
229
Реакции
8
Интересно, зачем это вам? Для последующей печати это не нужно, а если вырезать, то такие обрезки потом ровно не наклеишь.
Задача удалить все перекрывающиеся части. Конечно это лишь часть макроса. Далее объединение по цветам, их подпись, добавление обводок и т.д.
 

eugeny

15 лет на форуме
Сообщения
855
Реакции
210
Покажите, как вы обрезаете -- код, вроде там все просто:

Код:
Dim s1 As Shape
    Set s1 = ActiveDocument.CreateShapeRangeFromArray(ActiveLayer.Shapes(2), ActiveLayer.Shapes(1)).ConvertToBitmapEx(4, False, True, 0, 1, True, False, 95)
    Dim s2 As Shape
    Set s2 = ActiveLayer.Shapes(1).Trim(s1, True, True)
    s1.Delete
 

_MBK_

Пикирующий бомбардировщик
15 лет на форуме
Сообщения
33 138
Реакции
10 835
С помощью intersect нахожу перекрытие и создаю объект, а вот обрезка этим объектом не получается.
А вы обрезайте не перекрытием а верхним обьектом.
По сути весь алгоритм - высчитывается иерархия перекрывающихся обьектов, затем последовательно верхние вычитаются из нижних
 

garvey

Участник
Сообщения
142
Реакции
44
А вы обрезайте не перекрытием а верхним обьектом.
По сути весь алгоритм - высчитывается иерархия перекрывающихся обьектов, затем последовательно верхние вычитаются из нижних
"Все со всеми"?
во первых, нужно проверять на непустоту,
а во вторых, результаты тоже могут пересекаться.
т.е. результат тоже нужно "упрощать", выбрасывая "пустые", пока не будут одни "пустые "результаты.
 

_MBK_

Пикирующий бомбардировщик
15 лет на форуме
Сообщения
33 138
Реакции
10 835
"Все со всеми"?
во первых, нужно проверять на непустоту,
а во вторых, результаты тоже могут пересекаться.
т.е. результат тоже нужно "упрощать", выбрасывая "пустые", пока не будут одни "пустые "результаты.
Сперва определить пересекающиеся. Но, в самом начале, при построении графа, да, таки все со всеми, тормозить будет ужасно.
 

tohaa

Участник
Топикстартер
Сообщения
229
Реакции
8
Сперва определить пересекающиеся. Но, в самом начале, при построении графа, да, таки все со всеми, тормозить будет ужасно.
А можно как-то запускать горячую клавишу с эффектом упрощения при переборе объектов?
 

_MBK_

Пикирующий бомбардировщик
15 лет на форуме
Сообщения
33 138
Реакции
10 835
В смысле - можно ли повесить макрос на горячую клавишу? Можно.
 

_MBK_

Пикирующий бомбардировщик
15 лет на форуме
Сообщения
33 138
Реакции
10 835

dastin

Некромант-любитель
12 лет на форуме
Сообщения
2 131
Реакции
2 027
или иначе ...
Для затравки
Код:
#If VBA7 Then
Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
#Else
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
#End If

Option Explicit

Function ShiftKey() As Boolean
    ShiftKey = (GetAsyncKeyState(vbKeyShift) And &H8000)
End Function

И далее в коде ...
Код:
    If ShiftKey Then
...
    Else
...
    End If