| |
Corel FORUM
Forum użytkowników programów firmy Corel. Grafika wektorowa, rastrowa i obróbka zdjęć cyfrowych |
 |
CorelDRAW - grafika wektorowa - Import pdf RGB do CMYK, eksport bez kropek
krnck - 3 Luty 2011, 00:26
Temat postu: Import pdf RGB do CMYK, eksport bez kropek
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?
chezare - 3 Luty 2011, 01:30
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 - 3 Luty 2011, 02:55
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 - 3 Luty 2011, 10:08
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 - 3 Luty 2011, 10:32
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 - 3 Luty 2011, 11:17
Martin Nez,
Teraz jest ok!
krnck - 6 Sierpień 2013, 10:02
Witam znowu,
potrzebuję podobnego skryptu, ale w Corelu X6, bez podmiany na kropki.
krnck - 6 Sierpień 2013, 10:05
Przesyłam załącznik.
|
|