Follow

How can I create a base map from DRG data using a Mapviewer script?

This article contains a sample script for creating a base map from a USGS DRG file and clipping it to the map collar. The map is then exported as a new georeferenced TIF file.

To run this script:

  1. Copy the script below, or click here to download the BAS file: Clip_DRG_24K.bas.
  2. In a Windows Explorer window, navigate to C:\Program Files\Golden Software\MapViewer 8\Scripter.
  3. Double click on Scripter.exe to launch Scripter.
  4. Press Ctrl+A to select all of the existing lines then press Delete.
  5. If you copied this script, press Ctrl+V to paste it into Scripter. If you downloaded it, click File | Open, select the BAS file from your downloads directory, and click Open.
  6. Click Script | Run to run the script.
     

*********

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Clip_DRG_24K.bas
' Copyright (C) Golden Software Inc. 1992-2015
'
' This script clips the map collar from a 1:24,000 scale (7.5 minute)
' USGS Digital Raster Graphic (DRG).  It assumes that the DRG is in
' TIFF format, with embedded georeferencing.
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub Main
  Dim mvApp, plot, map, bmap, area As Object
  Dim inFile, outName, outDir, outFile, opts As String
  Dim center(1) As Double
  Dim xMin, xMax, yMin, yMax, collar(9) As Double
  Dim i,j As Integer

  ' Start MapViewer
  Set mvApp = CreateObject("MapViewer.Application")
  mvApp.Visible = True
  Set plot = mvApp.Documents.Add(DocType:=mvDocPlot)

  ' Get the file to clip
  inFile = GetFilePath("","tif","","1:24K DRG to clip",0)
  ' Need to handle cancel from file dialog
  If inFile = "" Then Exit Sub

  ' Get the output file name.
  ' Default to input name + "_clipped"
  i = InStrRev(inFile,"\")
  j = InStrRev(inFile,".")
  outName = Mid(inFile,i+1,j-i-1) + "_clipped.tif"
  outDir = Left(inFile,i)
  outFile = GetFilePath(outName,"tif",outDir,"Save Clipped DRG As",3)
  ' Need to handle cancel from file dialog
  If outFile = "" Then Exit Sub

  ' Import the DRG using the embedded georeferencing info
  Set map = plot.CreateBaseMap(inFile,"SpatialReferenceSource=1")

  ' Get a pointer to the bitmap object
  Set bmap = plot.ActiveLayer.Shapes(1)

  ' Get Lat/Long of center of DRG
  center(0) = plot.PageSetup.Width / 2.0
  center(1) = plot.PageSetup.Height / 2.0
  plot.ConvertCoordUnits(Vertices:=center, SourceUnits:=mvCoordDisplayUnitPageUnits, _
  	DestUnits:=mvCoordDisplayUnitLatLon )

  ' Calculate extents of DRG in Lat/Long by rounding up and down to the nearest
  ' one-eighth of a degree (7.5 minutes).
  xMax = CDbl(Fix((center(0) * 8.0)))/8.0
  xMin = xMax - 0.125
  yMin = CDbl(Fix((center(1) * 8.0)))/8.0
  yMax = yMin + 0.125

  ' Convert map extents in lat/long to page units and create area object to use for cropping
  collar(0) = xMin  ' Lower left
  collar(1) = yMin
  collar(2) = xMin  ' Upper left
  collar(3) = yMax
  collar(4) = xMax  ' Upper right
  collar(5) = yMax
  collar(6) = xMax  ' Lower right
  collar(7) = yMin
  collar(8) = xMin  ' Lower left
  collar(9) = yMin
  plot.ConvertCoordUnits( collar, mvCoordDisplayUnitLatLon, mvCoordDisplayUnitPageUnits )
  Set area = plot.ActiveLayer.Shapes.AddPolygon( bSpline:=False, Vertices:=collar )

  ' Crop the image to the rectangle
  plot.ActiveLayer.Shapes.SelectAll()
  plot.ActiveLayer.Shapes(1).CropImage( DelCropingObjs := True )

  ' Build the export options string
  opts = "Defaults=1" + ",ForgetOptions=1" + ",Width=" + Str(bmap.WidthInPixel) + _
        ",Height=" + Str(bmap.HeightInPixel) + ",KeepAspect=0" + _
        ",ColorDepth=" + Str(bmap.BitsPerPixel) + ",IgnoreRefInfo=0" + _
        ",SaveRefInfoAsGeoTIFF=1" + ",SaveRefInfoAsGSIREF=1" + _
        ",SaveRefInfoAsBlueMarbleRSF=0" + ",SaveRefInfoAsESRIWorld=1"

  ' Export the clipped DRG
  plot.Export( FileName := outFile, SelectionOnly := False, Options := opts )

End Sub

 

Updated October 31, 2016

Was this article helpful?
0 out of 0 found this helpful
Have more questions? Submit a request

0 Comments

Please sign in to leave a comment.