Fountain to bitmap in powerclip

[grzjanik]

Hello everyone.

I need something like this:

1. Duplicate the curve in the same place.


2. Put the original to Powerclip and enlarge the curve about 1 mm.


3. Fountain Set by steps to 999.


4. Contents Powerclip converts the bitmap (CMYK, 300 dpi).


5. Exit from Powerclip.


I just have to replace all marked Fountains or the entire document.

Sometimes the need to replace all the complicated fountains to bitmaps because of differences Corel <> Adobe.

Thank you very much for your help.

Best Regards.

~GrzJanik

[grzjanik]

Hello members of Oberon.

I managed to do something like this:

Sub GradientToPowerclip()

ActiveDocument.Unit = cdrMillimeter
Dim x As Double, y As Double
Dim OrigSelection As ShapeRange
Set OrigSelection = ActiveSelectionRange
Dim s1 As Shape
Dim dup1 As ShapeRange
Set dup1 = OrigSelection.Duplicate()
OrigSelection.AddToPowerClip dup1(1)
dup1.ApplyNoFill
dup1(1).PowerClip.EnterEditMode
Dim s2 As Shape
Set s2 = OrigSelection.ConvertToBitmapEx(cdrCMYKColorImage, False, False, 300, cdrNormalAntiAliasing, True)
ActiveDocument.ReferencePoint = cdrCenter
OrigSelection.GetPosition x, y
s2.Stretch 1.02, 1.02
Dim s3 As Shape
Set s3 = s2.ConvertToBitmapEx(cdrCMYKColorImage, False, False, 300, cdrNormalAntiAliasing, True)
dup1(1).PowerClip.LeaveEditMode

End Sub

I can not clean up the code. I am a beginner in VBA. But it works.

I can not just do this change would affect all the selected gradients, or all throughout the document (in powerclips also).

Please send me an hint.

Regards.
~GrzJanik

[grzjanik]

Now the code looks like this:

Sub GradientToPowerclipWithFountain()

ActiveDocument.Unit = cdrMillimeter
Dim x As Double, y As Double
Dim OrigSelection As ShapeRange
Set OrigSelection = ActiveSelectionRange
Dim s1 As Shape
Dim dup1 As ShapeRange
Set dup1 = OrigSelection.Duplicate()
ActiveSelection.Fill.Fountain.Steps = 999
OrigSelection.AddToPowerClip dup1(1)
dup1.ApplyNoFill
dup1(1).PowerClip.EnterEditMode
Dim s2 As Shape

Set s2 = OrigSelection.ConvertToBitmapEx(cdrCMYKColorImage, False, False, 300, cdrNormalAntiAliasing, True)
ActiveDocument.ReferencePoint = cdrCenter
OrigSelection.GetPosition x, y
s2.Stretch 1.02, 1.02
Dim s3 As Shape
Set s3 = s2.ConvertToBitmapEx(cdrCMYKColorImage, False, False, 300, cdrNormalAntiAliasing, True)
dup1(1).PowerClip.LeaveEditMode

End Sub

Works and changes the fountain steps on 999!

How to do it throughout the document?

Yours beginner.
~GrzJanik

[grzjanik]

Unfortunately, it works but not always correctly.

[grzjanik]

It is a pity that no one attempted to solve the problem.

I think that either too difficult or for some reason active users do not like me (although I do not know why).

[shark]

Hi.
You could use loop For Each/Next to check all shapes on the page.
Then call your sub to process curve.
Something like...

Dim s As Shape
For Each s In ActivePage.FindShapes()
If (s.Type = cdrCurveShape) and (s.Fill.Type = cdrFountainFill) Then
GradientToPowerclipWithFountain(s)
End If
Next s

Sub GradientToPowerclipWithFountain(ByRef s as Shape)
...
replace old shape by new shape
...
End Sub