The Omni Group Forums - Script: Make Circles of N Block Arrows

For cases which need more flexibility than the [URL="http://forums.omnigroup.com/showthread.php?t=23531"]Curved Block Arrow stencils[/URL], the following script can be adapted to generate block arcs with arrows at both ends, and/or circles of single-line arrows.

(Probably helpful to select the generated shapes and use [B]Edit > Shapes > Make Custom Shape[/B])

[CODE]property pTitle : "Make Circles of N Block Arrows"
property pVer : "0.07"

-- Copyright © 2010, Robin Trew
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without modification,
-- are permitted provided that the following conditions are met:
--
-- - Redistributions of source code must retain the above copyright notice,
-- this list of conditions and the following disclaimer.
-- - Redistributions in binary form must reproduce the above copyright notice,
-- this list of conditions and the following disclaimer in the documentation
-- and/or other materials provided with the distribution.
--
-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
-- THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
-- IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR
-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
-- (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
-- LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-- WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

-- ver 0.05 Takes account of any rotation of the template shape to determine where first arrow starts
-- ver 0.06 Corrects radius of non-block arrows (when inner or outer fit has been specified)

property pstrHelp : "
Number Number of arrows
a=N Number of arrows
w=N width of block arrows
h=true|false header arrow ?
t=true|false tail arrrow ?
b=true|false block arrows ?
r=c radius=corner
r=e radius=mid edge
f=i fit=inside
f=o fit=outside
f=m fit=mid arrow
? Help
"

property pstrPrompt : "Number of arrows ?
Width of block arrows ?
Head and or tail arrow ?
Block arrows ? (or simple line arrows)
Circle radius:
to corner of shape ?
to mid-edge of shape ?
Circle fit:
fits inside shape ?
fits outside shape ?
covers edge of shape ?

HELP ? (enter a question mark)
"

property plngArrows : 4
property plngRadius : 150

property pblnBlockArrow : true
property pArrowWidth : 20

property peMidEdgeRadius : 1
property peCornerRadius : 2
property peInnerFit : 1
property peOuterFit : 2
property peMidArrowFit : 3

property pRadiusMatch : 2 -- peCornerRadius
property pFit : 2 -- peOuterFit

property pArcAnglePoints : 0.25

property pHeadArrow : true
property pTailArrow : false

property pstrLineArrowHead : "FilledArrow"
property plstLineArrowColor : {1.0, 0.0, 0.0}
property prLineArrowThickness : 2
property pblnLineArrowShadow : true

property plstBlockArrowLineColor : {34081, 38505, 51776}

-- User data keys (adjust if they happen to clash with keys already in use)

property pGap : 1 / 400

property pDeg : 180 / pi

-- FUNCTION:
-- CREATES A CYCLE DIAGRAM, IN WHICH A SET OF SHAPES ARE LINKED IN A CIRCLE
-- BY ARC ARROWS

on run
tell application id "OGfl"
activate

set oShape to self
try
oShape
on error
if my isFullScreen("OGfl") then
set oWin to window 2
else
set oWin to window 1
end if
if id of oWin < 0 then return

set lstSeln to selection of oWin
if length of lstSeln < 1 then
display dialog "First position, size, and select a rectangle, then run again." buttons {"OK"} default button "OK" with title pTitle & " ver. " & pVer
return
end if
set oShape to item 1 of lstSeln
end try

set strReturned to "?"
repeat until strReturned ≠ "?"
tell oShape

set strDefault to "arrows=" & (plngArrows as string) & space & "w=" & pArrowWidth & " h=" & pHeadArrow & " t=" & pTailArrow & " b=" & pblnBlockArrow
if pRadiusMatch = peCornerRadius then
set strDefault to strDefault & " radius=corner"
else
set strDefault to strDefault & " radius=edge"
end if
if pFit = peInnerFit then
set strDefault to strDefault & " fit=innner"
else
set strDefault to strDefault & " fit=outer"
end if

try
tell (display dialog pstrPrompt default answer strDefault with title pTitle & tab & pVer)
set strReturned to text returned
end tell
on error
return
end try

set {dlm, my text item delimiters} to {my text item delimiters, " "}
set lstParts to text items of strReturned
set lngParts to length of lstParts
if lngParts < 1 then return
set my text item delimiters to dlm

set {dlm, my text item delimiters} to {my text item delimiters, "="}
repeat with iPart from 1 to lngParts
set strPart to item iPart of lstParts
set lstKeyValue to text items of strPart
if length of lstKeyValue = 2 then
set {strKey, strvalue} to lstKeyValue
if strKey begins with "a" then
try
set plngArrows to (strvalue as integer)
on error
display alert strvalue & " could not be read as an integer"
return
end try
else if strKey begins with "h" then
try
set pHeadArrow to strvalue as boolean
on error
display dialog strvalue & " could not be interpreted as a boolean value ..."
return
end try
else if strKey begins with "t" then
try
set pTailArrow to strvalue as boolean
on error
display dialog strvalue & " could not be interpreted as a boolean value ..."
return
end try
else if strKey begins with "w" then
try
set pArrowWidth to strvalue as number
on error
display dialog strvalue & " could not be interpreted as a number ..."
return
end try
else if strKey begins with "b" then
try
set pblnBlockArrow to strvalue as boolean
on error
display dialog strvalue & " could not be interpreted as a boolean value ..."
return
end try
else if strKey begins with "r" then
if strvalue begins with "c" then
set pRadiusMatch to peCornerRadius
else
set pRadiusMatch to peMidEdgeRadius

end if
else if strKey begins with "f" then
if strvalue begins with "i" then
set pFit to peInnerFit
else if strvalue begins with "o" then
set pFit to peOuterFit
else
set pFit to peMidArrowFit
end if
end if
else
if strPart begins with "?" then
display dialog pstrHelp buttons {"OK"} default button "OK" with title pTitle & " ver. " & pVer
else
try
set plngArrows to (strPart as integer)
on error
display alert strpars & " could not be read as an integer"
return
end try
end if
end if
end repeat
set my text item delimiters to dlm

if plngArrows < 1 or plngArrows > 100 then
display alert "Number of arrows must be in range 1-100 ..."
return
end if

if strReturned ≠ "?" then
set oCanvas to its canvas
set automatic layout of layout info of oCanvas to false

set {rX, rY} to origin
set {rWidth, rHeight} to size
set rRotn to rotation

-- DETERMINE RADIUS AS A FUNCTION OF radius type and fit type
if rWidth ≥ rHeight then
set plngRadius to (rWidth / 2)
else
set plngRadius to (rHeight / 2) + pArrowWidth
end if

if pRadiusMatch = peCornerRadius then
set plngRadius to ((rWidth / 2) ^ 2 + (rHeight / 2) ^ 2) ^ 0.5
else
if rWidth ≥ rHeight then
set plngRadius to (rHeight / 2)
else
set plngRadius to (rWidth / 2)
end if
end if

if pblnBlockArrow then
if pFit = peInnerFit then
set plngRadius to plngRadius - pArrowWidth / 2
else if pFit = peOuterFit then
set plngRadius to plngRadius + pArrowWidth / 2
end if
end if

set lstCenter to {rX + rWidth / 2, rY + rHeight / 2}
set rTheta to rRotn
set rDelta to 360 / plngArrows
set rNext to rTheta + rDelta

-- DRAW A CURVED ARC (ARROW) BETWEEN EACH SUCCESSIVE PAIR OF SHAPES
repeat with i from 1 to plngArrows
set oArc to my MakeArc(pblnBlockArrow, lstCenter, plngRadius, rTheta, rNext, ¬
pArrowWidth, pArcAnglePoints, pHeadArrow, pTailArrow, oCanvas)
if oArc is not missing value then
tell oArc
--set value of user data item pstrArcData to "{From:" & idLast & ", To:" & idNext & "}"
set idArc to its id
end tell
end if
set rTheta to rNext
set rNext to rTheta + rDelta
end repeat
end if
end tell
end repeat
end tell
end run

-- CENTER, RADIUS, FROM DEGREES, TO DEGREES, WIDTH,
-- BEZIER POINTS PER DEGREE OF ARC, HEAD ARROW, TAIL ARROW
on MakeArc(pblnBlockArrow, {rX, rY}, rRadius, rFrom, rTo, rWidth, rPointsPerDegree, blnHeadArrow, blnTailArrow, oCanvas)
-- (CURRENTLY A SIMPLE FUNCTION OF THE ARROW WIDTH)
set {rStart, rEnd} to {rFrom, rTo}

if pblnBlockArrow then
-- CALCULATE THE LENGTH OF ANY ARROWS
if (blnHeadArrow or blnTailArrow) then
set rArrow to (rWidth / (pi * rRadius)) * 180
if blnHeadArrow then set rEnd to rTo - rArrow
if blnTailArrow then set rStart to rFrom + rArrow
end if
end if

-- AND THE AMOUNT OF ARC WHICH IT TRAVELS
set rArc to rEnd - rStart
if rArc < 0 then set rArc to (rEnd + 360) - rStart

-- HOW MANY POINTS WILL WE USE TO DRAW THE SHAFT ?
set lngPoints to (rArc * rPointsPerDegree) as integer
if lngPoints > 0 then
set rDelta to rArc / lngPoints

if pblnBlockArrow then
set oGraphic to BlockArrow(oCanvas, {rX, rY}, rFrom, rTo, rStart, rEnd, rDelta, lngPoints, rWidth, blnHeadArrow, blnTailArrow, rRadius)
else
set oGraphic to ArcArrow(oCanvas, {rX, rY}, rFrom, rTo, rDelta, lngPoints, blnHeadArrow, blnTailArrow, rRadius)
end if

return oGraphic
else
return missing value
end if
end MakeArc

on ArcArrow(oCanvas, {rX, rY}, rFrom, rTo, rDelta, lngPoints, blnHeadArrow, blnTailArrow, rRadius)
set rTheta to rFrom
set lstPoints to {}
repeat with i from 1 to lngPoints
set end of lstPoints to {rX + (rRadius * (sin(rTheta))), rY - rRadius * (cos(rTheta))}
set rTheta to rTheta + rDelta
end repeat
set end of lstPoints to {rX + (rRadius * (sin(rTheta))), rY - rRadius * (cos(rTheta))}

-- property pstrLineArrowHead : "FilledArrow"
-- property plstLineArrowColor : {1.0, 0.0, 0.0}
-- property plngLineArrowThickness : 2
-- property pblnLineArrowShadow : true

tell application id "OGfl"
tell oCanvas
set recStyle to {draws stroke:true, thickness:prLineArrowThickness, draws shadow:pblnLineArrowShadow, stroke color:plstLineArrowColor}
if blnHeadArrow then set recStyle to recStyle & {head type:pstrLineArrowHead}
if blnTailArrow then set recStyle to recStyle & {tail type:pstrLineArrowHead}
set oLine to (make new line with properties {point list:lstPoints, line type:curved} & recStyle)
end tell
end tell
return oLine
end ArcArrow

on BlockArrow(oCanvas, {rX, rY}, rFrom, rTo, rStart, rEnd, rDelta, lngPoints, rWidth, blnHeadArrow, blnTailArrow, rRadius)

-- GET THE INNER AND OUTER RADII OF THE BLOCK ARROW
set rW to rWidth / 2
set {rRadOut, rRadin} to {rRadius + rW, rRadius - rW}

-- COLLECT THE POINTS FOR THE OUTER AND INNER FLANKS OF THE ARROW
set {lstOuter, lstInner} to {{}, {}}
set rTheta to rStart
repeat with i from 1 to lngPoints
set {dX, dY} to {sin(rTheta), cos(rTheta)}
set end of lstOuter to {rX + (rRadOut * dX), rY - rRadOut * dY}
set end of lstInner to {rX + (rRadin * dX), rY - rRadin * dY}
set rTheta to rTheta + rDelta
end repeat
set {dX, dY} to {sin(rTheta), cos(rTheta)}
set end of lstOuter to {rX + (rRadOut * dX), rY - rRadOut * dY}
set end of lstInner to {rX + (rRadin * dX), rY - rRadin * dY}

-- MAKE HEAD AND/OR TAIL ARROWS IF REQUIRED
set {lstHead, lstTail} to {{}, {}}
set {rInnerBarb, rOuterBarb} to {rRadius - rWidth, rRadius + rWidth}
-- TAIL ARROW ?
if blnTailArrow then
-- inner barb, tip, outer barb
set lstTail to {{rX + (rInnerBarb * (sin(rStart))), rY - rInnerBarb * (cos(rStart))}, ¬
{rX + (rRadius * (sin(rFrom))), rY - rRadius * (cos(rFrom))}, ¬
{rX + (rOuterBarb * (sin(rStart))), rY - rOuterBarb * (cos(rStart))}}
end if
-- HEAD ARROW ?
if blnHeadArrow then
set lstHead to {{rX + (rOuterBarb * (sin(rEnd))), rY - rOuterBarb * (cos(rEnd))}, ¬
{rX + (rRadius * (sin(rTo))), rY - rRadius * (cos(rTo))}, ¬
{rX + (rInnerBarb * (sin(rEnd))), rY - rInnerBarb * (cos(rEnd))}}
end if

-- JOIN THE SHAFT TO ANY ARROW TIPS
set lstPoints to (lstOuter & lstHead & reverse of lstInner & lstTail)

-- GATHER THE POINTS IN THE TRIPLET FORMAT EXPECTED FOR CUSTOM SHAPES
set oFirstPoint to item 1 of lstPoints
set lstBezier to {oFirstPoint, oFirstPoint}
repeat with i from 2 to length of lstPoints
set oPoint to item i of lstPoints
set lstBezier to lstBezier & {oPoint, oPoint, oPoint}
end repeat
set end of lstBezier to oFirstPoint

-- AND RETURN A CUSTOM SHAPE
tell application id "OGfl"
tell oCanvas to set oShape to make new shape with properties {point list:lstBezier, draws stroke:true, stroke color:plstBlockArrowLineColor}
set notes of oShape to "From " & rFrom & "º" & return & "To " & rTo & "º"
end tell
return oShape
end BlockArrow

-- If Lion is running, are we in full screen mode ?
on isFullScreen(strAppID)
tell application "Finder" to set blnPreLion to (version < "10.7")
if blnPreLion then
return false
else
tell application id "sevs"
set lstApps to application processes where creator type = strAppID
if length of lstApps < 1 then return false
set lstWins to windows of first item of lstApps
if length of lstWins < 1 then return false
return value of attribute "AXFullScreen" of item 1 of lstWins
end tell
end if
end isFullScreen

-- on sin(rDegrees)
-- (do shell script "echo 'echo $((sin(" & (rDegrees / 180) * pi & ")))' | ksh") as number
-- end sin
--
-- on cos(rDegrees)
-- (do shell script "echo 'echo $((cos(" & (rDegrees / 180) * pi & ")))' | ksh") as number
-- end cos
--
-- on sin(rDegrees)
-- (do shell script "echo 's(" & (rDegrees / 180) * pi & ")' | bc -l") as number
-- end sin
--
-- on cos(rDegrees)
-- (do shell script "echo 'c(" & (rDegrees / 180) * pi & ")' | bc -l") as number
-- end cos

-- BASIC TRIG FUNCTIONS PUBLISHED BY OTHERS
-- COULD USE THE KSH SHELL, BUT THESE ARE PROBABLY FASTER ...

-- Trig functions from:
-- http://lists.apple.com/archives/applescript-users/2004/Feb/msg00939.html

on cos(x) -- degrees
local myCos, numerator, denominator, factor

set myCos to 0
if (x = 90) or (x = 270) then
set myCos to 0
else
set x to (x - (((x / 360) div 1) * 360)) * (pi / 180)
set {myCos, numerator, denominator, factor} to {0, 1, 1, -(x ^ 2)}
repeat with i from 2 to 40 by 2
set myCos to myCos + numerator / denominator
set numerator to numerator * factor
set denominator to denominator * i * (i - 1)
end repeat
end if
return myCos
end cos
--
-- ----------------------------
on sin(x) -- degrees
local mySin, numerator, denomintator, factor

set mySin to 0
if (x = 180) or (x = 360) then
set mySin to 0
else
set x to (x - (((x / 360) div 1) * 360)) * (pi / 180)
set {mySin, numerator, denominator, factor} to {0, x, 1, -(x ^ 2)}
repeat with i from 3 to 40 by 2
set mySin to mySin + numerator / denominator
set numerator to numerator * factor
set denominator to denominator * i * (i - 1)
end repeat
end if
return mySin
end sin

[/CODE]