[CDR 2025] Поиск и выбор похожих элементов

NemoSUN

Топикстартер
15 лет на форуме
Сообщения
234
Реакции
0
Возникла необходимость выделить треугольники и точки после импорта чертежа с AutoCAD. Нашёл на форуме в истории скрипт SelectSame.gms. Но при запуске поиска появляется ошибка :
Безымянный.png

Есть ли работающие скрипты под 16 или 25 или другие методы.
 
Закомментируйте две строки начиная с выделенной
 
  • Спасибо
Реакции: zollinger
CorelScript это старый class из 2013 года.
судя по коду, он разрешает вам выделить объекты на всех слоях страницы.
можете вместо всего блока IF... Endif написать
set shpsToTest =ActivePage.SelectableShapes.All
 
что интересно, то по запросу "SelectSame.gms" находит ветку с точно такой же проблемой ))

ну и не упущу возможность...

 
  • Спасибо
Реакции: NemoSUN и mnemonix
Закомментируйте две строки начиная с выделенной
Удалил.
вместо всего блока IF... Endif написал
set shpsToTest =ActivePage.SelectableShapes.All
Далее ругается на "CorelScript.RedrawScreen".
0.png
Но! В Corel X6(x64) этот макрос работает )
 
Для начала закомментить все строки, где встречается CorelScript. С большой долей вероятности будет работать. Если не заработает, посмотреть аналоги этих функций из современных версий
 
Последнее редактирование:
Мегамозг предложил
Код:
Option Explicit

Sub FixedMacro()
    Dim oScript As Object
    
    If AcrossLayers Then
        ' Попытка использовать CorelScript (совместимость)
        On Error Resume Next
        Set oScript = Application.CorelScript
        If Not oScript Is Nothing Then
            oScript.SetMultiLayer True
        Else
            ' Современный подход для 2025
            ActiveDocument.Selection.FindShapes.ReplaceAllAcrossLayers = True
        End If
        On Error GoTo 0
    End If
    
    ' Продолжение вашего кода...
End Sub
 
  • Спасибо
Реакции: NemoSUN
  • Спасибо
Реакции: NemoSUN и zollinger
Jeff select same не хватает возможности указать допуск, по размеру, например. Если нужно выбрать "маленькие объекты" и их много, то некоторая дополнительная головная боль. Но лучше чем ничего
 
Мегамозг предложил
Код:
Option Explicit

Sub FixedMacro()
    Dim oScript As Object
   
    If AcrossLayers Then
        ' Попытка использовать CorelScript (совместимость)
        On Error Resume Next
        Set oScript = Application.CorelScript
        If Not oScript Is Nothing Then
            oScript.SetMultiLayer True
        Else
            ' Современный подход для 2025
            ActiveDocument.Selection.FindShapes.ReplaceAllAcrossLayers = True
        End If
        On Error GoTo 0
    End If
   
    ' Продолжение вашего кода...
End Sub
Вставил код. Вот, что получилось:

123.png
Вот, что пишет.
 

Вложения

  • Спасибо
Реакции: zollinger
... и вообще - зачем ковырять засохшее ... нет чтобы скачать обновленный макрос

Посмотреть вложение 174984
О да! В 25 версии работает ) Но установщики (JH_SelectSame_2020.exe и JH_SelectSame_ver3_X5-2019.exe) не видят 25 версию. Только 16. Но и ладно. Главное, что макрос работает.
 
О да! В 25 версии работает ) Но установщики (JH_SelectSame_2020.exe и JH_SelectSame_ver3_X5-2019.exe) не видят 25 версию. Только 16. Но и ладно. Главное, что макрос работает.
он не ставится через установщик, я тоже попробовал, и он развалился, выдав странную ошибку. Там они и сами рекомендуют не установщиком пользоваться, а скопировать JH_SelectSame_3_international.gms в C:\Program Files\Corel\CorelDRAW Graphics Suite 2020\Draw\GMS. По крайней мере, в 2020 после этого всё отлично работает
 
Правильно заданный вопрос был завуалирован просьбой об исправлении ошибки. 'opa!)'
Хотя, человек вроде бы и искал.
В любом случае, огонь! Забрал, так, на всякий случай