Скрипт для Corel (преобразования цветов)

[hatrix]

Столкнулся с проблемой такого рода - есть этикетки со штрих-кодом. Размер штрих-кода на этикетке 20х7 мм. Всё бы ничего, но при печати на ухабе c353p с использованием цветопрофиля линии в штрих-коде становятся слишком жирными и считывание того самого штрих-кода проходит не с первого раза, в общем народ мучается. Это плохо. Связано это с тем, что при конверсии цветов цвет линий в штрих-коде из 100% черного преобразуется в составной. Проблему пока решаю таким образом, небольшой скрипт по преобразованию цветов

Sub ColorCorrect()
Dim OrigSelection As ShapeRange
Set OrigSelection = ActiveSelectionRange
ActiveDocument.ConvertToColorContext CreateColorContext2("ColorPlus,KONICA MINOLTA C353 PS_4CC_280_CMYK.icm,Dot Gain 20%", BlendingColorModel:=clrColorModelCMYK)
ActiveDocument.AssignColorContext CreateColorContext2("ColorPlus,Coated FOGRA39 (ISO 12647-2:2004),Dot Gain 20%", BlendingColorModel:=clrColorModelCMYK)
End Sub

Далее запускаю скрипт ColorReplacer, лежит тут ColorReplacer.zip, и выполняю замену составного получившегося черного обратно в К-100%
Можно через штатные средства Corel Find&Replace, но так еще дольше по времени.
Поставил себе задачу сделать скрипт чтобы одновременно преобразовывал конверсию цветов и искал в макете все векторные объекты с черной составной заливкой и применял им К-100%. Но, поковырявшись в нем, понял, что сам не осилю. В общем, камрады, прошу помощи! Можете кинуть в меня умной книжкой или парой строчек кода, ну или еще чего-нибудь..)

[Леша]

а если пойти таким путем EDIT / find and replace/ replace object/ replace color/ и меняете составной на черный

[hatrix]

Ну да, только долго это, да еще и по каждой странице придется отдельно пройтись, причем два раза - для заливок и для обводок. Кстати, тот скрипт что по ссылке лежит, предлагает работать сразу с заливками и с обводками, только вот с обводками почему-то не справляется, где-то там тоже ошибка вкралась. И я её уж точно не найду - мозги не хватит)

[Xromov]

А изначально черный в RGB как G:0 чтоли задан?

[hatrix]

Нет, цвет изначально задан как C - 0, M - 0, Y - 0, K - 100
После цветокоррекции - C - 32, M - 20, Y - 15, K - 85
Вот его нужно вернуть в исходное значение.
Кстати, если цвет задан как G:0, то проблем не возникает. Как вариант, можно сначала поменять везде К100 на G:0, а потом выполнить цветокоррекцию, но для этого все равно нужно писать скрипт (макрос). Кажись так даже лучше будет. Спасибо за идею)

[d_Serg]

Сообщение от hatrix

Нет, цвет изначально задан как C - 0, M - 0, Y - 0, K - 100
После цветокоррекции - C - 32, M - 20, Y - 15, K - 85
Вот его нужно вернуть в исходное значение.

В Питстопе это делается за 3 клика мышью

[hatrix]

Сообщение от d_Serg

В Питстопе это делается за 3 клика мышью

Ага, а питстоп для акробата
А я хочу в кореле, и за один клик.
Вот что-то получилось, вроде делает что надо, но только если объекты "сами по себе". Теперь надо думать как сделать чтобы залазил в сгруппированные объекты и в паверклипы.

Sub ColorCorrect()
Dim sh As Shape
Dim cnt As Integer
Dim findcolor As Color, replacecolor As Color
Dim p As Page, pActive As Page

Set findcolor = CreateCMYKColor(0, 0, 0, 100)
Set replacecolor = CreateGrayColor(0)

Set pActive = ActivePage
For Each p In ActiveDocument.Pages
p.Activate
For Each sh In ActiveDocument.ActivePage.Shapes
If sh.Fill.Type = cdrUniformFill Then
If sh.Fill.UniformColor.IsSame(findcolor) Then
sh.Fill.UniformColor = replacecolor
cnt = cnt + 1
End If
End If

If sh.Outline.Type = cdrOutline Then
If sh.Outline.Color.IsSame(findcolor) Then
sh.Outline.Color = replacecolor
cnt = cnt + 1
End If
End If
Next sh
Next p

pActive.Activate

ActiveDocument.ConvertToColorContext CreateColorContext2("ColorPlus,KONICA MINOLTA C353 PS_4CC_280_CMYK.icm,Dot Gain 20%", BlendingColorModel:=clrColorModelCMYK)
ActiveDocument.AssignColorContext CreateColorContext2("ColorPlus,Coated FOGRA39 (ISO 12647-2:2004),Dot Gain 20%", BlendingColorModel:=clrColorModelCMYK)

End Sub

[d_Serg]

Сообщение от hatrix

А я хочу в кореле, и за один клик.

да ради бога... чего тогда спрашиваете А если Вам завтра заказчик верстку в Люстре принесет.... а послезавтра в Ворде - и для них будете скрипты делать? в этом плане Питстоп универсальнее
Хотя, конечно, дело вкуса....

[hatrix]

Сообщение от d_Serg

чего тогда спрашиваете

Дык не шарю потому что
Печатаю в основном из корела, большинство макетов все же в нем достается. А люстру и ворд - в пдф, а тут уже и питстоп. Вам конечно за внимание к проблеме тоже спасибо! Поставлю-ка я вам тоже плюсик, а то не люблю когда люди нервничать начинают по пустякам)

[Xromov]

Всем бы так не шарить! Я только одного не понял - зачем крутится cnt

[hatrix]

можно удалить, это количество пройденных циклов, потом можно окошко выкинуть сколько объектов поменялось, но думаю это лишнее..

[hatrix]

Есть прогресс - макрос теперь умеет залазить в первый уровень паверклипа и там менять. Роем дальше..

[hatrix]

Ну всё. Вроде готово. Ищет в сгруппированных объектах и в паверклипах. Количество паверклипов и вложений друг в друга неограничено, с группами, соответственно, аналогично. Если кому не лень, затестите у себя, вдруг где ругнется или чего не сделает... Та часть, где конверсит цвета в профиль, можно удалить или свои профиля вписать, она в самом конце, предпоследние 2 строчки.

Sub ColorCorrect()

Dim findcolor, replacecolor As color
Dim p, pActive As Page
Dim ArAll, Ar1, Ar2 As ShapeRange
Dim x As Shape

ActiveDocument.PreserveSelection = False
Optimization = True
EventsEnabled = False

Set findcolor = CreateCMYKColor(0, 0, 0, 100)
Set replacecolor = CreateGrayColor(0)
Set pActive = ActivePage

For Each p In ActiveDocument.Pages
p.Activate
Set Ar1 = p.FindShapes
If Not Ar1 Is Nothing Then
Set ArAll = Ar1
Do
Set Ar2 = Nothing
For Each x In Ar1
If Not x.PowerClip Is Nothing Then
If Ar2 Is Nothing Then Set Ar2 = x.PowerClip.Shapes.FindShapes Else: Ar2.AddRange x.PowerClip.Shapes.FindShapes
End If
Next x
If Not Ar2 Is Nothing Then
Set Ar1 = Ar2
ArAll.AddRange Ar1
End If
Loop While Not Ar2 Is Nothing
End If

For Each x In ArAll
If x.Fill.UniformColor.IsSame(findcolor) Then x.Fill.UniformColor = replacecolor
If x.Outline.color.IsSame(findcolor) Then x.Outline.color = replacecolor
Next x
Next p

pActive.Activate

EventsEnabled = True
Optimization = False
ActiveDocument.PreserveSelection = True
ActiveDocument.EndCommandGroup

ActiveDocument.ConvertToColorContext CreateColorContext2("ColorPlus,KONICA MINOLTA C353 PS_4CC_280_CMYK.icm,Dot Gain 20%", BlendingColorModel:=clrColorModelCMYK)
ActiveDocument.AssignColorContext CreateColorContext2("ColorPlus,Coated FOGRA39 (ISO 12647-2:2004),Dot Gain 20%", BlendingColorModel:=clrColorModelCMYK)

End Sub

[hatrix]

Да, забыл сказать, конверсия в профиль будет работать в X6-ом, и скорее всего в Х5-м, в Х4 - уже не пашет. Остальная часть должна быть рабочей в версиях не ниже ХЗ.

[hatrix]

Макрос переделан заново, теперь всё работает как надо. На этом остановлюсь.
Если кому вдруг пригодится, то

Sub ColorCorrect()

Dim findcolor, replacecolor As color
Dim p, pActive As Page

ActiveDocument.PreserveSelection = False
Optimization = True
EventsEnabled = False

Set findcolor = CreateCMYKColor(0, 0, 0, 100)
Set replacecolor = CreateGrayColor(0)
Set pActive = ActivePage

For Each p In ActiveDocument.Pages
p.Activate
ColorCorrectItem p, findcolor, replacecolor
Next p

pActive.Activate

EventsEnabled = True
Optimization = False
ActiveDocument.PreserveSelection = True
ActiveDocument.EndCommandGroup

ActiveDocument.ConvertToColorContext CreateColorContext2("ColorPlus,KONICA MINOLTA C353 PS_4CC_280_CMYK.icm,Dot Gain 20%", BlendingColorModel:=clrColorModelCMYK)
ActiveDocument.AssignColorContext CreateColorContext2("ColorPlus,Coated FOGRA39 (ISO 12647-2:2004),Dot Gain 20%", BlendingColorModel:=clrColorModelCMYK)

End Sub

Sub ColorCorrectItem(obj, col1, col2)
Dim s As Shape
For Each s In obj.Shapes
If Not s.PowerClip Is Nothing Then
ColorCorrectItem s.PowerClip, col1, col2
If s.Fill.UniformColor.IsSame(col1) Then s.Fill.UniformColor = col2
If s.Outline.color.IsSame(col1) Then s.Outline.color = col2
Else
If cdrGroupShape = s.Type Then
ColorCorrectItem s, col1, col2
Else
If s.Fill.UniformColor.IsSame(col1) Then s.Fill.UniformColor = col2
If s.Outline.color.IsSame(col1) Then s.Outline.color = col2
End If
End If
Next s
End Sub

[Сега]

На самом деле огромное спасибо за проделанный труд, вот у меня никогда не хватало терпения или желания разобраться, как корел все это делает, в смысле макросы. Иногда, когда уж сильно припрет, лез разбираться ... как непохоже на обычное программирование... Но вот что самое интересное, это делать преобразования по всему файлу, по всем слоям и свойствам. Короче взял, буду учиться ) плюсую обязательно. )

[hatrix]

Ну спасибо ведь не только мне, люди тоже помогали, Xromov вон на гениальную мысль натолкнул с G:0. Так что коллективный разум решает

[Леша]

Молодец! добился чего хотел