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, 04: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, 04: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, 04: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, 03: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, 04: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, 13:14
shark shark is offline
Senior Member
 
Join Date: Aug 2010
Location: Russia, Belgorod
Posts: 145
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
  #7  
Old 29-08-2011, 13:33
grzjanik grzjanik is offline
Member
 
Join Date: Mar 2010
Location: Lodz, Poland
Posts: 86
Send a message via Skype™ to grzjanik
Default

Hi Shark.

Thank you for your reply.

I will try to use your idea.
Write to know about the effects of my work.

I'm still a beginner so little I know and not everything goes to me.
Any help and useful idea to me.

Soon I will write what I did or a failure.

Thank you for your help.
I greet all the help.

~GrzJanik
Reply With Quote
  #8  
Old 30-08-2011, 00:25
shelbym's Avatar
shelbym shelbym is offline
Senior Member
 
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,769
Blog Entries: 9
Send a message via ICQ to shelbym Send a message via AIM to shelbym Send a message via MSN to shelbym Send a message via Yahoo to shelbym
Default Gradient to Powerclip

You did not say which version of CorelDRAW you are using, this code will only work on X4 and above as I use CQL to find the shapes with a fountain fill. Also, this code will only convert the ActivePage, if you want to do all pages in a document you would need to add another loop. Hope it helps:
Code:
Sub GradientToPowerclip()
    Const dblEnlarge = 1
    Dim s As Shape, sDup As Shape
    Dim sr As ShapeRange
    
    ActiveDocument.ReferencePoint = cdrCenter 'Set reference point to the center
    ActiveDocument.Unit = cdrMillimeter 'Set our unit to millimeters
    
    Set sr = ActivePage.Shapes.FindShapes(Query:="@fill.type = 'fountain'") 'Find all shapes with fountain fills
    
    For Each s In sr.Shapes 'Loop thtough all the shapes found
        Set sDup = s.Duplicate 'Make a duplicate
        sDup.SetSize s.SizeWidth + dblEnlarge, s.SizeHeight + dblEnlarge 'Increase the size by our Constant
        sDup.Fill.Fountain.Steps = 999 'Set fountain fill steps to 999
        sDup.Outline.SetNoOutline 'Remove outline from duplice
        Set sDup = sDup.ConvertToBitmapEx(cdrCMYKColorImage, False, False, 300, cdrNormalAntiAliasing, True) 'Convert to Bitmap
        s.Fill.ApplyNoFill 'Remove fill from original shape
        sDup.AddToPowerClip s 'Place the bitmap in the orginal shape
    Next s
End Sub
-Shelby
Reply With Quote
  #9  
Old 02-09-2011, 04:58
grzjanik grzjanik is offline
Member
 
Join Date: Mar 2010
Location: Lodz, Poland
Posts: 86
Send a message via Skype™ to grzjanik
Default Corel 12

Hello.
Shelby thanks for your help and sorry for the inadvertence.
Unfortunately, works on CorelDraw v.12.
I'll check your code on Monday and write if it works.
Thanks again and best regards.
~GrzJanik
Reply With Quote
  #10  
Old 04-09-2011, 00:06
shelbym's Avatar
shelbym shelbym is offline
Senior Member
 
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,769
Blog Entries: 9
Send a message via ICQ to shelbym Send a message via AIM to shelbym Send a message via MSN to shelbym Send a message via Yahoo to shelbym
Default CorelDRAW

You do not need to test, it will not work in CorelDRAW 12. CorelDRAW 12 does not support CQL.

-Shelby
Reply With Quote
Reply

Tags
adobe, bitmap, corel, fountain, powerclip


Currently Active Users Viewing This Thread: 1 (0 members and 1 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 18:44
Rotation and PowerClip Craig Tucker CorelDRAW/Corel DESIGNER VBA 3 23-08-2007 17:31
How to convert transparencies to bitmap in nested powerclip designhouse CorelDRAW/Corel DESIGNER VBA 2 29-04-2007 04:07
powerclip extract zaum CorelDRAW/Corel DESIGNER VBA 2 26-10-2005 08:26
[BUG] - Fountain fill is'nt rotate in powerclip Kursad General 3 01-07-2005 22:01


All times are GMT -5. The time now is 12:16.


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