Keith Vetter 2004-03-10 : A subfield in the new activity of geocaching [
1] is locating geodetic control points, aka benchmarks [
2]. To locate a benchmark you use the survey details published by NGS for each one. Many of these surveys end up with a series of azimuth headings and distances to other landmarks. For example, benchmark AH7623 has the following:
THE STATION IS 35.1 FEET (10.7 M) AZIMUTH 114 DEGREES TO A MAIL BOX WITH THE NUMBER 2001, 14.3 FEET (4.4 M) AZIMUTH 31 DEGREES TO A 12 INCH RCP CULVERT, AND 55.9 FEET (17.0 M) AZIMUTH 355 DEGREES TO A POWER POLE WITH THE NUMBER 2F126.I wrote the following utility to help visualize all the different azimuths and distances. You can enter in the survey data and it will draw a map for you. (I have another version that will automate it by downloading and scraping the benchmark survey page for you but it was too complicated to post here.)
BAJ You can run this code via Jacl/Swank/Java Web Start at
http://www.onemoonscientific.com/swank/azimuth.jnlp
##+##########################################################################
#
# azimuth.tcl - plots distance/azimuth which locates a benchmark
# by Keith Vetter, March 3, 2004
#
package require Tk
set S(title) "Azimuth Plotting"
set colors {
yellow cyan green magenta steelblue red gold
darkturquoise chartreuse3 violetred
}
set PI [expr {atan(1)*4}]
proc PlotIt {} {
Clear
set xy [GetPoints] ;# Get raw, unscaled points
if {$xy == {}} return
set s [GetScale $xy]
foreach {x y id txt anchor} $xy { ;# Scale and plot each point
set px [expr {$x * $s}]
set py [expr {$y * $s}]
set color [lindex $::colors $id]
set txt [TwoLines $txt]
.c create line 0 0 $px $py -tag [list az az$id]
.c create oval [MakeBox $px $py 3] -fil $color -tag [list az az$id]
.c create text $px $py -text $txt -anchor $anchor -tag [list az az$id]
.c bind az$id <Enter> [list HighlightRow $id]
}
.c raise stn
DrawScale $s
}
proc DoDisplay {} {
global S
wm title . $S(title)
label .x ; .x configure -font "[font actual [.x cget -font]] -weight bold"
option add *font [.x cget -font] ; destroy .x
frame .screen -bd 2 -relief raised
frame .ctrl -relief ridge -bd 2 -padx 5 -pady 5
canvas .c -bd 0 -height 500 -width 500 -highlightthickness 0 -bg lightgreen
canvas .s -bd 0 -width 500 -height 30 -highlightthickness 0 -bg lightgreen
grid .screen .ctrl -row 0 -sticky news
grid rowconfigure . 0 -weight 1
grid columnconfigure . 0 -weight 2
grid columnconfigure . 1 -weight 1
grid .c -in .screen -sticky news -row 0
grid .s -in .screen -sticky ews
grid rowconfigure .screen 1 -weight 1
grid columnconfigure .screen 0 -weight 1
DrawSymbol 0 0 10
.c bind stn <Enter> {HighlightRow -1}
image create photo ::img::blank -width 1 -height 1
set txt "$::S(title)\nby Keith Vetter, March 2004\n\n"
append txt "see http://www.geocaching.com/mark/ for details"
button .about -image ::img::blank -highlightthickness 0 -command \
[list tk_messageBox -title "About $::S(title)" -message $txt]
place .about -in .ctrl -relx 1 -rely 1 -anchor nw
bind all <Key-F2> {console show}
bind .c <Configure> {ReCenter %W %h %w}
DoCtrlFrame
update
}
proc DoCtrlFrame {} {
grid [frame .cmid] -in .ctrl -sticky ew -pady 10
label .what -text "What"
label .dist -text Distance
label .azim -text "Azimuth"
grid .dist .azim .what -in .cmid -row 0 -sticky ew
for {set i 0} {$i < 10} {incr i} {
entry .d_$i -textvariable data(dist,$i) -width 8
entry .a_$i -textvariable data(azim,$i) -width 8
entry .w_$i -textvariable data(what,$i) -width 18
grid .d_$i .a_$i .w_$i -in .cmid -sticky ew
}
grid columnconfigure .cmid 2 -weight 1
frame .fbuttons
button .reset -text Reset -command Reset
button .clear -text Clear -command Clear
button .plot -text "Plot It" -command PlotIt
grid .fbuttons -in .ctrl -sticky ew
grid columnconfig .fbuttons {0 1 2 3} -weight 1
grid .reset .clear .plot -in .fbuttons -ipadx 10
tk_optionMenu .example S(who) "Example 1" "Example 2" "Example 3" \
"Example 4" "Example 5" "Example 6"
trace variable ::S(who) w DoExample
grid .example -in .ctrl -row 100
grid rowconfigure .ctrl 50 -weight 1
grid columnconfigure .ctrl 0 -weight 1
}
proc ReCenter {W h w} { ;# Called by configure event
set ::S(h2) [expr {$h / 2}] ; set ::S(w2) [expr {$w / 2}]
$W config -scrollregion [list -$::S(w2) -$::S(h2) $::S(w2) $::S(h2)]
North
PlotIt
}
proc DrawSymbol {x y r} {
foreach {X0 Y0 X1 Y1} [MakeBox $x $y $r] break
foreach {x0 y0 x1 y1} [MakeBox $x $y [expr {sqrt($r*$r /2.0)}]] break
.c create oval $X0 $Y0 $X1 $Y1 -tag stn -fill yellow -outline red
.c create line $x0 $y0 $x1 $y1 -tag stn -fill red
.c create line $x0 $y1 $x1 $y0 -tag stn -fill red
.c create line $X0 $y $X1 $y -tag stn -fill red
.c create line $x $Y0 $x $Y1 -tag stn -fill red
}
proc MakeBox {x y d} {
return [list [expr {$x-$d}] [expr {$y-$d}] [expr {$x+$d}] [expr {$y+$d}]]
}
proc Clear {} {
.c delete az
.s delete all
HighlightRow -1
}
proc Reset {} {
Clear
foreach arr [array names ::data] { set ::data($arr) ""}
}
proc GetPoints {} {
set xy {}
for {set i 0} {$i < 10} {incr i} {
if {[scan $::data(dist,$i) "%g" d] == -1} break ;# Stupid octal
if {[scan $::data(azim,$i) "%g" a] == -1} break ;# Stupid octal
set a1 [expr {360 - ($a - 90)}] ;# Convert to cartesian angle
set a2 [expr {$a1 * $::PI / 180.0}] ;# Convert to radians
set x [expr {$d * cos($a2)}]
set y [expr {-1 * $d * sin($a2)}]
set anchor [expr {($a >= 90 && $a <= 270) ? "n" : "s"}]
lappend xy $x $y $i $::data(what,$i) $anchor
}
return $xy
}
proc GetScale {xy} {
if {$xy == {}} {return 1} ;# Be safe
set mx [set my 0] ;# Get max X and Y
foreach {x y . . .} $xy {
if {abs($x) > $mx} {set mx [expr {abs($x)}]}
if {abs($y) > $my} {set my [expr {abs($y)}]}
}
set wx [expr {[winfo width .c] / 2 - 40}]
if {$wx < 0} {set wx 1}
set wy [expr {[winfo height .c] / 2 - 40}]
if {$wy < 0} {set wy 1}
set sx [expr {$wx / $mx}]
set sy [expr {$wy / $my}]
return [expr {$sx < $sy ? $sx : $sy}]
}
proc HighlightRow {row} {
set bg [lindex [.w_0 config -bg] 3]
for {set i 0} {$i < 10} {incr i} {
set color [expr {$i == $row ? [lindex $::colors $i] : $bg}]
.w_$i config -bg $color
.d_$i config -bg $color
.a_$i config -bg $color
}
}
proc DrawScale {sscale} {
set w .s
set width [expr {.9 * [winfo width $w]}]
set ppf $sscale ;# Pixels per feet
set ft [expr {$width / $ppf}] ;# How many miles per width
if {$ft < 1} return
foreach {limit tBig tMed} {
1000 500 100 500 500 100
400 200 100 200 100 50
100 50 10 50 50 10
10 5 1 5 5 1
1 1 1
} {
if {$ft > $limit} {
set ft $limit
break
}
}
set x1 [expr {$ft * $ppf}] ;# End of scale
set lh 25 ;# Where to draw line
$w delete all
$w create line 0 $lh $x1 $lh
set numTicks [expr {$ft / $tMed}]
for {set tick 0} {$tick <= $numTicks} {incr tick} {
set dist [expr {$tick * $tMed}]
set ::dist $dist
set big [expr {($dist % $tBig) == 0}]
set h [expr {$big ? 12 : 6}]
set x [expr {0 + $tick * $tMed * $ppf}]
$w create line $x $lh $x [expr {$lh - $h}]
if {$big} {
$w create text $x [expr {$lh-10}] -text $dist -anchor s -tag ft
}
}
foreach {. . x y} [$w bbox ft] break
$w create text $x $y -text "ft" -anchor sw
# Center the scale
foreach {x0 . x1 .} [$w bbox all] break
set dx [expr {([winfo width $w] - ($x0 + $x1)) / 2.0}]
$w move all $dx 0
}
proc North {} {
global S
.c delete north
set x [expr {30 - $S(w2)}]
set y [expr {5 - $S(h2)}]
.c create text $x $y -tag north -anchor n -text "N" -font [.what cget -font]
set y1 [lindex [.c bbox north] 3]
set y2 [expr {$y1 + 80}]
.c create line $x $y1 $x $y2 -tag north -width 5 -arrow first
}
proc TwoLines {txt} {
regsub -all {\s+} [string trim $txt] " " txt ;# Compress spaces
set len [string length $txt]
if {$len < 19} { return $txt }
set best $len
foreach index [regexp -all -inline -indices {\s} $txt] {
set index [lindex $index 0]
set err [expr {$len / 2 - $index}]
if {abs($err) < $best} {set best $err}
}
if {$best == $len} { return [list $txt ""] }
set idx [expr {$len / 2 - $best}]
set result "[string range $txt 0 [expr {$idx-1}]]\n"
append result [string range $txt [expr {$idx+1}] end]
return $result
}
proc DoExample {args} {
global S data example
Reset
regexp {\d+} $S(who) who
array set data $example($who)
PlotIt
}
set example(1) {
id AH7625
dist,0 39.2 azim,0 293 what,0 "Maple tree"
dist,1 43.5 azim,1 125 what,1 "Mail box #1603"
dist,2 101.6 azim,2 33 what,2 "Corner stone pier"
dist,3 111.7 azim,3 109 what,3 "Corner stone pier"
}
set example(2) {
id AH7654
dist,0 18.7 azim,0 125 what,0 "Power pole 550-20/40T"
dist,1 87.4 azim,1 270 what,1 "Sign post for turning lanes"
dist,2 9.0 azim,2 204 what,2 "Guy anchor"
}
set example(3) {
id AH7624
dist,0 76.4 azim,0 31 what,0 {The east corner of the baseball dugout}
dist,1 73.7 azim,1 357 what,1 {The west corner of the baseball dugout}
dist,2 49.7 azim,2 347 what,2 {one inch in diameter balsm tree}
dist,3 137.5 azim,3 142 what,3 {Gas line marker}
}
set example(4) {
id AH7656
dist,0 43.2 azim,0 25 what,0 "Utility pole with the number 0065 084/552B4-6"
dist,1 8.6 azim,1 90 what,1 "The centerline of overhead electric wires"
dist,2 124 azim,2 184 what,2 "Utility pole"
}
set example(5) {
id AH7608
dist,0 36.8 azim,0 208 what,0 "Fence gate post"
dist,1 44.4 azim,1 229 what,1 "Fence gate post"
dist,2 55.9 azim,2 320 what,2 "28 inch sugar maple tree"
dist,3 68.2 azim,3 10 what,3 "Mail box post"
}
set example(6) {
id AH7641
dist,0 16.1 azim,0 15 what,0 "Two foot by two foot square grate drop inlet"
dist,1 23.4 azim,1 275 what,1 "One foot by two feet metal drop inlet at the curb"
dist,2 62.9 azim,2 149 what,2 "Power pole with the number 505D4-167"
dist,3 65.6 azim,3 286 what,3 "Street and stop sign pole"
}
DoDisplay
set S(who) "Example 1"
gold added pix
