Corel FORUM

[krnck]

Mam plik PDF (w załączniku), krzyżówka RGB.
1. Co zrobić aby po imporcie do corela było od razu CMYK?
2. Po imporcie krzyżówki do corela nie ma kropek, które są w prawym dolnym rogu (oznaczenie rozwiązania). Dlaczego tak jest?

---

A5.pdf

Pobierz Plik ściągnięto 296 raz(y) 58.13 KB

[chezare]

Otworzyć pdf z rgb w Corelu zapisać do pdfa w cmyk.

Dlaczego nie ma kropek nie mam pojęcia. U mnie po otwarciu w X3 nie ma nic :)
krzyżówka

[Martin Nez]

Pomóc powinien ten skrypt... Pisałem go na szybko i w menedżerze obiektów zostają jakieś nieodświeżone "śmieci"... Wystarczy zapisać i otworzyć od nowa plik, aby one zniknęły. Importować należy PDFa do Corela z zachowaniem tekstów jako... Teksty...

Kod:

Sub zamien()     Dim kolor As Color     Optimization = True     For i = 1 To ActivePage.Shapes.Count         ' zamiana wypełnienia na CMYK         If ActivePage.Shapes(i).Fill.UniformColor.Name = "Czarny" Then             ActivePage.Shapes(i).Fill.ApplyUniformFill CreateCMYKColor(0, 0, 0, 100)         ElseIf ActivePage.Shapes(i).Fill.UniformColor.Name = "Biały" Then             ActivePage.Shapes(i).Fill.ApplyUniformFill CreateCMYKColor(0, 0, 0, 0)         End If         ' zamiana konturu na CMYK         If ActivePage.Shapes(i).Outline.Color.Name = "Czarny" Then             ActivePage.Shapes(i).Outline.SetProperties Color:=CreateCMYKColor(0, 0, 0, 100)         ElseIf ActivePage.Shapes(i).Outline.Color.Name = "Biały" Then             ActivePage.Shapes(i).Outline.SetProperties Color:=CreateCMYKColor(0, 0, 0, 0)         End If         ' zamiana koloru fioletowych kratek         If ActivePage.Shapes(i).Fill.UniformColor.Type = cdrColorRGB And ActivePage.Shapes(i).Fill.UniformColor.Name = "unnamed color" Then             ActivePage.Shapes(i).Fill.UniformColor.ConvertToCMYK         End If         ' podmiana "pustych" znaków na kropki         If ActivePage.Shapes(i).Type = cdrTextShape Then             If ActivePage.Shapes(i).Text.Story.Font = "Wingdings" Then                 Dim pozx As Double                 Dim pozy As Double                 Dim rozmiar As Double                 ActivePage.Shapes(i).GetPosition pozx, pozy                 rozmiar = ActivePage.Shapes(i).Text.Story.size                 ActivePage.Shapes(i).Delete                 Dim tekst As Shape                 Set tekst = ActiveLayer.CreateArtisticText(pozx, pozy, "ź", cdrPolish, , "Wingdings", rozmiar, cdrFalse, cdrFalse, cdrNoFontLine, cdrLeftAlignment)             End If             'poniższą linię należy zakomentować (dodać ' na początku) jeśli nie chcesz zamieniać tekstu w krzywe             ActivePage.Shapes(i).ConvertToCurves         End If     Next     Optimization = False     ActiveWindow.Refresh End Sub

PS. Jeśli nie masz pojęcia co to jest zajrzyj tutaj.
Pozdr,
MN

[krnck]

Martin Nez,
Właśnie o to chodzi, tylko nie chcę zamieniać czcionek na krzywe.
Gdzie na początku mam dodać tą poniższą linię i czy to jest ta linia:
ActivePage.Shapes(i).ConvertToCurves

Czy było by jeszcze możliwe żeby był czarny zawsze nadrukowany?

Pozdrawiam

[Martin Nez]

Poprawiony kod:

Kod:

Sub zamien()     Dim kolor As Color     Optimization = True     For i = 1 To ActivePage.Shapes.Count         ' zamiana wypełnienia na CMYK         If ActivePage.Shapes(i).Fill.UniformColor.Name = "Czarny" Then             ActivePage.Shapes(i).Fill.ApplyUniformFill CreateCMYKColor(0, 0, 0, 100)             ActivePage.Shapes(i).OverprintFill = True         ElseIf ActivePage.Shapes(i).Fill.UniformColor.Name = "Biały" Then             ActivePage.Shapes(i).Fill.ApplyUniformFill CreateCMYKColor(0, 0, 0, 0)         End If         ' zamiana konturu na CMYK         If ActivePage.Shapes(i).Outline.Color.Name = "Czarny" Then             ActivePage.Shapes(i).Outline.SetProperties Color:=CreateCMYKColor(0, 0, 0, 100)             ActivePage.Shapes(i).OverprintOutline = True         ElseIf ActivePage.Shapes(i).Outline.Color.Name = "Biały" Then             ActivePage.Shapes(i).Outline.SetProperties Color:=CreateCMYKColor(0, 0, 0, 0)         End If         ' zamiana koloru fioletowych kratek         If ActivePage.Shapes(i).Fill.UniformColor.Type = cdrColorRGB And ActivePage.Shapes(i).Fill.UniformColor.Name = "unnamed color" Then             ActivePage.Shapes(i).Fill.UniformColor.ConvertToCMYK         End If         ' podmiana "pustych" znaków na kropki         If ActivePage.Shapes(i).Type = cdrTextShape Then             If ActivePage.Shapes(i).Text.Story.Font = "Wingdings" Then                 Dim pozx As Double                 Dim pozy As Double                 Dim rozmiar As Double                 ActivePage.Shapes(i).GetPosition pozx, pozy                 rozmiar = ActivePage.Shapes(i).Text.Story.size                 ActivePage.Shapes(i).Delete                 Dim tekst As Shape                 Set tekst = ActiveLayer.CreateArtisticText(pozx, pozy, "ź", cdrPolish, , "Wingdings", rozmiar, cdrFalse, cdrFalse, cdrNoFontLine, cdrLeftAlignment)             End If         End If     Next     Optimization = False     ActiveWindow.Refresh End Sub

Usunąłem zamianę na krzywe, dodałem nadrukowanie wypełnienia/konturu jeśli kolor jest czarny.

Pozdr,
MN

[krnck]

Martin Nez,
Teraz jest ok!

[krnck]

Witam znowu,
potrzebuję podobnego skryptu, ale w Corelu X6, bez podmiany na kropki.

[krnck]

Przesyłam załącznik.

---

krz.rar

Pobierz Plik ściągnięto 163 raz(y) 146.44 KB