/* ***************************************************************************** /* /* GEOLOGICAL SURVEY OF CANADA /* --------------------------- /* /* Name: border.aml /* Arc version: 7.0.3 /* /* Purpose: To create a map border with graticules according to GSC /* specifications. No annotation is added around the border, nor /* are the graticule polygons coded as to be shaded white or black. /* This must be done manually in Arcedit. /* /* Called by: border.menu /* Calls made: msg.menu /* borderprj.menu /* borderntl.menu /* borderfin.menu /* /* History: - original coding, Vic Dohar, July 1992 /* - changes to avoid crash from TOO MANY ALIASES, V. Dohar, /* May 1993 /* - added NODESNAP CLOSEST 0 when constructing graticule corners /* to avoid snapping of nodes to another dangle, V. Dohar, /* August 1993 /* - check on length of cover name, V. Dohar, August 1993 /* - clean & create label points after completion, V. Dohar, Jan 94 /* - major changes to code: 1) user only has to input latitude and /* longitude extremes and scale 2) default values are used for /* tick and subdivision intervals according to GSC specifications /* 3) starting coordinate of subdivisions is handeled by program /* 4) new code in adding subdivisions. V. Dohar, July 1994. /* - addition of subgraticule alongside neatline /* - this version has been converted to using menus accessible only /* from the gscmenu system; the old border.aml accessible from /* the prompt has been renamed to borderold.aml /* V. Dohar, July 1994 /* - construction is fully automated, no more manually delete the /* corner buffers; and lat and long values are added as /* annotation features (what a task), V. Dohar, Sept 1994 /* - upgraded to A/I version 7.0 and WIMP for 7.0, Sept 1995 /* - altered method of creating border elements, used COPY PARALLEL /* instead of BUFFERing and APPENDing and creating corners in AE. /* - additions to conform to GSC Database Standards /* /* ***************************************************************************** /* /* 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. /* /* ***************************************************************************** /* Defaults for AML &if [show &echo] eq &ON &then &s mess &on &else &s mess &off &all &messages %mess% &severity &warning &ignore &severity &error &routine ERROR /* VALIDATING INPUT FROM MENU /* -------------------------- /* Check that the cover is not more than 10 characters in length &if [length %.brd$cover%] gt 10 &then &do &s .gsc$msg Cover cannot be more than 10 characters long &thread &create msg &modal &menu msg &position ¢er &thread border ~ &pinaction '&s .brd$cover' &stripe 'Message!' &return &end /* then do /* Convert latitudes and lonitudes to decimal minutes &if %.brd$wdeg% lt 0 &then &s west [calc ( %.brd$wdeg% * 60 ) - %.brd$wmin% - ( %.brd$wsec% / 60 )] &else &s west [calc ( %.brd$wdeg% * 60 ) + %.brd$wmin% + ( %.brd$wsec% / 60 )] &if %.brd$edeg% lt 0 &then &s east [calc ( %.brd$edeg% * 60 ) - %.brd$emin% - ( %.brd$esec% / 60 )] &else &s east [calc ( %.brd$edeg% * 60 ) + %.brd$emin% + ( %.brd$esec% / 60 )] &if %.brd$sdeg% lt 0 &then &s south [calc ( %.brd$sdeg% * 60 ) - %.brd$smin% - ( %.brd$ssec% / 60 )] &else &s south [calc ( %.brd$sdeg% * 60 ) + %.brd$smin% + ( %.brd$ssec% / 60 )] &if %.brd$ndeg% lt 0 &then &s north [calc ( %.brd$ndeg% * 60 ) - %.brd$nmin% - ( %.brd$nsec% / 60 )] &else &s north [calc ( %.brd$ndeg% * 60 ) + %.brd$nmin% + ( %.brd$nsec% / 60 )] /* Check if northern latitude is north of southern latitude &if %north% le %south% &then &do &s .gsc$msg Northern latitude not north of southern latitude &thread &create msg &modal &menu msg &position ¢er &thread border ~ &stripe 'Message!' &return &end /* then do /* Check if eastern longitude is east of western longitude &if %east% le %west% &then &do &s .gsc$msg Eastern longitude not east of western longitude &thread &create msg &modal &menu msg &position ¢er &thread border ~ &stripe 'Message!' &return &end /* then do /* Calculating tick extensions distance in DD for generate procedure. &s dist %.brd$scale% * 0.00004 /* 0.00004 is the constant for all scales &if [abs %north%] ge [calc 68 * 60] or [abs %south%] ge [calc 68 * 60] &then &s dist %dist% * 2 &s dist %dist% / 60 /* convert minutes to DD /* Delete input menus &if [show &thread &exists borderextra] &then &thread &delete borderextra /* GET PROJECTION INFORMATION /* -------------------------- /* Calculate densify distance &s n [calc ( %.brd$latsubint% / 60 ) / 4] &s densifydist [truncate %n%].[substr [after %n% .] 1 5] &thread &focus &on &self &do &until %continue% &menu borderprj &position &below &thread wimp &pinaction ~ '&s continue .FALSE.' &stripe 'Project Map Border' &end /* do until /* GENERATE NEATLINE COVER /* ----------------------- &s neatline_geo [scratchname -prefix brd -directory] GENERATE %neatline_geo% /* &messages &off &all &s severity GENERATE &ty \Generating neatline for border cover /* Adding one continuous neatline with starting and ending point between /* western and eastern longitudes along southern latitude LINES 1 [calc ( %west% + ( ( %east% - %west% ) / 2 ) ) / 60] [calc %south% / 60] [calc %west% / 60] [calc %south% / 60] [calc %west% / 60] [calc %north% / 60] [calc %east% / 60] [calc %north% / 60] [calc %east% / 60] [calc %south% / 60] [calc ( %west% + ( ( %east% - %west% ) / 2 ) ) / 60] [calc %south% / 60] END END QUIT /* GENERATE BORDER COVER /* --------------------- /* Variables for text scaling of minutes and seconds &s textfactor 0.8 &s typeset '!SCA0.8;' /* Generate cover in decimal degrees. &s tick_geo [scratchname -prefix brd -directory] GENERATE %tick_geo% &mess %mess% &s severity GENERATE &ty \Generating border cover ... /* Adding corner tics TICS 1 [calc %west% / 60] [calc %south% / 60] 2 [calc %east% / 60] [calc %south% / 60] 3 [calc %west% / 60] [calc %north% / 60] 4 [calc %east% / 60] [calc %north% / 60] END /* Adding neatline with a -ID = 1 LINES 1 [calc %west% / 60] [calc %south% / 60] [calc %west% / 60] [calc %north% / 60] END 1 [calc %west% / 60] [calc %north% / 60] [calc %east% / 60] [calc %north% / 60] END 1 [calc %east% / 60] [calc %north% / 60] [calc %east% / 60] [calc %south% / 60] END 1 [calc %east% / 60] [calc %south% / 60] [calc %west% / 60] [calc %south% / 60] END /* Adding ticks and subdivisions along longitude lines going north. /* Calculate starting latitude &s lattickid 100 &s line lat &s lasttick .FALSE. &if [type [calc %south% / %.brd$latsubint%]] eq -2 &then &do %lattickid% [calc %west% / 60] [calc %south% / 60] [calc ( %west% / 60 ) - %dist%] [calc %south% / 60] END [calc %lattickid% + 100] [calc %east% / 60] [calc %south% / 60] [calc ( %east% / 60 ) + %dist%] [calc %south% / 60] END &s lat %south% &call TICKVALUE &if %south% lt 0 &then &s lat [calc %.brd$latsubint% * [truncate ~ [calc %south% / %.brd$latsubint%]]] &else &s lat [calc %.brd$latsubint% * ( 1 + [truncate ~ [calc %south% / %.brd$latsubint%]] )] &s lattickid 101 &end /* then do &else &s lat %south% &s startlat %lat% /* Add subdivisions and ticks until north latitiude is surpassed &do &until %lat% ge %north% &if %lattickid% eq 100 or ~ [type [calc %lat% / %.brd$lattickint%]] eq -1 &then &do %lattickid% [calc %west% / 60] [calc %lat% / 60] [calc ( %west% / 60 ) - %dist%] [calc %lat% / 60] END [calc %lattickid% + 100] [calc %east% / 60] [calc %lat% / 60] [calc ( %east% / 60 ) + %dist%] [calc %lat% / 60] END &call TICKVALUE &s lattickid [calc %lattickid% + 1] &end /* then do &else &do 7 [calc %west% / 60] [calc %lat% / 60] [calc ( %west% / 60 ) - %dist%] [calc %lat% / 60] END 7 [calc %east% / 60] [calc %lat% / 60] [calc ( %east% / 60 ) + %dist%] [calc %lat% / 60] END &end /* else do &s lat [calc %lat% + [abs %.brd$latsubint%]] &end /* do until /* Plot north tick %lattickid% [calc %west% / 60] [calc %north% / 60] [calc ( %west% / 60 ) - %dist%] [calc %north% / 60] END [calc %lattickid% + 100] [calc %east% / 60] [calc %north% / 60] [calc ( %east% / 60 ) + %dist%] [calc %north% / 60] END &s lasttick .TRUE. &s lat %north% &call TICKVALUE /* Assign values to latitude ticks on east side &do x = 100 &to %lattickid% &by 1 &s tick[calc %x% + 100] [value tick%x%] &end /* do to by /* Calculate starting longitude &s longtickid 300 &s line long &s lasttick .FALSE. &if [type [calc %west% / %.brd$longsubint%]] eq -2 &then &do %longtickid% [calc %west% / 60] [calc %south% / 60] [calc %west% / 60] [calc %south% / 60 - %dist%] END [calc %longtickid% + 100] [calc %west% / 60] [calc %north% / 60] [calc %west% / 60] [calc ( %north% / 60 ) + %dist%] END &s long %west% &call TICKVALUE &if %west% lt 0 &then &s long [calc %.brd$longsubint% * [truncate ~ [calc %west% / %.brd$longsubint%]]] &else &s long [calc %.brd$longsubint% * ( 1 + [truncate ~ [calc %west% / %.brd$longsubint%]] )] &s longtickid 301 &end /* then do &else &s long %west% &s startlong %long% /* Add subdivisions and ticks until east longitude is surpassed &do &until %long% ge %east% &if %longtickid% eq 300 or ~ [type [calc %long% / %.brd$longtickint%]] eq -1 &then &do %longtickid% [calc %long% / 60] [calc %south% / 60] [calc %long% / 60] [calc ( %south% / 60 ) - %dist%] END [calc %longtickid% + 100] [calc %long% / 60] [calc %north% / 60] [calc %long% / 60] [calc ( %north% / 60 ) + %dist%] END &call TICKVALUE &s longtickid [calc %longtickid% + 1] &end /* then do &else &do 7 [calc %long% / 60] [calc %south% / 60] [calc %long% / 60] [calc ( %south% / 60 ) - %dist%] END 7 [calc %long% / 60] [calc %north% / 60] [calc %long% / 60] [calc ( %north% / 60 ) + %dist%] END &end /* else do &s long [calc %long% + [abs %.brd$longsubint%]] &end /* do until /* Plot east tick %longtickid% [calc %east% / 60] [calc %south% / 60] [calc %east% / 60] [calc ( %south% / 60 ) - %dist%] END [calc %longtickid% + 100] [calc %east% / 60] [calc %north% / 60] [calc %east% / 60] [calc ( %north% / 60 ) + %dist%] END &s lasttick .TRUE. &s long %east% &call TICKVALUE /* Assign values to longitude ticks on north side &do x = 300 &to %longtickid% &by 1 &s tick[calc %x% + 100] [value tick%x%] &end /* do to by /* End of generate. END QUIT /* GENERATE SUBGRATICULE COVER /* --------------------------- /* Subgraticules are created between the neatline and the border graticule /* based on the number of divisions the user requested within both the /* latitude and longitude subdivision interval. The process for adding /* subgraticules is the same for both latitude and longitude lines. /* The subgraticule interval is calculated by dividing the number of /* subgraticule divisions per subdivision by the subdivision interval. /* Subgraticules are then added per subdivision until it exceeds the /* north latitude or east longitude or until the next subdivision is /* encountered. The subdivision interval is then plotted and the process /* repeats itself until the limit is reached. If the starting subdivision /* interval is not the same as the southern latitude or western longitude, then /* subgraticules are added in the reverse direction until they exceed those /* limits. /* Check if subgraticules are requested &if %.brd$subgrat% &then &do /* Check if subdivision intervals are entered &if [null %.brd$longsubgratdiv%] &then &s .brd$longsubgratdiv 1 &if [null %.brd$latsubgratdiv%] &then &s .brd$latsubgratdiv 1 /* Begin to generate subgraticule cover &s subgrat_geo [scratchname -prefix brd -directory] GENERATE %subgrat_geo% &ty \Generating subgraticule cover ... /* Adding neatline with a -ID = 1. LINES 1 [calc %west% / 60] [calc %south% / 60] [calc %west% / 60] [calc %north% / 60] END 1 [calc %west% / 60] [calc %north% / 60] [calc %east% / 60] [calc %north% / 60] END 1 [calc %east% / 60] [calc %north% / 60] [calc %east% / 60] [calc %south% / 60] END 1 [calc %east% / 60] [calc %south% / 60] [calc %west% / 60] [calc %south% / 60] END /* Add subgraticules along longitude line going north &if %startlat% ne %south% &then &do &s lat %startlat% &do a = 1 &to %.brd$latsubgratdiv% &by 1 &until %lat% <= %south% 8 [calc %west% / 60] [calc %lat% / 60] [calc ( %west% / 60 ) - %dist%] [calc %lat% / 60] END 8 [calc %east% / 60] [calc %lat% / 60] [calc ( %east% / 60 ) + %dist%] [calc %lat% / 60] END &s lat [calc %startlat% - ( %a% * ~ ( %.brd$latsubint% / %.brd$latsubgratdiv% ) )] &end /* do to by until &end /* then do &s lat %startlat% &s a 1 &do &while %lat% lt %north% &s lat [calc %lat% + ( %.brd$latsubint% / %.brd$latsubgratdiv% )] &do b = 1 &to %.brd$latsubgratdiv% &by 1 &while %lat% lt %north% 8 [calc %west% / 60] [calc %lat% / 60] [calc ( %west% / 60 ) - %dist%] [calc %lat% / 60] END 8 [calc %east% / 60] [calc %lat% / 60] [calc ( %east% / 60 ) + %dist%] [calc %lat% / 60] END &s lat [calc %lat% + ( %.brd$latsubint% / %.brd$latsubgratdiv% )] &end /* do to by while &s lat [calc %startlat% + ( %a% * %.brd$latsubint% )] &s a %a% + 1 &end /* do while /* Add subgraticules along latitude line going east &if %startlong% ne %west% &then &do &s long %startlong% &do a = 1 &to %.brd$longsubgratdiv% &by 1 &until %long% <= %west% 8 [calc %long% / 60] [calc %south% / 60] [calc %long% / 60] [calc ( %south% / 60 ) - %dist%] END 8 [calc %long% / 60] [calc %north% / 60] [calc %long% / 60] [calc ( %north% / 60 ) + %dist%] END &s long [calc %startlong% - ( %a% * ~ ( %.brd$longsubint% / %.brd$longsubgratdiv% ) )] &end /* do to by until &end /* then do &s long %startlong% &s a 1 &do &while %long% lt %east% &s long [calc %long% + ( %.brd$longsubint% / %.brd$longsubgratdiv% )] &do b = 1 &to %.brd$longsubgratdiv% &by 1 &while %long% lt %east% 8 [calc %long% / 60] [calc %south% / 60] [calc %long% / 60] [calc ( %south% / 60 ) - %dist%] END 8 [calc %long% / 60] [calc %north% / 60] [calc %long% / 60] [calc ( %north% / 60 ) + %dist%] END &s long [calc %long% + ( %.brd$longsubint% / %.brd$longsubgratdiv% )] &end /* do to by while &s long [calc %startlong% + ( %a% * %.brd$longsubint% )] &s a %a% + 1 &end /* do while END QUIT &end /* then do /* PROJECT AND/OR DENSIFY COVERS /* ----------------------------- /* Densify covers if requested before projecting &if %densifyoption% &then &do &ty \Densifying map border cover ... DENSIFYARC %neatline_geo% # %densifydist% DENSIFYARC %tick_geo% # %densifydist% &if %.brd$subgrat% &then &do &ty \Densifying subgraticule cover ... DENSIFYARC %subgrat_geo% # %densifydist% &end /* then do &end /* then do /* Project map border cover and kill geographic cover &s severity PROJECT &ty \Projecting map border cover to publication map projection ... &s neatline [scratchname -prefix brd -directory] PROJECT COVER %neatline_geo% %neatline% %prjfile% &s tick [scratchname -prefix brd -directory] PROJECT COVER %tick_geo% %tick% %prjfile% BUILD %neatline% LINE BUILD %tick% LINE /* Project subgraticules if required and kill geographic cover &if %.brd$subgrat% &then &do &ty \Projecting subgraticule cover to publication map projection ... &s subgrat [scratchname -prefix brd -directory] PROJECT COVER %subgrat_geo% %subgrat% %prjfile% BUILD %subgrat% LINE &end /* then do /* EXTRACT NEATLINE TO BORDER ELEMENTS /* ----------------------------------- &ty \Extracting border elements ... &s severity ELEMENTS /* Calculating distances in meters as per cartographic specifications in /* inches based on the final map scale. &s innergrat_dist [calc 0.040 * ( 0.0254 * %.brd$scale% )] &s outergrat_dist [calc 0.070 * ( 0.0254 * %.brd$scale% )] &s ticklimit_dist [calc 0.130 * ( 0.0254 * %.brd$scale% )] &s border1_dist [calc 0.609 * ( 0.0254 * %.brd$scale% )] &s border2_dist [calc 0.667 * ( 0.0254 * %.brd$scale% )] &s tolerance_dist [calc 0.005 * ( 0.0254 * %.brd$scale% )] &s fuzzy_dist [calc 0.002 * ( 0.0254 * %.brd$scale% )] ARCEDIT EDIT %neatline% ARC DRAWENVIRONMENT ARC ON DRAWENVIRONMENT NODE ERRORS NODECOLOR DANGLE BLUE NODECOLOR PSEUDO GREEN SETDRAWSYMBOL 0 RED NODESNAP OFF ARCSNAP OFF GRAIN [calc [show grain] / 10] &s id 2 &do element &list innergrat outergrat ticklimit border1 border2 SELECT ALL COPY PARALLEL [value [value element]_dist] CALCULATE [upcase %neatline%]-ID = %id% &s %element% [scratchname -prefix brd -directory] PUT [value %element%] DELETE &s id [calc %id% + 1] &end /* do list loop /* CONSTRUCT BORDER AND SUBGRAT /* ---------------------------- &ty \Assembling border ... &s severity ASSEMBLE /* Begin constructing subgraticule &if %.brd$subgrat% &then &do EDIT %subgrat% ARC /* Set inner graticule and save edit INTERSECTARCS ALL GET %innergrat% SAVE &end /* then do /* Begin constructing border graticule EDIT %tick% ARC SELECT [upcase %tick%]-ID = 1 /* Put neatline to NTL if it does not already exist &if %.brd$gscdatabase% and ^ [exists NTL%.carto$mapnumber% -cover] &then &do &ty \Creating [upcase NTL%.carto$mapnumber%] cover ... PUT NTL%.carto$mapnumber% &end /* then do /* Put neatline to temporary cover &s neatline_temp [scratchname -prefix brd -directory] PUT %neatline_temp% DELETE /* Get inner graticule INTERSECTARCS ALL GET %innergrat% /* Delete innergrat at corners &call SELECTCORNER &if [show number select] gt 0 &then DELETE /* Get outer graticule GET %outergrat% /* Save and quit ARCEDIT SAVE QUIT NO /* Clean graticule and subgraticule cover for any dangle nodes that have to be /* snapped to inner or outer graticule. CLEAN %tick% # 0 %fuzzy_dist% LINE &if %.brd$subgrat% &then CLEAN %subgrat% # 0 %fuzzy_dist% LINE /* Set item to add to SYMBOL or BOR-SYM &if %.brd$gscdatabase% &then &s item BOR-SYM &else &s item SYMBOL /* Add item ADDITEM %tick%.AAT %tick%.AAT %item% 4 4 I &if %.brd$subgrat% &then ADDITEM %subgrat%.AAT %subgrat%.AAT %item% 4 4 I /* Return to ARCEDIT to continue with graticule and subgraticule construction. ARCEDIT /* Resume construction of subgraticule &if %.brd$subgrat% &then &do EDIT %subgrat% ARC /* Delete all dangles, neatline and inner graticule SELECT DANGLE &if [show number select] gt 0 &then DELETE SELECT [upcase %subgrat%]-ID = 1 OR [upcase %subgrat%]-ID = 2 DELETE /* Code item SYMBOL SELECT ALL CALCULATE %item% = 805 /* Save to separate cover &if ^ [exists %.brd$cover%SG -cover] &then &do SAVE %.brd$cover%SG &s subgrat_name [upcase %.brd$cover%SG] &end /* then do &else &do &s subgrat_name [scratchname -prefix %.brd$cover% -directory] SAVE %subgrat_name% &end /* else do &end /* then do /* Resume construction of graticule EDIT %tick% ARC DRAWENVIRONMENT ARC ON DRAWENVIRONMENT NODE ERRORS NODECOLOR DANGLE BLUE NODECOLOR PSEUDO GREEN SETDRAWSYMBOL 0 RED NODESNAP OFF ARCSNAP OFF TEXTSET GSC LINESET GSC GRAIN [calc [show grain] / 10] /* Delete interval arcs SELECT [upcase %tick%]-ID = 7 RESELECT DANGLE DELETE /* Add tick limit and delete unecessary tick arcs INTERSECTARCS ALL GET %ticklimit% DELETE SELECT [upcase %tick%]-ID >= 100 RESELECT DANGLE DELETE /* Get temporary neatline cover GET %neatline_temp% /* Code symbol item SELECT ALL CALCULATE %item% = 805 /* Get border arcs GET %border1% CALCULATE %item% = 805 GET %border2% CALCULATE %item% = 825 /* Save border cover SAVE /* ADD LATITUDE AND LONGITUDE VALUES AT TICKS /* ------------------------------------------ /* Setup &s pointsize 10 &ty \Adding latitude and longitude values to map border ... &s severity ANNOTATION /* Add Latitude text &s a 100 &do &while %a% le [calc 100 + %lattickid%] /* Extract first and last coordinates of tick SELECT [upcase %tick%]-ID = %a% RESELECT DANGLE /* should have only one arc selected &if [show number select] eq 1 &then &do &s arc [show select 1] &s x1 [extract 1 [show arc %arc% vertex 1]] &s y1 [extract 2 [show arc %arc% vertex 1]] &s x2 [extract 1 [show arc %arc% vertex [show arc %arc% npnts]]] &s y2 [extract 2 [show arc %arc% vertex [show arc %arc% npnts]]] /* Calculate third point &s x3 [calc %x1% + ( ( ( %border1_dist% - %outergrat_dist% ) * ~ ( %x2% - %x1% ) ) / [invdistance %x1% %y1% %x2% %y2%] )] &s y3 [calc %y1% + ( ( ( %border1_dist% - %outergrat_dist% ) * ~ ( %y2% - %y1% ) ) / [invdistance %x1% %y1% %x2% %y2%] )] /* Add test &flushpoints &if %a% le %lattickid% &then &do &push 1 %x3% %y3% &push 1 %x1% %y1% &end /* then do &else &do &push 1 %x1% %y1% &push 1 %x3% %y3% &end /* else do &push 9 0 0 EDITFEATURE ANNO ANNOFIT OFF ANNOPOSITION CC ANNOSYMBOL 300 &if [search [value tick%a%] !SCA] gt 0 &then ANNOSIZE [calc %pointsize% * %.brd$scale% * 0.0003527] &else &do &if [search [value tick%a%] °] gt 0 &then ANNOSIZE [calc %pointsize% * %.brd$scale% * 0.0003527] &else ANNOSIZE [calc ( %pointsize% * %textfactor% ) * ~ %.brd$scale% * 0.0003527] &end /* else do ADD NEW ANNOTEXT [unquote [value tick%a%]] ANNOPLACE * EDITFEATURE ARC &end /* &else &do &ty \*********************************************************************** &ty ERROR: Unable to position latitude text [unquote [value tick%a%]] &ty ***********************************************************************\ &end /* else do &if %a% eq %lattickid% &then &s a 200 &else &s a %a% + 1 &end /* do while /* Add longitude &s a 300 &do &while %a% le [calc 100 + %longtickid%] /* Extract first and last coordinates of tick SELECT [upcase %tick%]-ID = %a% RESELECT DANGLE /* should have only one arc selected &if [show number select] eq 1 &then &do &s arc [show select 1] &s x1 [extract 1 [show arc %arc% vertex 1]] &s y1 [extract 2 [show arc %arc% vertex 1]] &s x2 [extract 1 [show arc %arc% vertex [show arc %arc% npnts]]] &s y2 [extract 2 [show arc %arc% vertex [show arc %arc% npnts]]] /* Calculate third point &if %a% lt 400 &then &do &s x3 [calc %x1% + ( ( ( 0.6 * ( %border1_dist% - %outergrat_dist% ) ) * ~ ( %x2% - %x1% ) ) / [invdistance %x1% %y1% %x2% %y2%] )] &s y3 [calc %y1% + ( ( ( 0.6 * ( %border1_dist% - %outergrat_dist% ) ) * ~ ( %y2% - %y1% ) ) / [invdistance %x1% %y1% %x2% %y2%] )] &end /* then do &else &do &s x3 [calc %x1% + ( ( ( 0.4 * ( %border1_dist% - %outergrat_dist% ) ) * ~ ( %x2% - %x1% ) ) / [invdistance %x1% %y1% %x2% %y2%] )] &s y3 [calc %y1% + ( ( ( 0.4 * ( %border1_dist% - %outergrat_dist% ) ) * ~ ( %y2% - %y1% ) ) / [invdistance %x1% %y1% %x2% %y2%] )] &end /* else do /* Calculate other two points for text &s angle [atan [calc ( %x1% - %x3% ) / ( %y3% - %y1% )]] &s x4 [calc %x3% + ( ( ( %border1_dist% - %outergrat_dist% ) / 2 ) * ~ [cos [calc %angle% + [angrad 180]]] )] &s y4 [calc %y3% + ( ( ( %border1_dist% - %outergrat_dist% ) / 2 ) * ~ [sin [calc %angle% + [angrad 180]]] )] &s x5 [calc %x3% + ( ( ( %border1_dist% - %outergrat_dist% ) / 2 ) * ~ [cos %angle%] )] &s y5 [calc %y3% + ( ( ( %border1_dist% - %outergrat_dist% ) / 2 ) * ~ [sin %angle%] )] /* Add text &flushpoints &push 1 %x4% %y4% &push 1 %x5% %y5% &push 9 0 0 EDITFEATURE ANNO ANNOFIT OFF ANNOPOSITION LC ANNOSYMBOL 300 &if [search [value tick%a%] !SCA] gt 0 &then ANNOSIZE [calc %pointsize% * %.brd$scale% * 0.0003527] &else &do &if [search [value tick%a%] °] gt 0 &then ANNOSIZE [calc %pointsize% * %.brd$scale% * 0.0003527] &else ANNOSIZE [calc ( %pointsize% * %textfactor% ) * ~ %.brd$scale% * 0.0003527] &end /* else do ADD NEW ANNOTEXT [unquote [value tick%a%]] ANNOPLACE * EDITFEATURE ARC &end /* then do &else &do &ty \*********************************************************************** &ty ERROR: Unable to position longitude text [unquote [value tick%a%]] &ty ***********************************************************************\ &end /* else do &if %a% eq %longtickid% &then &s a 400 &else &s a %a% + 1 &end /* do while SAVE /* DISPLAY MAP BORDER /* ------------------ /* Display final result of border symbolized along with subgraticules if /* requested and annotation guideline &if %.brd$view% &then &do REMOVEBACK ALL &if %.brd$subgrat% &then &do BACKCOVER %subgrat_name% BACKENVIRONMENT %subgrat_name% ARC ON BACKSYMBOLITEM %subgrat_name% ARC %item% &s subgrat_display Subgraticule is saved as %subgrat_name% &end /* then do &else &s subgrat_display SYMBOLITEM ARC %item% DRAWENVIRONMENT NODE OFF ANNO ON MAPSCALE AUTOMATIC MAPUNITS METERS LINESCALE MAPSCALE %.brd$scale% DRAW &menu borderfin &position ¢er &screen ~ &stripe 'Border Construction Complete!' &end /* then do QUIT NO /* FINAL CLEANING AND LABEL GENERATION /* ----------------------------------- &ty \Cleaning border and creating polygon and arc attributes ... &s severity FINAL &messages &on COPY %tick% %.brd$cover% CLEAN %.brd$cover% # 0 %fuzzy_dist% POLY &ty \Creating label points for all polygons... CREATELABELS %.brd$cover% 0 BUILD %.brd$cover% POLY /* Add symbol item to polygon attribute table ADDITEM %.brd$cover%.PAT %.brd$cover%.PAT %item% 4 4 I &ty \Killing all temporary covers ... &do cover &list neatline_geo tick_geo subgrat_geo neatline tick subgrat ~ innergrat outergrat ticklimit border1 border2 neatline_temp &if [exists [value %cover%] -cover] &then KILL [value %cover%] ALL &end /* do list loop /* Add items to NTL if it exists &if %.brd$gscdatabase% and [exists NTL%.carto$mapnumber% -cover] &then &do &ty \Adding items to [upcase NTL%.carto$mapnumber%] ... BUILD NTL%.carto$mapnumber% (!LINE POLY!) ADDITEM NTL%.carto$mapnumber%.AAT NTL%.carto$mapnumber%.AAT NTL-SYM 4 4 I ADDITEM NTL%.carto$mapnumber%.AAT NTL%.carto$mapnumber%.AAT NTL-LAYER 16 16 C ADDITEM NTL%.carto$mapnumber%.PAT NTL%.carto$mapnumber%.PAT NTL-SYM 4 4 I ADDITEM NTL%.carto$mapnumber%.PAT NTL%.carto$mapnumber%.PAT NTL-LAYER 16 16 C &end /* then do /* END OF AML /* ---------- &s .gsc$cov [joinfile [show workspace] [locase %.brd$cover%] -sub] &s .gsc$msg Construction of border is complete &menu msg &pos &below &thread wimp &stripe 'Border Routine' &thread &focus &on &all &return /* ROUTINE ERROR /* ------------- /* /* This AML resets the severity, informs the user that the AML encountered an /* error and has crashed and returns program control to the calling level. &routine ERROR &severity &error &ignore &messages &on &select %severity% &when GENERATE; &do &s .gsc$msg Error during border generation END QUIT &end /* when &when PROJECT &s .gsc$msg Error during densifying and/or projecting &when ELEMENTS; &do &s .gsc$msg Error during extracting border elements &if [show program] = ARCEDIT &then QUIT NO &end /* when &when ASSEMBLE; &do &s .gsc$msg Error during assembling border &if [show program] = ARCEDIT &then QUIT NO &end /* when &when ANNOTATION; &do &s .gsc$msg Error during adding coordinates &if [show program] = ARCEDIT &then QUIT NO &end /* when &when FINAL &s .gsc$msg Error during final stages &end /* select &menu msg &pos ¢er &screen &stripe 'Error!' &thread &focus &on &all &thread &delete &self &return; &return /* ROUTINE TICKVALUE /* ----------------- /* This routine determines the text string assigned to a variable that /* corresponds to the appropriate tick on the border &routine TICKVALUE /* Extract text for degrees, minutes and seconds &s D [truncate [calc [value %line%] / 60]] &s M [truncate [calc [value %line%] - ( %D% * 60 )]] &s S [abs [truncate [calc ( ( [value %line%] - ( %D% * 60 ) ) - %M% ) * 60]]] &if %S% lt 10 &then &s S 0%S% &s D [abs %D%] &s M [abs %M%] &if %M% lt 10 &then &s M 0%M% /* Determine combination of text string based on the tick and subdivision /* intervals that will be assigned to the variable &if [value %line%tickid] eq 100 or [value %line%tickid] eq 300 or ~ %lasttick% or [type [calc [value %line%] / 60]] eq -1 &then &do &if [type [value .brd$%line%tickint]] eq -2 or ~ [type [calc [value %line%] / [value .brd$%line%subint]]] eq -2 &then &do &s tick[value %line%tickid] [quote %D%°[unquote %typeset%]%M%'%S%''] &end /* then do &else &do &if [type [calc [value .brd$%line%tickint] / 60]] eq -1 &then &s tick[value %line%tickid] [quote %D%°] &else &s tick[value %line%tickid] [quote %D%°[unquote %typeset%]%M%'] &end /* else do &end /* then do &else &do &if [type [value .brd$%line%tickint]] eq -2 &then &s tick[value %line%tickid] [quote %M%'%S%''] &else &s tick[value %line%tickid] [quote %M%'] &end /* else do &return /* ROUTINE SELECTCORNER /* -------------------- /* This routine deletes the corner for the creation /* of the map border and the graticule. &routine SELECTCORNER /* Determine selection coordinates of buffers &flushpoints SELECT [upcase %tick%]-ID = 2 &s h [calc [sqrt [calc %innergrat_dist% ** 2 + %innergrat_dist% ** 2]]] &do n = 1 &to 4 &by 1 &s %n%x [extract 1 [show tic %n% coordinate]] &s %n%y [extract 2 [show tic %n% coordinate]] &select %n% &when 1; &do &s 3x [extract 1 [show tic 3 coordinate]] &s 3y [extract 2 [show tic 3 coordinate]] &if [calc %3x% - %1x%] eq 0 &then &s angle 45 &else &s angle [calc [atan [calc ( %3y% - %1y% ) / ( %3x% - %1x% )]] - ~ [angrad 45]] &push 1 [calc [value %n%x] + ( %h% * [cos [calc %angle% + ~ [angrad 180]]] )] [calc [value %n%y] + ( %h% * [sin [calc %angle% + ~ [angrad 180]]] )] &end /* when 1 &when 2; &do &s 4x [extract 1 [show tic 4 coordinate]] &s 4y [extract 2 [show tic 4 coordinate]] &if [calc %4x% - %2x%] eq 0 &then &s angle -45 &else &s angle [calc [atan [calc ( %4y% - %2y% ) / ( %4x% - %2x% )]] + ~ [angrad 45]] &push 1 [calc [value %n%x] + ( %h% * [cos %angle%] )] ~ [calc [value %n%y] + ( %h% * [sin %angle%] )] &end /* when 2 &when 3; &do &s 1x [extract 1 [show tic 1 coordinate]] &s 1y [extract 2 [show tic 1 coordinate]] &if [calc %1x% - %3x%] eq 0 &then &s angle -45 &else &s angle [calc [atan [calc ( %1y% - %3y% ) / ( %1x% - %3x% )]] + ~ [angrad 45] - [angrad 180]] &push 1 [calc [value %n%x] + ( %h% * [cos [calc %angle% + ~ [angrad 180]]] )] [calc [value %n%y] + ( %h% * [sin [calc %angle% + ~ [angrad 180]]] )] &end /* when 3 &when 4; &do &s 2x [extract 1 [show tic 2 coordinate]] &s 2y [extract 2 [show tic 2 coordinate]] &if [calc %2x% - %4x%] eq 0 &then &s angle 45 &else &s angle [calc [angrad 180] - [angrad 45] + [atan [calc ~ ( %2y% - %4y% ) / ( %2x% - %4x% )]]] &push 1 [calc [value %n%x] + ( %h% * [cos %angle%] )] ~ [calc [value %n%y] + ( %h% * [sin %angle%] )] &end /* when 4 &end /* select &end /* do to by &push 9 0 0 EDITDISTANCE [calc %h% / 2] RESELECT MANY &return