[CDR 2024] Скрипт для установки CMYK 8

[mnemonix]

Подскажите, как сделать уровень CMYK8. Скрипт ИИ написал/переписывал, но не работает. Ошибок не выдаёт, как и результата.
Должно получиться так:

Sub ApplyLevels_64bit_Version()
Dim p As Page
Dim s As Shape

' Работаем на активной странице
Set p = ActivePage

' Отключаем обновление экрана
Optimization = True

' Запускаем рекурсивную функцию обработки для всех объектов
ProcessShapes p.Shapes

Optimization = False
ActiveWindow.Refresh
MsgBox "Готово! Все изображения на странице обработаны.", vbInformation
End Sub

' Рекурсивная процедура для захода внутрь групп и PowerClip
Private Sub ProcessShapes(ss As Shapes)
Dim s As Shape

For Each s In ss
If s.Type = cdrBitmapShape Then
' 1. Применяем конвертацию в CMYK для 64-битной версии
s.Bitmap.ConvertTo cdrCMYKColorImage

' 2. Используем метод принудительного изменения через параметры эффекта
' Для 64-бит версии лучше всего работает вызов свойств через .Parameters
On Error Resume Next
Dim eff As Effect
Set eff = s.Bitmap.Effects.Add(cdrLevelsEffect)

If Not eff Is Nothing Then
eff.Parameters("Black").Value = 8
eff.Parameters("White").Value = 255
eff.Parameters("Gamma").Value = 1#
eff.Apply
' Завершаем (запекаем)
s.Bitmap.Effects.Commit
End If
On Error GoTo 0

ElseIf s.Type = cdrGroupShape Or s.Type = cdrTextShape Then
' Если это группа, заходим внутрь рекурсивно
ProcessShapes s.Shapes
ElseIf s.Type = cdrPowerClipFrame Then
' Если это PowerClip, заходим внутрь
ProcessShapes s.PowerClip.Shapes
End If
Next s
End Sub

 

[Андрей Викторов]

как сделать уровень CMYK8.

Не по теме:

Для себя спрошу: это для чего нужно, как это используется?

 

[_MBK_]

Подскажите, как сделать уровень CMYK8. Скрипт ИИ написал/переписывал, но не работает. Ошибок не выдаёт, как и результата.
Должно получиться так:

Посмотреть вложение 181187

Sub ApplyLevels_64bit_Version()
Dim p As Page
Dim s As Shape

' Работаем на активной странице
Set p = ActivePage

' Отключаем обновление экрана
Optimization = True

' Запускаем рекурсивную функцию обработки для всех объектов
ProcessShapes p.Shapes

Optimization = False
ActiveWindow.Refresh
MsgBox "Готово! Все изображения на странице обработаны.", vbInformation
End Sub

' Рекурсивная процедура для захода внутрь групп и PowerClip
Private Sub ProcessShapes(ss As Shapes)
Dim s As Shape

For Each s In ss
If s.Type = cdrBitmapShape Then
' 1. Применяем конвертацию в CMYK для 64-битной версии
s.Bitmap.ConvertTo cdrCMYKColorImage

' 2. Используем метод принудительного изменения через параметры эффекта
' Для 64-бит версии лучше всего работает вызов свойств через .Parameters
On Error Resume Next
Dim eff As Effect
Set eff = s.Bitmap.Effects.Add(cdrLevelsEffect)

If Not eff Is Nothing Then
eff.Parameters("Black").Value = 8
eff.Parameters("White").Value = 255
eff.Parameters("Gamma").Value = 1#
eff.Apply
' Завершаем (запекаем)
s.Bitmap.Effects.Commit
End If
On Error GoTo 0

ElseIf s.Type = cdrGroupShape Or s.Type = cdrTextShape Then
' Если это группа, заходим внутрь рекурсивно
ProcessShapes s.Shapes
ElseIf s.Type = cdrPowerClipFrame Then
' Если это PowerClip, заходим внутрь
ProcessShapes s.PowerClip.Shapes
End If
Next s
End Sub

В отладчик VBA зайди да посмотри что не так.

 

[mnemonix]

отладчик VBA

Если б я умел...

как это используется?

Печать на фанере, потом лазерная резка.

 

[_MBK_]

Если б я умел...

Ну что ты , в самом деле...

Чтобы открыть редактор, нажмите ALT + F11 внутри CorelDRAW.
Главные инструменты отладки
F8 (Пошаговый шаг) — выполняет ровно одну строку кода.
F5 (Запуск) — запускает макрос до конца или до паузы.
Ctrl + Break — принудительно останавливает зависший цикл кода.
Точка останова (Breakpoint) — клик на левом поле строки кода. Код остановится на ней.
Окна для отслеживания данных
Immediate Window (Ctrl + G) — окно для вывода логов. Пишите Debug.Print переменная для проверки значений.
Locals Window — автоматически показывает все переменные в текущей процедуре и их значения.
Watch Window — позволяет следить за конкретным выражением или объектом Corel (например, ActiveShape.Fill).

 

[mnemonix]

Благодарю . Ну я не так глубоко ныряю. По F8 всё проходит без сучка и задоринки, а результата нет. Потому и обратился.

 

[dastin]

On Error Resume Next

вот это надо привести к виду (закомментировать)
'On Error Resume Next
и зажмуриться ...

 

[Emergency]

Печать на фанере

Надо полагать, что фанера сильно впитывает краску и вы хотите таким образом сделать оттиск плотнее?
По хорошему это делается профилированием, а не ручным исправлением кривых CMYK.
Чем печатаете?

 

[_MBK_]

вот это надо привести к виду (закомментировать)
'On Error Resume Next
и зажмуриться ...

Чисто посмотреть какую ошибку выкинет?
Тогда все конструкции On Error... закомментить