Due to the interest in the code for the mapsheet maker program, I've put the mapbasic
code below.
''''''''Start of Program''''''''''''''''''''''''''''''''
'AUTHOR: TOM COLLEY
'PURPOSE: TO CREATE A SET OF MAPSHEETS BASED ON USER INPUT
'FIRST WRITTEN: 20 JANUARY 2003
'LAST UPDATED: 20 JANUARY 2003
'___________________________________________________________
Dim x1, x2, y1, y2, xcrement, ycrement, xSheetCnt, ySheetCnt, cnta, cntb as float
Dim minx, miny, maxx, maxy as float
Dim strTabFileName, strTabName, strID as string
Dim spat as object
Set CoordSys Earth Projection 8, 33, "m", 153, 0, 0.9996, 500000, 10000000
Note "This procedure will produce a set of mapsheet cells" + chr$(13) +
"based on user input for origins, increments and number" + chr$(13) +
"of mapsheets in vertical and horizontal directions." + chr$(13) +
"The mapsheets will produced in GDA94 MGA Zone 56."
'___________________________________________________________
'GET USER INPUT
Dialog
Title "Enter values in metres..."
Width 230 Height 230
'1
Control StaticText
Title "Min X:"
Position 20, 20
Control EditText
Position 90 ,20
Width 120 Height 10
ID 1
Value 237800
Into x1
'2
' Control StaticText
' Title "Max X:"
' Position 90, 40
' Control EditText
' Position 90 ,40
' Width 120 Height 10
' ID 2
' Value
' Into x2
'3
Control StaticText
Title "Min Y:"
Position 20, 60
Control EditText
Position 90 ,60
Width 120 Height 10
ID 3
Value 6245900
Into y1
'4
' Control StaticText
' Title "Max Y:"
' Position 20, 80
' Control EditText
' Position 90 ,80
' Width 120 Height 10
' ID 4
' Value 237800
' Into y2
'5
Control StaticText
Title "X Increment:"
Position 20, 100
Control EditText
Position 90 ,100
Width 120 Height 10
ID 5
Value 4000
Into xcrement
'6
Control StaticText
Title "Y Increment:"
Position 20, 120
Control EditText
Position 90 ,120
Width 120 Height 10
ID 6
Value 2500
Into ycrement
'7
Control StaticText
Title "Mapsheet Count X:"
Position 20, 140
Control EditText
Position 90 ,140
Width 120 Height 10
ID 7
Value 12
Into xSheetCnt
'8
Control StaticText
Title "Mapsheet Count Y:"
Position 20, 160
Control EditText
Position 90 ,160
Width 120 Height 10
ID 8
Value 24
Into ySheetCnt
'9
' Control StaticText
' Title "Min X:"
' Position 20, 180
' Control EditText
' Position 90 ,180
' Width 120 Height 10
' ID 9
' Value 237800
' Into x1
'10
' Control StaticText
' Title "Min X:"
' Position 20, 180
' Control EditText
' Position 90 ,180
' Width 120 Height 10
' ID 10
' Value 237800
' Into x1
Control OKButton
Position 80, 190
Width 40 Height 20
Control CancelButton
Position 130, 190
Width 40 Height 20
'___________________________________________________________
'CREATE TABLE FOR RESULT
strTabFileName = FileSaveAsDlg ( "C:\Temp" , "MapSheet", "tab", "Save Mapsheets
as..." )
strTabName = PathToTableName$( strTabFileName)
Create Table strTabName
("ID" Char(6),
"XMin" Float,
"YMin" Float,
"XMax" Float,
"YMax" Float)
File strTabFileName
Type NATIVE
Create Map
For strTabName
CoordSys Earth Projection 8, 33, "m", 153, 0, 0.9996, 500000, 10000000
'___________________________________________________________
' SET REGION SYMBOLOGY
Set Style Brush MakeBrush(1, 16777215, 16777215)
Set Style Pen MakePen(2, 2, 0)
'___________________________________________________________
' CREATE SPATIAL OBJECTS
For cnta = 1 to xSheetCnt
For cntb = 1 to ySheetCnt
minx = xcrement * (cnta -1) + x1
maxx = xcrement * cnta + x1
miny = ycrement * (cntb -1) + y1
maxy = ycrement * cntb + y1
Create Rect Into Variable spat
( minx , miny ) ( maxx , maxy )
strID = Right$("00" + str$(cnta), 2)
strID = strID + "-" + Right$("00" + str$(cntb), 2)
' If cnta = 1 and cntb = 1 then
' Note "Check 1: Spat = " + spat + chr$(13) +
' "strID = " + strID
' End If
Insert into strTabName (ID, XMin, YMin, XMax, YMax, Obj)
Values (strID, minx, miny, maxx, maxy, spat)
' If cnta = 1 and cntb = 1 then
' Note "Check 2"
' End If
Next
Next
Commit table strTabName
Map from strTabName
set map redraw off
Set Map Layer 1 Label Font ("Arial",0,7,0)
Set Map Layer 1 Label Auto On
set map redraw on
Note "Processing complete!"
'___________________________________________________________
'''''End of Program'''''''''''''''''''''''''''''''''''
Regards
Tom
> -----Original Message-----
> From: Thomas Colley
> Sent: Friday, 19 December 2003 8:26 AM
> To: 'Ryan Morgan, Aerials Express '; MapInfo-L List Input (E-mail)
> Subject: Automatic Square Quartering?
>
> Ryan,
>
> I've attached compiled and uncompiled versions of a mapbasic program, that I wrote
> and used for a similar purpose (these won't get on the MI-L list). You can run it
> immediately to get the idea of how it works; just accept the defaults - it's very
> quick. It will produce a set of mapsheet cells based on user input for origins,
> increments and number of mapsheets in vertical and horizontal directions. The
> mapsheets will produced in projection GDA94 MGA Zone 56. The projection can be
> altered by changing one line of code. I presume you can get the details for your
> projection; if not let me know. The rest is self-explanatory. If this solution
> works, pls let me know. If others are interested, I can paste the code into the text
> of an email so it can be accessed by the MI-L list.
>
> Regards
> Tom Colley
> Sustainability Systems Analyst
> Blue Mountains City Council
> Tel: (61.2) 4780-5451
> [EMAIL PROTECTED]
>
> > <<MapSheetMaker.MBX>> > > <<MapSheetMaker.mb>>
>
>
> -----Original Message-----
> From: Ryan Morgan, Aerials Express [mailto:[EMAIL PROTECTED]
> Sent: Tuesday, December 16, 2003 4:38 PM
> To: MapInfo-L
> Subject: MI-L Automatic Square Quartering?
>
> Hi all,
>
> I'm stuck. I'm trying to quarter a township, range, and section grid to
> show a NW, NE, SW, and SE quarter in a separate layer. Is there an easy way
> of doing this? I'm looking at close to 20,000 cells, way too many to do by
> hand.
>
> TIA and Happy Holidays!
>
> Ryan Morgan
> Aerials Express
> www.AerialsExpress.com
---------------------------------------------------------------------
List hosting provided by Directions Magazine | www.directionsmag.com |
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
Message number: 9656
