Make "Planche Contact"

Discuss AppleScripting for QuarkXPress 10, 9 & 8 (and before)
Post Reply
Vincent Nicolas
Posts: 0
Joined: 13 Apr 2011, 09:55

Make "Planche Contact"

Post by Vincent Nicolas » 10 Nov 2011, 23:32

Hello,
I would like to make a "Planche Conctat" with 4 images on a A4 pages with a legende (filename + Width and Height of the image and the dimension in centimeters).
It means it add pages as long as necessary depending on the number of images.
I know Quark as a script "Fldr to Selct PBoxes", but the script should add pages each time is necessary.
I would like to start from scratch... but I can't make my script to add a page.
tell application "QuarkXPress"

activate
try

make new project at beginning

tell default document 1
set page height to "29.70 cm"
set page width to "21.0 cm"
set automatic text box to false
set guides showing to true
set guides in front to true
set horizontal measure to centimeters
set vertical measure to centimeters
end tell

tell document 1
make new page at after page 1
end tell
end try
end tell
The script I found to get the resolution of the picture is:
choose file
set filename to result as string
tell application "Image Events"
launch
set theImage to open file filename
set theDimensions to (dimensions of theImage) --list of 2 numbers, {width, height}
close theImage
end tell
set W to item 1 of theDimensions
set H to item 2 of theDimensions

Emma
Posts: 657
Joined: 07 Jul 2004, 08:43

Make "Planche Contact"

Post by Emma » 14 Nov 2011, 04:42

No replies?? Vincent, a regular poster here, Michel, has written a very handy script that makes contact sheets.
I will post it below and you can either use it to get ideas, or adapt it to suit your purpose.
It calculates the number of pages needed at the beginning, rather than adding pages as it goes along.

property TypeList : {"BMP ", "EPSF", "GIFf", "JPEG", "PDF ", "PICT", "PNGf", "TIFF"} -- File types of your graphic files
property LabelHeight : 16 -- Height of the Label Box (in points)
property HorSpace : 6 -- Gutter between column (in points)
property VerSpace : 12 -- Gutter between rows (in points)

property BoxWidth : 0 -- will be defined at run time
property BoxHeight : 0 -- will be defined at run time
property SourceFolder : "" -- will be defined at run time
property Xor : 0 -- will be defined at run time
property Yor : 0 -- will be defined at run time
property LabelSpace : 0 -- will be defined at run time
property MarginTop : 0 -- will be defined at run time
property MarginBottom : 0 -- will be defined at run time
property MarginLeft : 0 -- will be defined at run time
property MarginRight : 0 -- will be defined at run time
property DocName : "" -- will be defined at run time

tell application "QuarkXPress"
activate
set QFolder to "Please locate the folder containing the images you wish to process"
set VContinue to false
set SetupTemp to false
try
set DocName to name of document 1
set QOverwrite to "Do you really wish to overwrite the current document?"
set DOverwrite to display dialog QOverwrite buttons {"No Use the template", "Yes"} default button 1 with icon note
if button returned of DOverwrite is "Yes" then
set SourceFolder to (choose folder with prompt QFolder) as text
set VContinue to true
tell document DocName
make new page at beginning
make new page at beginning
try
delete (pages 2 thru -1)
end try
end tell
else
set SetupTemp to true
end if
on error
set SetupTemp to true
end try
end tell

if SetupTemp is true then
set TempFolder to (path to me) as text
tell application "QuarkXPress"
set TemplateFile to (my FindReplace("Contact Sheet_Maker", "Contact Sheet_Template", TempFolder)) as alias
set SourceFolder to (choose folder with prompt QFolder) as text
open TemplateFile
set DocName to name of document 1
tell master document DocName
try
set contents of story 1 of text box "txt_Header" to my GetTExtItem(SourceFolder, ":", -2)
end try
end tell
set VContinue to true
end tell
end if

if VContinue then
set ItemList to list folder SourceFolder without invisibles
set FileList to {}
repeat with ThisItem in ItemList
set TheInfo to info for (file (SourceFolder & ThisItem))
if folder of TheInfo is false then
if file type of TheInfo is in TypeList then
set end of FileList to (ThisItem as text)
end if
end if
end repeat


tell application "QuarkXPress"
activate
set QRows to "You have selected " & FileList's length & " images" & return & return & "How many rows would you like me to produce?"
set doLoop to true
repeat while doLoop is true
set DRows to display dialog QRows default answer "0" with icon note
try
set NumRows to (text returned of DRows) as integer
if NumRows > 0 then
set doLoop to false
else
display dialog "Number must be greater than 0!" with icon caution
end if
on error
display dialog "Numbers only please!" with icon caution
end try
end repeat

set QColumns to "You have selected " & FileList's length & " images" & return & return & "How many columns would you like me to produce?"
set doLoop to true
repeat while doLoop is true
set DColumns to display dialog QColumns default answer "0" with icon note
try
set NumCols to (text returned of DColumns) as integer
if NumCols > 0 then
set doLoop to false
else
display dialog "Number must be greater than 0!" with icon caution
end if
on error
display dialog "Numbers only please!" with icon caution end try end repeat set QLabels to "What kind of labels wold you like?" set DLabels to display dialog QLabels buttons {"None", "File path", "File name"} default button 3 with icon note set LabelType to button returned of DLabels --*) if LabelType is not "None" then set LabelSpace to LabelHeight if not (exists character spec "Label" of document DocName) and not (exists style spec "Label" of document DocName) then set CharStyle to make new character spec at document DocName's end with properties {name:"Label"} set ParaStyle to make new style spec at document DocName's end with properties {name:"Label"} set character style of ParaStyle to CharStyle end if else set LabelSpace to 0 end if tell document DocName set OldHor to horizontal measure set OldVer to vertical measure set horizontal measure to points set vertical measure to points set PageWidth to page width as real set PageHeight to page height as real my Set_MarginValue(count of pages) set DisplayWidth to PageWidth - MarginLeft - MarginRight set DisplayHeight to PageHeight - MarginTop - MarginBottom set BoxWidth to (DisplayWidth - (HorSpace * (NumCols - 1))) / NumCols set BoxHeight to ((DisplayHeight - (VerSpace * (NumRows - 1))) / NumRows) - LabelSpace end tell set i to 1 repeat while i FileList's length repeat with j from 1 to NumRows repeat with K from 1 to NumCols try my Make_PicBox(K, j, (item i of FileList) as text) if LabelType is "File name" then my Make_LabelBox(K, j, (item i of FileList) as text) else if LabelType is "File path" then my Make_LabelBox(K, j, SourceFolder & (item i of FileList) as text) end if on error exit repeat end try set i to i + 1 end repeat end repeat if i tell document DocName make new page at end set current page to page (count of pages) my Set_MarginValue(count of pages) end tell end if end repeat tell document DocName set horizontal measure to OldHor set vertical measure to OldVer end tell if SetupTemp is true then set PageCount to count of pages of document DocName tell master document DocName try set contents of story 1 of text box "txt_TotalPages" to PageCount end try end tell end if end tellend ifbeep 3on Set_MarginValue(ThisPage) tell application "QuarkXPress" tell document DocName set FacingPages to facing pages tell page ThisPage if (page number) mod 2 > 0 then -- Odd page set Page_Parity to "Odd" else -- Even page set Page_Parity to "Even" end if end tell if FacingPages and Page_Parity is "Odd" then set MarginTop to top margin as real set MarginBottom to bottom margin as real set MarginLeft to inside margin as real set MarginRight to outside margin as real else if FacingPages and Page_Parity is "Even" then set MarginTop to top margin as real set MarginBottom to bottom margin as real set MarginLeft to outside margin as real set MarginRight to inside margin as real else set MarginTop to top margin as real set MarginBottom to bottom margin as real set MarginLeft to left margin as real set MarginRight to right margin as real end if set Xor to MarginLeft set Yor to MarginTop end tell end tellend Set_MarginValueon Make_PicBox(RowRun, ColRun, ThisPicture) tell application "QuarkXPress" tell document DocName tell current page set Y to ((ColRun - 1) * (BoxHeight + VerSpace + LabelSpace)) + Yor set X to ((RowRun - 1) * (BoxWidth + HorSpace)) + Xor set NewBox to make new picture box at beginning with properties {bounds:{Y, X, Y + BoxHeight, X + BoxWidth}} tell picture box 1 set image 1 to file ((SourceFolder & ThisPicture) as text) set bounds of image 1 to proportional fit end tell end tell end tell end tellend Make_PicBoxon Make_LabelBox(RowRun, ColRun, ThisLabel) tell application "QuarkXPress" set ParaStyle to object reference of style spec "Label" of document DocName tell document DocName tell current page set Y to ((ColRun - 1) * (BoxHeight + VerSpace + LabelSpace)) + Yor set X to ((RowRun - 1) * (BoxWidth + HorSpace)) + Xor set NewBox to make new text box at beginning with properties {bounds:{Y + BoxHeight, X, Y + BoxHeight + LabelHeight, X + BoxWidth}} tell NewBox set contents of story 1 to ThisLabel set style sheet of paragraph 1 of story 1 to ParaStyle end tell end tell end tell end tellend Make_LabelBoxon DoMenu(This_Menu, First_Level, Second_Level) tell application "QuarkXPress" try if Second_Level is "" then select menu item First_Level of menu This_Menu else select menu item Second_Level of menu item First_Level of menu This_Menu end if on error errMsg number errNum display dialog ("An error " & errNum & " has occured" & return & return & errMsg) with icon stop end try end tellend DoMenuon GetTExtItem(ThisString, ThisDelim, ThisItem) -- ThisString -> String to look in -- ThisDelim -> Text element that delimit the string -- ThisItem -> Number of the element to return copy the text item delimiters to OldDelims set the text item delimiters to ThisDelim set arrItem to every text item of ThisString set the text item delimiters to OldDelims if ThisItem 0 then return (item ThisItem of arrItem) as text else return arrItem -- return every items end ifend GetTExtItemon FindReplace(FindWhat, ReplaceBy, ThisString) copy the text item delimiters to OldDelims set the text item delimiters to {FindWhat} set TempList to every text item of ThisString set the text item delimiters to {ReplaceBy} set NewString to TempList as text set the text item delimiters to OldDelims return NewStringend FindReplace

Scripting_Ace
Posts: 684
Joined: 29 Jun 2004, 13:14

Make "Planche Contact"

Post by Scripting_Ace » 14 Nov 2011, 08:35

I thought I recognised my "scriptmanship". I realy should have replied but I did not have the time to test if the code was still working with the current version of Quark.
Thanks Emma,

Post Reply

Return to “QuarkXPress 8, 9 & 10: AppleScript”