OberonPlace.com Forums  

Go Back   OberonPlace.com Forums > Corel User Forums > CorelDRAW > Macros/Add-ons

Reply
 
Thread Tools Search this Thread Display Modes
  #1  
Old 15-06-2011, 03:57
grzjanik grzjanik is offline
Member
 
Join Date: Mar 2010
Location: Lodz, Poland
Posts: 86
Send a message via Skype™ to grzjanik
Default Fountain to bitmap in powerclip

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
Reply With Quote
  #2  
Old 07-07-2011, 03:12
grzjanik grzjanik is offline
Member
 
Join Date: Mar 2010
Location: Lodz, Poland
Posts: 86
Send a message via Skype™ to grzjanik
Default Half of success :)

Hello members of Oberon.

I managed to do something like this:

Quote:
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
Reply With Quote
  #3  
Old 07-07-2011, 03:56
grzjanik grzjanik is offline
Member
 
Join Date: Mar 2010
Location: Lodz, Poland
Posts: 86
Send a message via Skype™ to grzjanik
Default Add Fountain 999 :)

Now the code looks like this:

Quote:
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
Reply With Quote
  #4  
Old 25-08-2011, 02:56
grzjanik grzjanik is offline
Member
 
Join Date: Mar 2010
Location: Lodz, Poland
Posts: 86
Send a message via Skype™ to grzjanik
Default Unfortunately

Unfortunately, it works but not always correctly.
Reply With Quote
  #5  
Old 25-08-2011, 03:09
grzjanik grzjanik is offline
Member
 
Join Date: Mar 2010
Location: Lodz, Poland
Posts: 86
Send a message via Skype™ to grzjanik
Default Help

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).
Reply With Quote
  #6  
Old 29-08-2011, 12:14
shark shark is offline
Senior Member
 
Join Date: Aug 2010
Location: Russia, Belgorod
Posts: 146
Default

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
Reply With Quote
Reply

Tags
adobe, bitmap, corel, fountain, powerclip


Currently Active Users Viewing This Thread: 2 (0 members and 2 guests)
 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off

Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
CQL does not find shapes in PowerClip aakkaarr CorelDRAW/Corel DESIGNER VBA 3 11-05-2011 17:44
Rotation and PowerClip Craig Tucker CorelDRAW/Corel DESIGNER VBA 3 23-08-2007 16:31
How to convert transparencies to bitmap in nested powerclip designhouse CorelDRAW/Corel DESIGNER VBA 2 29-04-2007 03:07
powerclip extract zaum CorelDRAW/Corel DESIGNER VBA 2 26-10-2005 07:26
[BUG] - Fountain fill is'nt rotate in powerclip Kursad General 3 01-07-2005 21:01


All times are GMT -5. The time now is 19:09.


Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
Copyright © 2011, Oberonplace.com