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

mnemonix

mnemonix

ॐ मणि पद्मे हूँ
Топикстартер
Сообщения
997
Реакции
274
Подскажите, как сделать уровень CMYK8. Скрипт ИИ написал/переписывал, но не работает. Ошибок не выдаёт, как и результата.
Должно получиться так:

Скриншот 06.06.26_08.21.50.png


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
 

Вложения

  • Скриншот 06.06.26_08.16.15.png
    Скриншот 06.06.26_08.16.15.png
    14.6 КБ · Просм.: 19
Последнее редактирование:
mnemonix сказал(а):
Подскажите, как сделать уровень 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 сказал(а):
Если б я умел...
Нажмите, чтобы раскрыть...
Ну что ты , в самом деле...

Чтобы открыть редактор, нажмите ALT + F11 внутри CorelDRAW.
Главные инструменты отладки
F8 (Пошаговый шаг) — выполняет ровно одну строку кода.
F5 (Запуск) — запускает макрос до конца или до паузы.
Ctrl + Break — принудительно останавливает зависший цикл кода.
Точка останова (Breakpoint) — клик на левом поле строки кода. Код остановится на ней.
Окна для отслеживания данных
Immediate Window (Ctrl + G) — окно для вывода логов. Пишите Debug.Print переменная для проверки значений.
Locals Window — автоматически показывает все переменные в текущей процедуре и их значения.
Watch Window — позволяет следить за конкретным выражением или объектом Corel (например, ActiveShape.Fill).
 
Благодарю 'yes'. Ну я не так глубоко ныряю. По F8 всё проходит без сучка и задоринки, а результата нет. Потому и обратился.
 
mnemonix сказал(а):
Печать на фанере
Нажмите, чтобы раскрыть...
Надо полагать, что фанера сильно впитывает краску и вы хотите таким образом сделать оттиск плотнее?
По хорошему это делается профилированием, а не ручным исправлением кривых CMYK.
Чем печатаете?
 
dastin сказал(а):
вот это надо привести к виду (закомментировать)
'On Error Resume Next
и зажмуриться ...
Нажмите, чтобы раскрыть...
Чисто посмотреть какую ошибку выкинет?
Тогда все конструкции On Error... закомментить
 
Попробую)
 
Неа, чатгпт не справился пока.
 
Это делается через Bitmap.ApplyBitmapEffect. Но туда нужно передавать строку с параметрами. CorelDraw не записывает макрос, но в community пишут, что можно записать макрос в Corel Photo Paint и взять параметры от туда. Levels - это скорее всего "EqualizeEffect". Photo Paint у меня нет - проверить не могу.
 
  • Спасибо
Реакции: mnemonix
Here is the list I compiled and they seem to work just fine in 2018 I got them by recording them in PP and editing the script files and applying them in coreldraw. Enjoy!

'to get the settings for coreldraw record the process as a corelscript in photopaint then use those settings
'also when you see 5:255:255:255 or 3:0:0:0:100 The 5 reps RGB and 3 is CMYK the other numbers are the rgb or the cmyk levels

's.Bitmap.ApplyBitmapEffect "Plastic", "PlasticEffect Highlight=45,Depth=40,Smoothness=20,Direction=270,Tint=5:255:255:255" 'Works
's.Bitmap.ApplyBitmapEffect "Wind", "WindEffect WindStrength=66,WindOpacitiy=100,WindAngle=135" 'works
's.Bitmap.ApplyBitmapEffect "Watercolor", "WatercolorEffect Size=8,Detail=14,Water=89,Bleed=69,Brightness=14" 'Works
's.Bitmap.ApplyBitmapEffect "Gaussian Blur", "GaussianBlurEffect GaussianBlurRadius=800,GaussianBlurResampled=0"
's.Bitmap.ApplyBitmapEffect "Smooth", "SmoothEffect SmoothPercentage=100" 'Works
's.Bitmap.ApplyBitmapEffect "3D Rotate", "3DRotateEffect 3DRotateHorizontal=32,3DRotateVertical=-28,3DRotateFace=0,3DRotateBestFit=1,3DRotateBckgndClr=5:255:255:255" 'Works
's.Bitmap.ApplyBitmapEffect "3-D Stereo Noise", "3DStereoNoiseEffect StereoNoiseDepth=8,StereoNoiseShowDots=1" 'Works
's.Bitmap.ApplyBitmapEffect "Bit Planes", "BitPlanesEffect BPlanesLevel=0,BPlanesRed=7,BPlanesGreen=4,BPlanesBlue=5" 'Works
's.Bitmap.ApplyBitmapEffect "Adaptive Unsharp", "AdaptiveUnsharpEffect AUnsharpLevel=99" 'Works
's.Bitmap.ApplyBitmapEffect "Pixelate", "PixelateEffect PixelateMode=0,PixelateWidth=10,PixelateHeight=10,PixelateOpacity=61,PixelateCenterX=1271,PixelateCenterY=150" 'Works Radius mode= 2 Square = 0 Rect = 1
's.Bitmap.ApplyBitmapEffect "Add Noise", "AddNoiseEffect AddNoiseType=2,AddNoiseColorMode=2,AddNoiseLevel=96,AddNoiseDensity=88,AddNoiseColor=5:255:255:255" 'Works type is (Gaussian = 0 Spike = 1 Uniform = 2) Color Mode is(intensity = 0 Random = 1 single = 2)
's.Bitmap.ApplyBitmapEffect "Band Pass", "BandPassEffect BandPassInWeight=30,BandPassMidWeight=30" 'Works kind of
's.Bitmap.ApplyBitmapEffect "Brick Wall", "BrickWallEffect Roughness=25,Width=60,Height=20,GroutWidth=5,Direction=105" 'Works Direction is light source
's.Bitmap.ApplyBitmapEffect "Bubbles", "BubblesEffect Diameter=47,Coverage=91,Refraction=1,Direction=126" 'Works
's.Bitmap.ApplyBitmapEffect "Charcoal", "CharcoalEffect Size=7,Edge=6" 'Works differently than in photopaint
's.Bitmap.ApplyBitmapEffect "Cobblestone", "CobblestoneEffect CobblestoneRoughness=6,CobblestoneSize=6,CobblestoneGroutWidth=9,CobblestoneDirection=281,CobblestoneWarp=1" 'Works
's.Bitmap.ApplyBitmapEffect "Cobblestone", "CobbleStoneEffect Size=2,GroutWidth=5,Roughness=6,Direction=281,Warp=1" 'Works
's.Bitmap.ApplyBitmapEffect "Conte Crayon", "ConteCrayonEffect ConteColor=0,Intensity=80,Texture=0,PaperColor=5:233:233:215" 'Works but works better in PP
's.Bitmap.ApplyBitmapEffect "Crayon", "CrayonEffect Detail=7,Edge=48" 'Works
's.Bitmap.ApplyBitmapEffect "Crystalize", "CrystalizeEffect Size=5" 'Works But works differently in PP
's.Bitmap.ApplyBitmapEffect "Cubist", "CubistEffect Size=5,Brightness=32,Color=5:0:0:0" 'Works
's.Bitmap.ApplyBitmapEffect "Cylinder", "CylinderEffect MapCylinderObjectPercent=79,MapCylinderObjectMode=0" 'Works mode Horiz=0 and vert = 1
's.Bitmap.ApplyBitmapEffect "Dabble", "DabbleEffect DabbleDistribution=20,DabbleStyle=2,DabbleSize=3" 'Works
's.Bitmap.ApplyBitmapEffect "Diffuse", "DiffuseEffect DiffuseLevel=80" 'works
's.Bitmap.ApplyBitmapEffect "Directional Sharpen", "DirectionalSharpenEffect DirectionalSharpenLevel=6" 'Works very subtle
's.Bitmap.ApplyBitmapEffect "DirectionalSmooth", "DirectionalSmoothEffect DirectionalSmoothPercentage=100" 'Works but very subtle
's.Bitmap.ApplyBitmapEffect "DustScratch", "DustScratchEffect DustScratchLevel=150,DustScratchRadius=4" 'Works
's.Bitmap.ApplyBitmapEffect "EdgeDetect", "EdgeDetectEffect EdgeDetectSensitivity=8,EdgeDetectColorModel=5,EdgeDetectColor1=63,EdgeDetectColor2=97,EdgeDetectColor3=204,EdgeDetectColor4" 'Works
's.Bitmap.ApplyBitmapEffect "ElephantSkin", "ElephantSkinEffect ElephantSkinAge=80,ElephantSkinVariation=20,ElephantSkinType=1,ElephantSkinComp1=10,ElephantSkinComp2=10,ElephantSkinComp3=10,ElephantSkinComp4=80" 'Works
's.Bitmap.ApplyBitmapEffect "Emboss", "EmbossEffect EmbossDepth=8,EmbossLevel=150,EmbossAngle=61,EmbossColor=0,EmbossCS=5:242:195:8" 'Works
's.Bitmap.ApplyBitmapEffect "Etching", "EtchingEffect Detail=92,Depth=50,Direction=275,SurfaceTint=5:255:200:0" 'Works
's.Bitmap.ApplyBitmapEffect "Fabric", "FabricEffect Style=4,Size=21,Percent=67,Brightness=20,Angle=90" 'works style NeedPt=0 rug hook = 1 quilt =2 str=3 rib=4 tissue=5
's.Bitmap.ApplyBitmapEffect "FindEdges", "FindEdgesEffect FindEdgesLevel=80,FindEdgesEdgeType=0" 'Works
's.Bitmap.ApplyBitmapEffect "GlassBlock", "GlassBlockEffect GlassBlockWidth=50,GlassBlockHeight=15" 'Works
's.Bitmap.ApplyBitmapEffect "Halftone", "HalftoneEffect HalftoneRadius=3,HalftoneCyan=100,HalftoneMagenta=85,HalftoneYellow=300,HalftoneBlack=100" 'Works
's.Bitmap.ApplyBitmapEffect "HighPass", "HighPassEffect HighPassRadius=2,HighPassPercentage=100" 'Works
's.Bitmap.ApplyBitmapEffect "Impressionist", "ImpressionistEffect ImpressionistStyle=2,ImpressionistDetail=90,ImpressionistColoration=50,ImpressionistBrightness=45" 'Works
's.Bitmap.ApplyBitmapEffect "JaggyDespeckle", "JaggyDespeckleEffect JaggyDespeckleWidth=5,JaggyDespeckleHeight=1" 'Works
's.Bitmap.ApplyBitmapEffect "Local Equalization", "LocalEqualizeEffect LocalHistWidth=51,LocalHistHeight=51,LocalHistSquare=1" 'Works
's.Bitmap.ApplyBitmapEffect "LowPass", "LowPassEffect LowPassRadius=1,LowPassPercentage=10" 'works'
's.Bitmap.ApplyBitmapEffect "Maximum", "MaximumEffect MaximumRadius=1,MaximumPercentage=5" 'Works
's.Bitmap.ApplyBitmapEffect "Median", "MedianEffect MedianRadius=10,MedianPercentage=25" 'Works
's.Bitmap.ApplyBitmapEffect "Minimum", "MinimumEffect MinimumRadius=5,MinimumPercentage=5" 'Works
's.Bitmap.ApplyBitmapEffect "Motion Blur", "MotionBlurEffect MotionBlurDistance=39,MotionBlurDirection=76,MotionBlurOffImageSampling=0,MotionBlurPaperColor=5:255:255:255" 'Works
's.Bitmap.ApplyBitmapEffect "Page Curl", "PageCurlEffect PageCurlDir=1,PageCurlWidth=50,PageCurlHeight=50,PageCurlCorner=2,PageCurlOpaque=0,PageCurlCurlColor=5:127:127:127,PageCurlBackground=5:255:255:255" 'Works
's.Bitmap.ApplyBitmapEffect "PaletteKnife", "PaletteKnifeEffect PaletteKnifeBladeSize=10,PaletteKnifeSoftEdge=5,PaletteKnifeAngle=90" 'Works
's.Bitmap.ApplyBitmapEffect "Pastels", "PastelsEffect PastelsType=2,PastelsSize=5,PastelsHue=30" 'Works
's.Bitmap.ApplyBitmapEffect "PenInk", "PenInkEffect PenInkMode=1,PenInkDensity=40,PenInkInk=10" 'Works CrossHatch = 0 stippling = 1
's.Bitmap.ApplyBitmapEffect "Pinch/Punch", "PinchPunchEffect PinchPunch=-82,PinchPunchCenterX=1271,PinchPunchCenterY=150" 'Works
's.Bitmap.ApplyBitmapEffect "PlasterWall", "PlasterWallEffect PlasterWallDetail=30,PlasterWallVariation=80,PlasterWallBrightness=95" 'Works
's.Bitmap.ApplyBitmapEffect "Pointillist", "PointillistEffect PointillistSize=50,PointillistBrightness=50" 'Works
's.Bitmap.ApplyBitmapEffect "Psychedelic", "PsychedelicEffect PsychedelicLevel=11" 'Works
's.Bitmap.ApplyBitmapEffect "Radial Blur", "RadialBlurEffect RadialBlurAmount=11,RadialBlurCenterX=1271,RadialBlurCenterY=150,RadialBlurQuality=1" 'Works
's.Bitmap.ApplyBitmapEffect "Relief Sculpture", "ReliefSculptureEffect Depth=35,Detail=3,Smoothness=15,Direction=315,SurfaceTint=5:242:183:8" 'Works
's.Bitmap.ApplyBitmapEffect "Ripple", "RippleEffect RipplePeriod=90,RippleAmplitude=90,RippleAngle=45,RippleDistort=True,RippleMode=1" 'Works
's.Bitmap.ApplyBitmapEffect "Scatter", "ScatterEffect ScatterHorizontal=50,ScatterVertical=50" 'Works
's.Bitmap.ApplyBitmapEffect "Scraperboard", "ScraperboardEffect ScraperboardStyle=0,ScraperboardDensity=25,ScraperboardSize=5" 'Works
's.Bitmap.ApplyBitmapEffect "Screen Door", "ScreenDoorEffect Color=0,Size=21,Soft=47,Angle=62" 'Works Color is either BW=0 or Color =1 Angle is the Brightness
's.Bitmap.ApplyBitmapEffect "Sharpen", "SharpenEffect SharpenLevel=62,SharpenThreshold=17,SharpenPreserveColor=0" 'Works Preserve is either 0/false or 1/true
's.Bitmap.ApplyBitmapEffect "Sketch Pad", "SketchPadEffect SketchPadPencilType=1,SketchPadStyle=12,SketchPadLeadPressure=79,SketchPadOutline=60" 'Works PencilType is 0 for Graphite and 1 for color
's.Bitmap.ApplyBitmapEffect "Smoked Glass", "SmokedGlassEffect SmokedGlassTint=13,SmokedGlassPercent=62,SmokedGlassColor=5:140:133:133" 'Works
's.Bitmap.ApplyBitmapEffect "Smooth", "SmoothEffect SmoothPercentage=10" 'Works
's.Bitmap.ApplyBitmapEffect "Soften", "SoftenEffect SoftenPercentage=5" 'Works
's.Bitmap.ApplyBitmapEffect "Solarize", "SolarizeEffect SolarizeLevel=200" 'Works
's.Bitmap.ApplyBitmapEffect "Sphere", "SphereEffect SpherePercentage=85,SphereCenterX=1271,SphereCenterY=150,SphereLowQuality=0" 'Works Quality is Speed = 0 or quality =1 which is slower but a better effect
's.Bitmap.ApplyBitmapEffect "Stained Glass", "StainedGlassEffect BorderColor=5:150:150:150,Size=7,Thickness=5,LightIntensity=2,3DLighting=1" 'Works 3dlighting 0 for false and 1 for true
's.Bitmap.ApplyBitmapEffect "Stone", "StoneEffect StoneRoughness=50,StoneDetail=100,StoneInvert=False,StoneDirection=315" 'Works
 
  • Спасибо
Реакции: mnemonix
С Corel Photo Paint не работаю, но попробую. Да, макрос не записывается.
Если не получится, то всем выделенным битмапам разом можно задать эффект.
Пришёл пока к самому простому доступному методу - выделить все битмапы и вытащил кнопку "Levels" на панель, жмёшь и проставляешь 8.
 
Скриншот 07.06.26_09.35.55.png
 
Установить не проблема.
 
Дорогой @mnemonix, объясни, пожалуйста, зачем тебе это? Очень хочется понять.
С надеждой на понятный подробный ответ.
 
  • Спасибо
Реакции: Emergency
Значит так - много файлов, цель одна - напечатать с заданными условиями и порезать (новый заказчик, обтравку и пр. опускаем, там уже всё автоматизировано). А я лентяй, вкалывают роботы - счастлив человек. Ну и производительность повышаем)) Как-то так, разлюбезный ~RA~
 
Последнее редактирование:
  • Спасибо
Реакции: ~RA~
Для ответа нужно войти/зарегистрироваться
Верх Низ
Назад