Heavy duty script for ganging up images on sheet

so I found this script on the Quark forums and wanted to share it
here’s the link to the forum post:
http://www.quark.com/service/forums/viewtopic.php?t=3528

I did not write it, but only wanted to throw it out there to see if anybody wants to mess around with it

props go out to “Scripting_Ace” from Quark forums on writing this

It basically will build a Quark document of ganged up images that you specify, it also places crops on each image and the file name

now this script is supposed to fit the images the best it can on the sheet, trying to maximize the space used (and unused)

I was able to use this on my work machine but had to comment out the function that uses “Acme Script Widgets” which i believe is the function behind maximizing the space used- and I was not able to get the script to run on my home machine, I keep getting errors on the coercion to real

anyways, I just wanted to see if anyone wanted to play with this on their machine and see how it works, and what it does

here’s the code (again “Scripting_Ace”, this is a beautiful script):

property DocWidth : 26 * 72 – Document’s width (in points)
property DocHeight : 20 * 72 – Document’s height (in points)
property DocMargins : 36 – Documnent’s margin (in points) (they are all the same for this script)
property LabelHeight : 14 – Height of the Label text box (in points)
property LabelOffset : 6 – Distance between the picture and the label (in points)
property CropMarks_Length : 24 – Length of each crop marks (in points)
property CropMarks_Offset : 9 – Distance between the crop marks and the picture (in points)
property CropMarks_Thickness : 0.5 – Thickness of each crop marks (in points)
property TypeList : {"BMP ", “EPSF”, “GIFf”, “JPEG”, "PDF ", “PICT”, “PNGf”, “TIFF”} – Graphic File Format s (Modify to fit your needs)

– Other properties (do not change the following values
property SourceFolder : “” – Path (as text) of the picture folder
property DocName : “” – The Quark document’s name
property Top_Origin : 144 – Top origin of the temporary picture (in points)
property Left_Origin : 144 – Left origin of the temporary picture (in points)
property Size_Origin : 144 – Width and Height of the temporary picture (in points)
property Page_Spaces : {} – List of records of free space (per page)

tell application “QuarkXPress Passport”
activate
– A) create a blank document that is 26" wide by 20" tall
tell default document 1
– Save old values
set Old_Facing to facing pages
set Old_AutoText to automatic text box
set Old_Horizontal to horizontal measure
set Old_Vertical to vertical measure
– Set desired values
set facing pages to false
set automatic text box to false
set horizontal measure to points
set vertical measure to points
end tell

make new document at end with properties {page width:DocWidth, page height:DocHeight, top margin:DocMargins, bottom margin:DocMargins, left margin:DocMargins, right margin:DocMargins}
set Page_Spaces to {}
set end of Page_Spaces to {{TheTop:DocMargins, TheLeft:DocMargins, TheWidth:DocWidth - (2 * DocMargins), TheHeight:DocHeight - (2 * DocMargins)}}
set DocName to name of document 1

tell default document 1
– Restore changed values
set facing pages to Old_Facing
set automatic text box to Old_AutoText
set horizontal measure to Old_Horizontal
set vertical measure to Old_Vertical
end tell
end tell

– B) prompt for location of desired folder (this is a bit of a luxury – I would be happy just to have it look in the same place every time and skip this step)
set QFolder to “Please locate the folder containing the images you wish to import”
tell application “QuarkXPress Passport”
set SourceFolder to (choose folder with prompt QFolder) as text
end tell

set ItemList to list folder SourceFolder without invisibles
set FileList to {}
– Making sure we only process your graphic files
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

– Making style sheets
tell application “QuarkXPress Passport”
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”, color:“Registration”}
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

repeat with ThisFile in FileList
–1a) Create the picture box, place image and fit the box to its contents
set {PicBox, BoxHeight, BoxWidth} to my Make_PicBox(ThisFile)
–1b) Create crop marks.around picture box
set {Crop1, Crop2, Crop3, Crop4, Crop5, Crop6, Crop7, Crop8} to my Make_CropMarks(PicBox)
–2) Create a name label below the box.
set TextBox to my Make_LabelBox(Top_Origin + BoxHeight + LabelOffset, BoxWidth, ThisFile)
–3) Find a place for this group and move it there
set selection to null
repeat with ThisBox in {PicBox, TextBox, Crop1, Crop2, Crop3, Crop4, Crop5, Crop6, Crop7, Crop8}
set selected of ThisBox to true
end repeat
my Place_ThisGroup()
end repeat – repeat with ThisFile in FileList
end tell

–>> Handlers
on Make_PicBox(ThisPicture)
tell application “QuarkXPress Passport”
tell document DocName
tell current page
set PicBox to make new picture box at end with properties {bounds:{Top_Origin, Left_Origin, Top_Origin + Size_Origin, Left_Origin + Size_Origin}}
tell PicBox
set image 1 to file ((SourceFolder & ThisPicture) as text)
set PicBounds to (bounds of image 1)
set TheWidth to item 3 of PicBounds
set TheHeight to item 4 of PicBounds
set width of bounds to TheWidth
set height of bounds to TheHeight
set runaround to none runaround
end tell
end tell
end tell
end tell
return {PicBox, TheHeight as real, TheWidth as real}
end Make_PicBox

on Make_LabelBox(FromHeight, BoxWidth, ThisLabel)
tell application “QuarkXPress Passport”
set ParaStyle to object reference of style spec “Label” of document DocName
tell document DocName
tell current page
set TextBox to make new text box at end with properties {bounds:{FromHeight, Left_Origin, FromHeight + LabelHeight, Top_Origin + BoxWidth}}
tell TextBox
set contents of story 1 to ThisLabel
set style sheet of paragraph 1 of story 1 to ParaStyle
set runaround to none runaround
end tell
end tell
end tell
end tell
return TextBox
end Make_LabelBox

on Make_CropMarks(ThisBox)
tell application “QuarkXPress Passport”
tell document DocName
tell current page
copy (coerce (bounds of ThisBox as points rectangle) to list) to {T, L, B, R}
set T to T as real
set L to L as real
set B to B as real
set R to R as real

        set L1 to L - CropMarks_Offset - CropMarks_Length
        set L2 to L - CropMarks_Offset
        set R1 to R + CropMarks_Offset
        set R2 to R + CropMarks_Offset + CropMarks_Length
        set T1 to T - CropMarks_Offset - CropMarks_Length
        set T2 to T - CropMarks_Offset
        set B1 to B + CropMarks_Offset
        set B2 to B + CropMarks_Offset + CropMarks_Length
        
        set Crop1 to make new line box at end with properties {start point:{T, L1}, end point:{T, L2}, width:CropMarks_Thickness, color:"Registration"}
        set Crop2 to make new line box at end with properties {start point:{T, R1}, end point:{T, R2}, width:CropMarks_Thickness, color:"Registration"}
        set Crop3 to make new line box at end with properties {start point:{B, L1}, end point:{B, L2}, width:CropMarks_Thickness, color:"Registration"}
        set Crop4 to make new line box at end with properties {start point:{B, R1}, end point:{B, R2}, width:CropMarks_Thickness, color:"Registration"}
        
        set Crop5 to make new line box at end with properties {start point:{T1, L}, end point:{T2, L}, width:CropMarks_Thickness, color:"Registration"}
        set Crop6 to make new line box at end with properties {start point:{B1, L}, end point:{B2, L}, width:CropMarks_Thickness, color:"Registration"}
        set Crop7 to make new line box at end with properties {start point:{T1, R}, end point:{T2, R}, width:CropMarks_Thickness, color:"Registration"}
        set Crop8 to make new line box at end with properties {start point:{B1, R}, end point:{B2, R}, width:CropMarks_Thickness, color:"Registration"}
     end tell
  end tell

end tell
return {Crop1, Crop2, Crop3, Crop4, Crop5, Crop6, Crop7, Crop8}
end Make_CropMarks

on Place_ThisGroup()
tell application “QuarkXPress Passport”
tell document DocName
set TheRef to (object reference of selection)
set PlacingWidth to (width of bounds of TheRef) as real
set PlacingHeight to (height of bounds of TheRef) as real
my DoMenu(“Edit”, “Cut”)
set Place_Found to false
repeat with ThisPage from 1 to Page_Spaces’s length
set SpaceList to (item ThisPage of Page_Spaces)
if Place_Found is false then
repeat with PlaceIndex from 1 to SpaceList’s length
set ItsTop to TheTop of item PlaceIndex of SpaceList
set ItsLeft to TheLeft of item PlaceIndex of SpaceList
set ItsWidth to TheWidth of item PlaceIndex of SpaceList
set ItsHeight to TheHeight of item PlaceIndex of SpaceList

              if PlacingWidth <= ItsWidth and PlacingHeight <= ItsHeight then
                 set Place_Found to true
                 -- Remove used space from available space of that page
                 set (item ThisPage of Page_Spaces) to delete item PlaceIndex from (item ThisPage of Page_Spaces) -- Uses Acme Script Widgets
                 -- Separates the space vertically at Item's width and create remaining free space infos
                 if PlacingWidth < ItsWidth then -- There will be some free space to the right after placement
                    set FreeSpaceRigth to {TheTop:ItsTop, TheLeft:ItsLeft + PlacingWidth, TheWidth:ItsWidth - PlacingWidth, TheHeight:ItsHeight}
                    set end of (item ThisPage of Page_Spaces) to FreeSpaceRigth
                 end if
                 if PlacingHeight < ItsHeight then -- There will be some free space to the bottom after placement
                    set FreeSpaceDown to {TheTop:ItsTop + PlacingHeight, TheLeft:ItsLeft, TheWidth:PlacingWidth, TheHeight:ItsHeight - PlacingHeight}
                    set end of (item ThisPage of Page_Spaces) to FreeSpaceDown
                 end if
                 exit repeat
              end if
           end repeat
        else
           set ThisPage to ThisPage - 1
           exit repeat
        end if
     end repeat
     
     if Place_Found is true then
        set current page to page ThisPage
        my DoMenu("Edit", "Paste")
        do updates
        my DoMenu("Item", "Group")
        set TheRef to (object reference of selection)
        set origin of bounds of TheRef to {ItsTop, ItsLeft}
     else
        my Add_Page()
        my DoMenu("Edit", "Paste")
        my Place_ThisGroup()
     end if
  end tell

end tell
end Place_ThisGroup

on Add_Page()
tell application “QuarkXPress Passport”
tell document DocName
make new page at end
set end of Page_Spaces to {{TheTop:DocMargins, TheLeft:DocMargins, TheWidth:DocWidth - (2 * DocMargins), TheHeight:DocHeight - (2 * DocMargins)}}
end tell
end tell
end Add_Page

on SetTool(This_Tool)
tell application “QuarkXPress Passport”
tell document DocName
if This_Tool is “Contents” then
set tool mode to contents mode
else if This_Tool is “Drag” then
set tool mode to drag mode
end if
end tell
end tell
end SetTool

on DoMenu(This_Menu, This_SubMenu)
tell application “QuarkXPress Passport”
try
select menu item This_SubMenu of menu This_Menu
on error errMsg number errNum
display dialog (“An error " & errNum & " has occured” & return & return & errMsg) with icon stop
end try
end tell
end DoMenu

I have 2 variations of the above script to suit my needs. IMO Ace’s scripting of Quark is second to none.

If you wrote it then good job, it’s awesome

and maybe you can help me to figure this out:
on the handler to make crop marks I keep getting these kind of errors:

Can’t make «data FXPT00900000» into type real.

By the looks of things you have picked up a different version of Ace’s script to what I found on Quark’s site. This one is a bit more flexible just set up a Quark doc to your choice of paper size and this works to your margin guides from there its very simple to create a template with headers & footers to suit your needs. Enjoy and don’t be thinking a script like this was anything to do with me all the credit goes to Ace. There is 1 very small thing with this that I have found, there is a problem if the math of rows & columns needs to create the last page with only 1 image does not work but trying to fix this is beyond me very thing else works sweet.

property TypeList : {"BMP ", "EPSF", "GIFf", "JPEG", "PDF ", "PICT", "PNGf", "TIFF"} -- File types of your graphic files
property LabelHeight : 48 -- Height of the Label Box (in points)
property HorSpace : 12 -- 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 < FileList's length then
				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 tell
end if
beep 3

on 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 tell
end Set_MarginValue

on 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 tell
end Make_PicBox

on 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 tell
end Make_LabelBox

on 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 tell
end DoMenu

on 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 if
end GetTExtItem

on 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 NewString
end FindReplace

Looking at the two scripts the first gangs up image files on a document at 100%, where the second places them in a set sized image area with proportional fit. I have built the second for both Quark 4.0 and InDesign. My InDesign version also allows for changing page size and choosing the image types to place, including a rutine (discussed in another forum) for placing multiple page PDF’s.

The first script is the one that I find interesing, and I thank bace for posting it. Looking at the code, the line that uses Acme Script Widget just removes an item from a list, this could should be able to be done without the OSAX. I haven’t run the script, but would be interested in finding out how effecient the math is in placing the images. I have been thinking of modifying my InDesign script to do this as well as reduce the images, we have need for both options at work, but was not sure of how to go about doing the math, and havent had the time to research it. I know there are programs for home workshops that will “optamize” the placement of pieces to cut out of a sheet of plywood so that there is minimal waist, even rotating pieces where neccessarey, and that is what i was thinking of figuring out how to do. This gives me something to look at, so thanks for posting it (I stopped going to the Quark scripting form when it went down for so long, and wasnt aware that it was back up).

property DocWidth : 26 * 72 -- Document's width (in points)
property DocHeight : 20 * 72 -- Document's height (in points)
property DocMargins : 36 -- Documnent's margin (in points) (they are all the same for this script)
property LabelHeight : 14 -- Height of the Label text box (in points)
property LabelOffset : 6 -- Distance between the picture and the label (in points)
property CropMarks_Length : 24 -- Length of each crop marks (in points)
property CropMarks_Offset : 9 -- Distance between the crop marks and the picture (in points)
property CropMarks_Thickness : 0.5 -- Thickness of each crop marks (in points)
property TypeList : {"BMP ", "EPSF", "GIFf", "JPEG", "PDF ", "PICT", "PNGf", "TIFF"} -- Graphic File Format s (Modify to fit your needs)

-- Other properties (do not change the following values
property SourceFolder : "" -- Path (as text) of the picture folder
property DocName : "" -- The Quark document's name
property Top_Origin : 144 -- Top origin of the temporary picture (in points)
property Left_Origin : 144 -- Left origin of the temporary picture (in points)
property Size_Origin : 144 -- Width and Height of the temporary picture (in points)
property Page_Spaces : {} -- List of records of free space (per page)

tell application "QuarkXPress"
	activate
	-- A) create a blank document that is 26" wide by 20" tall
	tell default document 1
		-- Save old values
		set Old_Facing to facing pages
		set Old_AutoText to automatic text box
		set Old_Horizontal to horizontal measure
		set Old_Vertical to vertical measure
		-- Set desired values
		set facing pages to false
		set automatic text box to false
		set horizontal measure to points
		set vertical measure to points
	end tell
	
	make new document at end with properties {page width:DocWidth, page height:DocHeight, top margin:DocMargins, bottom margin:DocMargins, left margin:DocMargins, right margin:DocMargins}
	set Page_Spaces to {}
	set end of Page_Spaces to {{TheTop:DocMargins, TheLeft:DocMargins, TheWidth:DocWidth - (2 * DocMargins), TheHeight:DocHeight - (2 * DocMargins)}}
	set DocName to name of document 1
	
	tell default document 1
		-- Restore changed values
		set facing pages to Old_Facing
		set automatic text box to Old_AutoText
		set horizontal measure to Old_Horizontal
		set vertical measure to Old_Vertical
	end tell
end tell

-- B) prompt for location of desired folder (this is a bit of a luxury -- I would be happy just to have it look in the same place every time and skip this step)
set QFolder to "Please locate the folder containing the images you wish to import"
tell application "QuarkXPress"
	set SourceFolder to (choose folder with prompt QFolder) as text
end tell

set ItemList to list folder SourceFolder without invisibles
set FileList to {}
-- Making sure we only process your graphic files
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

-- Making style sheets
tell application "QuarkXPress"
	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", color:"Registration"}
		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
	
	repeat with ThisFile in FileList
		--1a) Create the picture box, place image and fit the box to its contents
		set {PicBox, BoxHeight, BoxWidth} to my Make_PicBox(ThisFile)
		--1b) Create crop marks.around picture box
		set {Crop1, Crop2, Crop3, Crop4, Crop5, Crop6, Crop7, Crop8} to my Make_CropMarks(PicBox)
		--2) Create a name label below the box.
		set TextBox to my Make_LabelBox(Top_Origin + BoxHeight + LabelOffset, BoxWidth, ThisFile)
		--3) Find a place for this group and move it there
		set selection to null
		repeat with ThisBox in {PicBox, TextBox, Crop1, Crop2, Crop3, Crop4, Crop5, Crop6, Crop7, Crop8}
			set selected of ThisBox to true
		end repeat
		my Place_ThisGroup()
	end repeat -- repeat with ThisFile in FileList
end tell


-->> Handlers
on Make_PicBox(ThisPicture)
	tell application "QuarkXPress"
		tell document DocName
			tell current page
				set PicBox to make new picture box at end with properties {bounds:{Top_Origin, Left_Origin, Top_Origin + Size_Origin, Left_Origin + Size_Origin}}
				tell PicBox
					set image 1 to file ((SourceFolder & ThisPicture) as text)
					set PicBounds to (bounds of image 1)
					set TheWidth to item 3 of PicBounds
					set TheHeight to item 4 of PicBounds
					set width of bounds to TheWidth
					set height of bounds to TheHeight
					set runaround to none runaround
				end tell
			end tell
		end tell
	end tell
	return {PicBox, TheHeight as real, TheWidth as real}
end Make_PicBox

on Make_LabelBox(FromHeight, BoxWidth, ThisLabel)
	tell application "QuarkXPress"
		set ParaStyle to object reference of style spec "Label" of document DocName
		tell document DocName
			tell current page
				set TextBox to make new text box at end with properties {bounds:{FromHeight, Left_Origin, FromHeight + LabelHeight, Top_Origin + BoxWidth}}
				tell TextBox
					set contents of story 1 to ThisLabel
					set style sheet of paragraph 1 of story 1 to ParaStyle
					set runaround to none runaround
				end tell
			end tell
		end tell
	end tell
	return TextBox
end Make_LabelBox

on Make_CropMarks(ThisBox)
	tell application "QuarkXPress"
		tell document DocName
			tell current page
				copy (coerce (bounds of ThisBox as points rectangle) to list) to {T, L, B, R}
				set T to T as real
				set L to L as real
				set B to B as real
				set R to R as real
				
				set L1 to L - CropMarks_Offset - CropMarks_Length
				set L2 to L - CropMarks_Offset
				set R1 to R + CropMarks_Offset
				set R2 to R + CropMarks_Offset + CropMarks_Length
				set T1 to T - CropMarks_Offset - CropMarks_Length
				set T2 to T - CropMarks_Offset
				set B1 to B + CropMarks_Offset
				set B2 to B + CropMarks_Offset + CropMarks_Length
				
				set Crop1 to make new line box at end with properties {start point:{T, L1}, end point:{T, L2}, width:CropMarks_Thickness, color:"Registration"}
				set Crop2 to make new line box at end with properties {start point:{T, R1}, end point:{T, R2}, width:CropMarks_Thickness, color:"Registration"}
				set Crop3 to make new line box at end with properties {start point:{B, L1}, end point:{B, L2}, width:CropMarks_Thickness, color:"Registration"}
				set Crop4 to make new line box at end with properties {start point:{B, R1}, end point:{B, R2}, width:CropMarks_Thickness, color:"Registration"}
				
				set Crop5 to make new line box at end with properties {start point:{T1, L}, end point:{T2, L}, width:CropMarks_Thickness, color:"Registration"}
				set Crop6 to make new line box at end with properties {start point:{B1, L}, end point:{B2, L}, width:CropMarks_Thickness, color:"Registration"}
				set Crop7 to make new line box at end with properties {start point:{T1, R}, end point:{T2, R}, width:CropMarks_Thickness, color:"Registration"}
				set Crop8 to make new line box at end with properties {start point:{B1, R}, end point:{B2, R}, width:CropMarks_Thickness, color:"Registration"}
			end tell
		end tell
	end tell
	return {Crop1, Crop2, Crop3, Crop4, Crop5, Crop6, Crop7, Crop8}
end Make_CropMarks

on Place_ThisGroup()
	tell application "QuarkXPress"
		tell document DocName
			set TheRef to (object reference of selection)
			set PlacingWidth to (width of bounds of TheRef) as real
			set PlacingHeight to (height of bounds of TheRef) as real
			my DoMenu("Edit", "Cut")
			set Place_Found to false
			repeat with ThisPage from 1 to Page_Spaces's length
				set SpaceList to (item ThisPage of Page_Spaces)
				if Place_Found is false then
					repeat with PlaceIndex from 1 to SpaceList's length
						set ItsTop to TheTop of item PlaceIndex of SpaceList
						set ItsLeft to TheLeft of item PlaceIndex of SpaceList
						set ItsWidth to TheWidth of item PlaceIndex of SpaceList
						set ItsHeight to TheHeight of item PlaceIndex of SpaceList
						
						if PlacingWidth ≤ ItsWidth and PlacingHeight ≤ ItsHeight then
							set Place_Found to true
							-- Remove used space from available space of that page
							--*set (item ThisPage of Page_Spaces) to delete item PlaceIndex from (item ThisPage of Page_Spaces) -- Uses Acme Script Widgets
							set (item ThisPage of Page_Spaces) to my DeleteItem(PlaceIndex, item ThisPage of Page_Spaces)
							
							-- Separates the space vertically at Item's width and create remaining free space infos
							if PlacingWidth < ItsWidth then -- There will be some free space to the right after placement
								set FreeSpaceRigth to {TheTop:ItsTop, TheLeft:ItsLeft + PlacingWidth, TheWidth:ItsWidth - PlacingWidth, TheHeight:ItsHeight}
								set end of (item ThisPage of Page_Spaces) to FreeSpaceRigth
							end if
							if PlacingHeight < ItsHeight then -- There will be some free space to the bottom after placement
								set FreeSpaceDown to {TheTop:ItsTop + PlacingHeight, TheLeft:ItsLeft, TheWidth:PlacingWidth, TheHeight:ItsHeight - PlacingHeight}
								set end of (item ThisPage of Page_Spaces) to FreeSpaceDown
							end if
							exit repeat
						end if
					end repeat
				else
					set ThisPage to ThisPage - 1
					exit repeat
				end if
			end repeat
			
			if Place_Found is true then
				set current page to page ThisPage
				my DoMenu("Edit", "Paste")
				do updates
				my DoMenu("Item", "Group")
				set TheRef to (object reference of selection)
				set origin of bounds of TheRef to {ItsTop, ItsLeft}
			else
				my Add_Page()
				my DoMenu("Edit", "Paste")
				my Place_ThisGroup()
			end if
		end tell
	end tell
end Place_ThisGroup

on Add_Page()
	tell application "QuarkXPress"
		tell document DocName
			make new page at end
			set end of Page_Spaces to {{TheTop:DocMargins, TheLeft:DocMargins, TheWidth:DocWidth - (2 * DocMargins), TheHeight:DocHeight - (2 * DocMargins)}}
		end tell
	end tell
end Add_Page

on SetTool(This_Tool)
	tell application "QuarkXPress"
		tell document DocName
			if This_Tool is "Contents" then
				set tool mode to contents mode
			else if This_Tool is "Drag" then
				set tool mode to drag mode
			end if
		end tell
	end tell
end SetTool

on DoMenu(This_Menu, This_SubMenu)
	tell application "QuarkXPress"
		try
			select menu item This_SubMenu of menu This_Menu
		on error errMsg number errNum
			display dialog ("An error " & errNum & " has occured" & return & return & errMsg) with icon stop
		end try
	end tell
end DoMenu

on DeleteItem(PlaceIndex, TheList)
	if PlaceIndex > 1 and PlaceIndex < (count of TheList) then set NewList to items 1 through (PlaceIndex - 1) of TheList & items (PlaceIndex + 1) through (count of TheList) of TheList
	if PlaceIndex is (count of TheList) and PlaceIndex > 1 then set NewList to items 1 through (PlaceIndex - 1) of TheList
	if PlaceIndex is 1 and (count of TheList) > 1 then set NewList to items (PlaceIndex + 1) through (count of TheList) of TheList
	if PlaceIndex is 1 and (count of TheList) is 1 then set NewList to {}
	return NewList
end DeleteItem

I added a handler that eleminates the call to Acme Script Widget. It tests OK on my computer using Quark 6. It could be a little better at utilizing the available space from my test, but it works pretty good and I’m sure would a lot of time.

does anyone know how this script needs to be adjusted to work in indesign?

grtz,

kris

I played around with this script a little over a year ago. It does pretty much what it says it does, but I wasn’t satisfied with the result. I am building an application that does this in ID CS2 right now, as well as a more traditional image catalog (contact sheet), and plan to have an alpha version ready soon with a minimal user interface. Last night I think I worked out one of the last actual problems with placing the images at 100%, or rather scaling those that are too large to fit on the selected page size so that they do fit. I will post more information tonight or tomorrow.

G’day Jerome, or anyone else that can answer this question

We need an Applescript to print 100% sized images either in indesign3 or in Quark, or as an App that monitors a folder. Do you have or know of such an item?

Regards

Santa

Model: intel iMac
Browser: Safari 525.18
Operating System: Mac OS X (10.5)

Over in the Script Builders section I have a link to one that I was working on a while ago for InDesign CS2: http://scriptbuilders.net/files/abettercontactsheet2a.html

I probably need to get the motivation to clean it up and add a better interface to it to increase the flexibility. I had an AppleScript Studio version that I was working on but lost the project somehow and haven’t gotten back to it. I think that it works pretty good for what it does and have received few complaints about it other than the person who gives it one star because they are getting an error because they do not have the correct font loaded (helvetica if I recall correctly).

Thanks Jerome.

I’ve taken the last above script and got it working, apart from the color:“Registration” having to be removed from each line.

Anybody knoww hat the problem m ight be?

Regards

Santa

I don’t see anything wrong with that line as long as there is a registration color to apply to the line and it is spelled the same as it is in the code. I last worked on that one in Quark 4 so I’m sure there have been some things that have changed since then. I tried using the same line of code to create a rule in and it works in Quark 6, the latest version I have access to. I really have not worked much in Quark in the last few years so can’t help you more, sorry.