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

  • Автор темы Автор темы tohaa
  • Дата начала Дата начала
tohaa сказал(а):
Даже пытаться не буду
Нажмите, чтобы раскрыть...
Это не конкретно про вас :)
tohaa сказал(а):
чтобы получить совет и подсказку и сделать самостоятельно
Нажмите, чтобы раскрыть...
Ваше право, просто не обращайте внимания, такие "полезные" советы неизбежны, поэтому в том разделе и закрыты комментарии.
 
Пойти заказать кому-то вместо того, чтобы сделать самому, потому что вопрос не понравился и лень или вообще неинтересно дальше помогать, в данном случае.
 
Я, простите, не большой "макросодел", еще по Адобовским "Action" туда-сюда, но!
Неужели "двоечку"
"SelectAll
Simplify"
Так трудно запрограммировать макросами?
 
tohaa сказал(а):
Даже пытаться не буду. Я создал тему в автоматизации, чтобы получить совет и подсказку и сделать самостоятельно.
Нажмите, чтобы раскрыть...
Как правило, если "подскажите" не работает, то "научите как" – задача более сложная, чем "сделайте"

Не по теме:

А если что-то надо объяснять,
То ничего не надо объяснять.
А если всё же стоит объяснить,
То ничего не стоит объяснить.
(с) М.Щербаков

 
пробегаемся по элементам смотрим кто с кем стыкуется тупо по "квадрату" выделения. и потом пошел по очереди по списку пары между собой тримить. ) в целом прикольный алгоритм надо будет себе такую кнопочку забабахать в панель ) нечто подобное у меня уже есть для вырезания дырок в макетах от горе-полиграфистов, которые любят отверстия делать белыми объектами сверху )). но упрощение каждого с каждым думаю тож прикольная штука.
 
Да делали когда то такое, по моему, как бы не Санчес?
 
Application.FrameWork.Automation.Invoke "7da36c72-627c-4782-b51a-01718a43551b" 'Simpify
 
  • Спасибо
Реакции: mnemonix, DukereD и tohaa
lev сказал(а):
Application.FrameWork.Automation.Invoke "7da36c72-627c-4782-b51a-01718a43551b" 'Simpify
Нажмите, чтобы раскрыть...
Вот это дело! Но есть Нюанс. Объекты упрощать всеже нужно попарно, т.к. корел очень часто лепит какую-то чушь при упрощении нескольких объектов одновременно.
 
DukereD сказал(а):
а чем этот Invoke отличается от s.Trim(s2, true, true)
тоже самое попарно перебрать и он упростит.
Нажмите, чтобы раскрыть...
Код: 
Sub RIs()
    Dim sr As ShapeRange
    Dim peresech As shape
    Dim i As Integer, j As Integer

    
    Set sr = ActiveSelectionRange
    
  
    For i = 1 To sr.Count - 1
        For j = i + 1 To sr.Count
            Set peresech = sr(i).intersect(sr(j))
            
            
            If Not peresech Is Nothing Then
                Application.FrameWork.Automation.Invoke "7da36c72-627c-4782-b51a-01718a43551b" 'Simpify
            End If
            
            Set peresech = Nothing
        Next j
    Next i
    
    Set sr = Nothing
End Sub

Помогите что я делаю не так? нахожу пересечение. если оно есть пытаюсь упростить.
 
внимательно смотрите за руками ...
вот вы сделали Set peresech = sr(i).intersect(sr(j))
ваше пересечение стало активным - выделилось
сколько потом его не упрощай - проще оно не станет. Нет?
Вы же хотите sr упростить? Это раз.
А во-вторых - полученный intersect никуда не делся. Его надо трансклюкировать.

вот- подкрашенное - испытайте


Код: 
Sub RIs()
    Dim sr As ShapeRange
    Dim peresech As Shape
    Dim i As Integer, j As Integer

    
    Set sr = ActiveSelectionRange
    
 
    For i = 1 To sr.Count - 1
        For j = i + 1 To sr.Count
            Set peresech = sr(i).Intersect(sr(j))
            
            
            If Not peresech Is Nothing Then
            sr.CreateSelection
                Application.FrameWork.Automation.Invoke "7da36c72-627c-4782-b51a-01718a43551b" 'Simpify
            End If
            peresech.Delete
'            Set peresech = Nothing
        Next j
    Next i
    
'    Set sr = Nothing
End Sub
 
  • Спасибо
Реакции: mnemonix и tohaa
dastin сказал(а):
внимательно смотрите за руками ...
вот вы сделали Set peresech = sr(i).intersect(sr(j))
ваше пересечение стало активным - выделилось
сколько потом его не упрощай - проще оно не станет. Нет?
Вы же хотите sr упростить? Это раз.
А во-вторых - полученный intersect никуда не делся. Его надо трансклюкировать.

вот- подкрашенное - испытайте


Код: 
Sub RIs()
    Dim sr As ShapeRange
    Dim peresech As Shape
    Dim i As Integer, j As Integer

   
    Set sr = ActiveSelectionRange
   
 
    For i = 1 To sr.Count - 1
        For j = i + 1 To sr.Count
            Set peresech = sr(i).Intersect(sr(j))
           
           
            If Not peresech Is Nothing Then
            sr.CreateSelection
                Application.FrameWork.Automation.Invoke "7da36c72-627c-4782-b51a-01718a43551b" 'Simpify
            End If
            peresech.Delete
'            Set peresech = Nothing
        Next j
    Next i
   
'    Set sr = Nothing
End Sub
Нажмите, чтобы раскрыть...
Ну надо же! забыл про выделение! спасибо
 
1685189063719.png
Работает только с простыми объектами. Как только попадается кривая сложнее или например текст в кривых - сбой(
 
не ... так лучше, но работает не до конца
и peresech.Delete даёт ошибку
вернем Set peresech = Nothing
 
и с простыми объектами выходит винегрет
1685189387118.png
 
Для ответа нужно войти/зарегистрироваться
Верх Низ