/* ***************************************************************************** /* /* GEOLOGICAL SURVEY OF CANADA /* --------------------------- /* /* Name: scalebar.aml /* Usage: SCALEBAR {E | F} {page_x} {page_y} /* SCALEBAR /* {E | F} {page_x} {page_y} /* Arc version: 7.0.3 /* Module: Arcplot /* OS: Solaris 2.4 /* Platform: Sun SPARCstation10 /* /* Purpose: Draws scale bar according to GSC specifications or by user /* defined parameters and assigns four variables to the x,y /* coordinates for the projection and copyright notes under the /* scale bar. /* /* Arguments: scale - scale denomintor of map /* args - the remaining arguments /* Globals: .X - x coordinate of center of scale bar /* .Y - y coordinate for baseline of text below scale bar /* Locals: echo - current setting of &echo /* mess - current setting of &messages /* D - number of divisions on scale bar /* DL - length of each division /* SD - number of sub-divisions, left of zero /* language - language of scale bar /* XC - x page coordinate, center of scale bar /* Y - y page coordinate, baseline of scale bar title /* n - used as extract value, counter for assigning Xn variable, /* and loop action /* units - current setting of UNITS /* weed - current setting of WEEDDRAW /* mapunits - current setting of MAPUNITS /* angle - current setting of MAPANGLE /* lineset - current LINESET /* linescale - current LINESCALE setting /* textset - current TEXTSET /* textscale - current TEXTSCALE setting /* scale_text - convert scale to include spaces, appears in title /* unit_threshold - scale denomintor to specify if metres or /* kilometres appear on scale bar /* SDL - length of each sub-division /* I - interval text that appears above scale bar /* K - constant, what 1 metre in inches equals /* P - page constant for plotting when page units or CM or INCHES /* YT - y coordinate for text above scale bar /* YU - upper y coordinate for scale bar /* YM - middle y coordinate for scale bar /* YL - lower y coordinate for scale bar /* XMIN - left x coordinate of scale bar /* XMAX - right x coordinate of scale bar /* Xn - x coordinate for scale bar intervals /* a - counter, loop action /* text - text that appears above scale bar, used with I /* /* Called by: user /* Calls made: none /* /* History: Original coding by Vic Dohar, April 1993 /* Updated to version 7.0, Vic Dohar /* /* ***************************************************************************** /* /* CROWN COPYRIGHTS RESERVED /* /* NO GUARANTEE IS MADE BY THE AUTHOR(S) OR THE GEOLOGICAL SURVEY OF /* CANADA REGARDING EITHER THE ACCURACY OF THIS PROGRAM OR THE PROPER /* EXECUTION ON ALL COMPUTER SYSTEMS. /* /* ***************************************************************************** &args scale args:rest &severity &warning &ignore &severity &error &routine ERROR /* Setting environment variables &s echo [show &echo] &echo &off &s mess [show &messages] &mess &off &all /* Check if user is running Arcplot &if [show program] ne ARCPLOT &then &do &ty This AML can only run from Arcplot &echo %echo% &mess %mess% &return &end /* then do /* Check if scale specified and is an integer between 10,000 and 10,000,000 &if [null %scale%] &then &call USAGE &if [type %scale%] ne -1 &then &call USAGE &if %scale% lt 5000 or %scale% gt 10000000 &then &do &ty Scale denomoinator must between 5000 and 10,000,000 &call USAGE &end /* then do /* Sort out remaining arguments /* Check if defaults are to be used &if [null [unquote %args%]] &then &do &call PARAMETERS &s SD 5 &s language E &s XC [extract 1 [show where current]] &s Y [extract 2 [show where current]] &end /* then do &else &do /* Check if user defining scale bar parameters &if [type [extract 1 [unquote %args%]]] lt 0 &then &do /* Check if third argument is also entered &if [null [extract 3 [unquote %args%]]] &then &call USAGE /* Verify that first three arguments are integers &if [type [extract 1 [unquote %args%]]] ne -1 or ~ [type [extract 2 [unquote %args%]]] ne -1 or ~ [type [extract 3 [unquote %args%]]] ne -1 &then &call USAGE &else &do &s D [extract 1 [unquote %args%]] &s DL [extract 2 [unquote %args%]] &s SD [extract 3 [unquote %args%]] /* Check that the number of division is two or more &if %D% le 1 &then &do &ty Two or more divisions are required. &call USAGE &end /* then do /* Check that the division length is greater than zero &if %DL% le 0 &then &do &ty Division length must be greater than zero. &call USAGE &end /* then do /* Check that the number of subdivisions is 2 or more &if %SD% le 1 &then &do &ty Two or more subdivisions are required. &call USAGE &end /* then do &end /* else do /* Set extract value &s n 4 &end /* then do &else &do /* Using default scale bar parameters &call PARAMETERS &s SD 5 /* Set extract value &s n 1 &end /* else do /* Check if user defining language preference &if [null [extract %n% [unquote %args%]]] &then &do &s language E &s XC [extract 1 [show where current]] &s Y [extract 2 [show where current]] &end /* then do &else &do /* Verify that next argument is a character for language prefernce &if [type [extract %n% [unquote %args%]]] ne 1 &then &call USAGE /* Set language preference &select [translate [extract %n% [unquote %args%]]] &when E, # &s language E &when F &s language F &otherwise &call USAGE &end /* select /* Increment extract value &s n %n% + 1 /* Check if both page coordinates entered &if [null [extract %n% [unquote %args%]]] &then &do &s XC [extract 1 [show where current]] &s Y [extract 2 [show where current]] &end /* then do &else &do /* Set first coordinate &if [type [extract %n% [unquote %args%]]] lt 0 &then &s XC [extract %n% [unquote %args%]] &else &do &if [extract %n% [unquote %args%]] eq # &then &s XC [extract 1 [show where current]] &else &call USAGE &end /* else do /* Check if secong coordinate entered, increment extract value &s n %n% + 1 &if [null [extract %n% [unquote %args%]]] &then &s Y [extract 2 [show where current] &else &do /* Set second coordinate &if [type [extract %n% [unquote %args%]]] lt 0 &then &s Y [extract %n% [unquote %args%]] &else &do &if [extract %n% [unquote %args%]] eq # &then &s Y [extract 2 [show where current]] &else &call USAGE &end /* else do &end /* else do &end /* else do &end /* else do &end /* else do /* Saving current arcplot environment settings &s units [show units] &s weed [show weeddraw] &s mapunits [show mapunits] &s angle [show mapangle] &s lineset [show lineset] &s linescale [show linescale] &s textset [show textset] &s textscale [show textscale] /* Convert to scale denominator to include spaces &s scale_text [substr %scale% [calc [length %scale%] - 2] 3] &select [length %scale%] &when 4 &s scale_text %scale% &when 5 &s scale_text [substr %scale% 1 2] %scale_text% &when 6 &s scale_text [substr %scale% 1 3] %scale_text% &when 7; &do &s scale_text [substr %scale% [calc [length %scale%] - 5] 3] %scale_text% &s scale_text [substr %scale% 1 1] %scale_text% &end /* when 7 &when 8; &do &s scale_text [substr %scale% [calc [length %scale%] - 5] 3] %scale_text% &s scale_text [substr %scale% 1 2] %scale_text% &end /* when 8 &end /* select /* Scale bar title TEXTDELETE ALL TEXTFONT 'Triumvirate' TEXTCOLOR CMYK -1 -1 -1 100 TEXTQUALITY PROPORTIONAL TEXTSIZE 10 # PT MOVE %XC% %Y% &if [translate %language%] eq E &then TEXT [quote Scale 1:%scale_text% - Échelle 1/%scale_text%] LC &else TEXT [quote Échelle 1/%scale_text% - Scale 1:%scale_text%] LC /* Set threshold for metres or kilometer values on top of scale bar depending /* on scale &s unit_threshold 40000 /* Calculate sub-division length and interval text to appear on top of scale bar &s SDL [calc %DL% / %SD%] &if %scale% lt %unit_threshold% &then &s I %DL% &else &s I [calc %DL% / 1000] /* Set scale factor constant and page factor &s K ( 100 / 2.54 ) &if [show pageunits] eq INCHES &then &s P 1 &if [show pageunits] eq CM &then &s P 2.54 /* Calculate coordinates for scale bar &s YT %Y% - ( %P% * 0.23 ) &s YU %YT% - ( %P% * 0.02 ) &s YM %YU% - ( %P% * 0.03 ) &s YL %YU% - ( %P% * 0.06 ) /* Draw box LINEDELETE ALL LINETYPE WIDE LINESIZE 0.004 LINEPEn 0.004 BUTT MITER LINECOLOR CMYK -1 -1 -1 100 &s XMIN %XC% - ( ( ( 0.5 * %D% * %DL% * %K% ) / %scale% ) * %P% ) &s XMAX %XC% + ( ( ( 0.5 * %D% * %DL% * %K% ) / %scale% ) * %P% ) BOX %XMIN% %YL% %XMAX% %YU% /* Calculate divisions &s n 0 &do &while %n% lt [calc %D% - 1] &s n %n% + 1 &s X%n% %XMIN% + ( %n% * ( ( ( %DL% * %K% ) / %scale% ) * %P% ) ) &end /* do while /* Draw division lines &s a 1 &do &while %a% le %n% LINE [value X%a%] %YL% [value X%a%] %YU% &s a %a% + 1 &end /* do while /* Add middle lines in divisions (right of 0 is always blank) LINETYPE WIDE LINESIZE 0.015 LINEPEn 0.015 BUTT MITER LINECOLOR CMYK -1 -1 -1 100 &s a 2 &do &while %a% le %n% &if %a% eq %n% &then LINE [value X%a%] %YM% %XMAX% %YM% &else LINE [value X%a%] %YM% [value X[calc 1 + %a%]] %YM% &s a %a% + 2 &end /* do while /* Add scalebar text TEXTFONT 'Triumvirate Condensed' TEXTCOLOR CMYK -1 -1 -1 100 TEXTQUALITY PROPORTIONAL TEXTSIZE 8 # PT MOVE [calc %XMIN% - 0.16] %YT% &if [translate %language%] eq E &then &do &if %scale% lt %unit_threshold% &then TEXT Metres LR &else TEXT Kilometres LR &end /* then do &else &do &if %scale% lt %unit_threshold% &then TEXT Mètres LR &else TEXT Kilomètres LR &end /* else do MOVE %XMIN% %YT% TEXT [quote %I%] LC &s a 1 &s text 0 &do &while %a% le %n% MOVE [value X%a%] %YT% TEXT [quote %text%] LC &s text %text% + %I% &s a %a% + 1 &end /* do while MOVE %XMAX% %YT% TEXT [quote %text%] LC MOVE [calc %XMAX% + 0.16] %YT% &if [translate %language%] eq F &then &do &if %scale% lt %unit_threshold% &then TEXT Metres LL &else TEXT Kilometres LL &end /* then do &else &do &if %scale% lt %unit_threshold% &then TEXT Mètres LL &else TEXT Kilomètres LL &end /* else do /* Calculate sub division &s n 0 &s XMAX %X1% &do &while %n% lt [calc %SD% - 1] &s n %n% + 1 &s X%n% %XMAX% - ( %n% * ( ( ( %SDL% * %K% ) / %scale% ) * %P% ) ) &end /* do while /* Draw sub division lines LINETYPE WIDE LINESIZE 0.004 LINEPEn 0.004 BUTT MITER LINECOLOR CMYK -1 -1 -1 100 &s a 1 &do &while %a% le %n% LINE [value X%a%] %YL% [value X%a%] %YU% &s a %a% + 1 &end /* do while /* Add middle lines in subdivision (left of 0 always has a line) LINETYPE WIDE LINESIZE 0.015 LINEPEn 0.015 BUTT MITER LINECOLOR CMYK -1 -1 -1 100 LINE %XMAX% %YM% %X1% %YM% &s a 2 &do &while %a% le %n% &if %a% eq %n% &then LINE [value X%a%] %YM% %XMIN% %YM% &else LINE [value X%a%] %YM% [value X[calc 1 + %a%]] %YM% &s a %a% + 2 &end /* do while /* Resetting Arcplot environment &call RESET /* Assign global variables to the x,y coordinates of the two columns under the /* scale bar for the projection and copyright notes. These can be used by the /* user to add projection and copyright text &s .X %XC% &s .Y %YL% - ( %P% * 0.25 ) &return /* ----------------------------------------------------------------------------- &routine PARAMETERS /* Assign divisions and division length based on scale entered &if %scale% ge 5000 and %scale% lt 10000 &then &do &s D 5 &s DL 100 &end /* then do &if %scale% ge 10000 and %scale% lt 15000 &then &do &s D 5 &s DL 250 &end /* then do &if %scale% ge 15000 and %scale% lt 20000 &then &do &s D 7 &s DL 250 &end /* then do &if %scale% ge 20000 and %scale% lt 30000 &then &do &s D 5 &s DL 500 &end /* then do &if %scale% ge 30000 and %scale% lt 40000 &then &do &s D 7 &s DL 500 &end /* then do &if %scale% ge 40000 and %scale% lt 60000 &then &do &s D 5 &s DL 1000 &end /* then do &if %scale% ge 60000 and %scale% lt 70000 &then &do &s D 6 &s DL 1000 &end /* then do &if %scale% ge 70000 and %scale% lt 80000 &then &do &s D 7 &s DL 1000 &end /* then do &if %scale% ge 80000 and %scale% lt 120000 &then &do &s D 5 &s DL 2000 &end /* then do &if %scale% ge 120000 and %scale% lt 150000 &then &do &s D 6 &s DL 2000 &end /* then do &if %scale% ge 150000 and %scale% lt 180000 &then &do &s D 7 &s DL 2000 &end /* then do &if %scale% ge 180000 and %scale% lt 280000 &then &do &s D 5 &s DL 5000 &end /* then do &if %scale% ge 280000 and %scale% lt 340000 &then &do &s D 6 &s DL 5000 &end /* then do &if %scale% ge 340000 and %scale% lt 400000 &then &do &s D 7 &s DL 5000 &end /* then do &if %scale% ge 400000 and %scale% lt 600000 &then &do &s D 5 &s DL 10000 &end /* then do &if %scale% ge 600000 and %scale% lt 800000 &then &do &s D 6 &s DL 10000 &end /* then do &if %scale% ge 800000 and %scale% lt 1300000 &then &do &s D 4 &s DL 25000 &end /* then do &if %scale% ge 1300000 and %scale% lt 2300000 &then &do &s D 4 &s DL 50000 &end /* then do &if %scale% ge 2300000 and %scale% lt 2800000 &then &do &s D 5 &s DL 50000 &end /* then do &if %scale% ge 2800000 and %scale% lt 3400000 &then &do &s D 6 &s DL 50000 &end /* then do &if %scale% ge 3400000 and %scale% lt 4000000 &then &do &s D 7 &s DL 50000 &end /* then do &if %scale% ge 4000000 and %scale% lt 6000000 &then &do &s D 5 &s DL 100000 &end /* then do &if %scale% ge 6000000 and %scale% lt 8000000 &then &do &s D 6 &s DL 100000 &end /* then do &if %scale% ge 8000000 and %scale% le 10000000 &then &do &s D 4 &s DL 250000 &end /* then do &return &routine USAGE &ty Usage: SCALEBAR {E | F} {page_x} {page_y} &ty SCALEBAR &ty {E | F} {page_x} {page_y} &echo %echo% &mess %mess% &return; &return &routine RESET MAPUNITS %mapunits% MAPANGLE %angle% LINEDELETE ALL LINESET %lineset% LINESCALE %linescale% TEXTDELETE ALL TEXTSET %textset% TEXTSCALE %textscale% UNITS %units% &echo %echo% &mess %mess% &return &routine ERROR &severity &error &ignore &call RESET &ty *** An error has occured plotting the Scale bar *** &return; &return