OberonPlace.com Forums  

Go Back   OberonPlace.com Forums > Developer Forums > VBA > CorelDRAW/Corel DESIGNER VBA

Reply
 
Thread Tools Search this Thread Display Modes
  #1  
Old 16-11-2004, 14:44
ddonnahoe's Avatar
ddonnahoe ddonnahoe is offline
Senior Member
 
Join Date: Jan 2004
Location: Louisville, KY
Posts: 552
Send a message via ICQ to ddonnahoe Send a message via AIM to ddonnahoe Send a message via MSN to ddonnahoe Send a message via Yahoo to ddonnahoe
Default Color Swatch Conundrum

Using Draw11

I am wondering if there is a way I can tweak the color swatch generator that comes with Corel. I want it to create a page that is 34" wide by however tall it has to be to fit all of the Pantone swatches on. (I was thinking that 78" would be good.)

Currently, the macro creates an 8.5 x 11 page. The current swatch size is sufficient, approx. 1".

The reason I want to do this, is to use the page to print to my oversize banner printer. It prints in CMYK and I want to see how it interpolates PMS to CMYK so that I can match customers colors better when printing banners.
__________________
Sean
Waiting for a ride in the T.A.R.D.I.S.
Reply With Quote
  #2  
Old 16-11-2004, 14:59
Alex's Avatar
Alex Alex is offline
Administrator
 
Join Date: Nov 2002
Posts: 1,940
Blog Entries: 4
Default Re: Color Swatch Conundrum

Sure it should be possible to do. But you might want to give the good old Palette Book script a try: http://www.oberonplace.com/draw/drawscripts/pbooksh.htm

It is for Draw 9 but I think it should still work with v11 (if you open the CSC file and change "CorelDRAW.Automation.9" for "CorelDRAW.Automation.11")

I guess I'd better create a VBA version of this macro. It sure beats the standard color swatch generator...
Reply With Quote
  #3  
Old 16-11-2004, 15:05
ddonnahoe's Avatar
ddonnahoe ddonnahoe is offline
Senior Member
 
Join Date: Jan 2004
Location: Louisville, KY
Posts: 552
Send a message via ICQ to ddonnahoe Send a message via AIM to ddonnahoe Send a message via MSN to ddonnahoe Send a message via Yahoo to ddonnahoe
Default

Alex, thanks again. Where do I place the two files so that I can run the script?
__________________
Sean
Waiting for a ride in the T.A.R.D.I.S.
Reply With Quote
  #4  
Old 16-11-2004, 15:38
ddonnahoe's Avatar
ddonnahoe ddonnahoe is offline
Senior Member
 
Join Date: Jan 2004
Location: Louisville, KY
Posts: 552
Send a message via ICQ to ddonnahoe Send a message via AIM to ddonnahoe Send a message via MSN to ddonnahoe Send a message via Yahoo to ddonnahoe
Default

OK, I answered that one on my own. However the script crashes when I try to change the page size to 34"x78". Dang. I anxiously await the VBA version for 11.
__________________
Sean
Waiting for a ride in the T.A.R.D.I.S.
Reply With Quote
  #5  
Old 22-11-2004, 10:57
ddonnahoe's Avatar
ddonnahoe ddonnahoe is offline
Senior Member
 
Join Date: Jan 2004
Location: Louisville, KY
Posts: 552
Send a message via ICQ to ddonnahoe Send a message via AIM to ddonnahoe Send a message via MSN to ddonnahoe Send a message via Yahoo to ddonnahoe
Default

I have a macro now that does what I want (code below).

One question though. I want to add another line of text underneath the color name, and I want it to show the approx. CMYK values for the above PMS color.

Is this possible?
Code:
Option Explicit

Sub CreateColorSwatches()
    Dim d As Document
    Dim sName As String
    Dim p As Page
    Dim c As Color
    Dim s As Shape
    Dim pal As Palette
    Dim n As Long, i As Long
    Const sx As Double = 0.5
    Const sy As Double = 0.5
    Dim x As Double, y As Double
    Dim MaxX As Long, nx As Long
    Dim MaxY As Long, ny As Long
    Set d = CreateDocument
    d.Unit = cdrInch
    Set p = d.ActivePage
    
    With ActivePage
        .Orientation = cdrPortrait
        .SizeHeight = 18
        .SizeWidth = 34
    End With
    x = 0.75
    y = 0.75
    nx = 0
    MaxX = CLng((p.SizeWidth - 1) / (sx * 1.5))
    MaxY = CLng((p.SizeHeight - 1) / (sy * 1.5))
    CorelDRAW.Optimization = True
    For Each pal In Palettes
        If pal.Type = cdrFixedPalette Then
            If pal.PaletteID = cdrPANTONECorel8 Then
                Exit For
            End If
        End If
    Next pal
    
    If pal Is Nothing Then
        Set pal = Palettes.OpenFixed(cdrPANTONECorel8)
    End If
    
    For Each c In pal.Colors
    If c.Name <> "unnamed color" Then
        Set s = p.ActiveLayer.CreateRectangle(x, y, x + sx, y + sy)
        s.Fill.ApplyUniformFill c
        sName = c.Name
            If Left$(sName, 18) = "PANTONE Warm Gray " Then sName = "W Gray " & Mid$(sName, 19)
            If Left$(sName, 18) = "PANTONE Cool Gray " Then sName = "C Gray " & Mid$(sName, 19)
            If Left$(sName, 16) = "PANTONE Process " Then sName = "Pro. " & Mid$(sName, 17)
            If Left$(sName, 8) = "PANTONE " Then sName = Mid$(sName, 9)
            If Right$(sName, 3) = " CV" Then sName = Left$(sName, Len(sName) - 3)
        sName = "PMS " & sName
        p.ActiveLayer.CreateArtisticText x + (sx / 2), y - 0.1, sName, cdrEnglishUS, cdrCharSetMixed, "Arial", 6, cdrFalse, cdrFalse, cdrNoFontLine, cdrCenterAlignment
        x = x + (sx * 1.5)
        nx = nx + 1
        If nx = MaxX Then
            nx = 0
            x = 0.75
            y = y + (sy * 1.5)
            ny = ny + 1
            If ny = MaxY Then
                ny = 0
                y = 0.75
                Set p = d.AddPages(1)
            End If
        End If
    End If
    Next c
    CorelDRAW.Optimization = False
End Sub
Attached Images
 
__________________
Sean
Waiting for a ride in the T.A.R.D.I.S.
Reply With Quote
  #6  
Old 22-11-2004, 12:15
Alex's Avatar
Alex Alex is offline
Administrator
 
Join Date: Nov 2002
Posts: 1,940
Blog Entries: 4
Default

Yes, you just need to make a copy of color, convert it to CMYK, get its components, construct a string and then concatenate the two lines using a carriage return/line feed character squence:

Code:
...
sName = "PMS " & sName
' ... New code follows ...
Dim cDup as New Color
cDup.CopyAssign c
cDup.ConvertToCMYK
sName = sName & vbCrLf & cDup.Name(True)
' ... End of new code
p.ActiveLayer.CreateArtisticText ...
...
Reply With Quote
Reply


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


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


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