'========================================================================== 'CONTOURFILL.BAS ' 'This script demonstrates the following: ' ' How to create a contour map ' How to fill the contour intervals with user defined range ' How to fill a single contour interval with a specific color ' ' SKP 9/99 Surfer 7 '========================================================================== Sub Main 'Declare the variable that will reference the application Dim SurferApp As Object 'Creates an instance of the Surfer Application object ' and assigns it to the variable named "SurferApp" Set SurferApp = CreateObject("Surfer.Application") 'Make Surfer visible SurferApp.Visible = True 'Assigns the location of the data and grid files to the variable "Path" Path = SurferApp.Path + "\samples\" 'Declares Doc as an Object Dim Doc As Object 'Creates a new plot window with variable name "Doc" Set Doc = SurferApp.Documents.Add 'Turn off screen updating for faster redraws SurferApp.ScreenUpdating = False 'Creates a contour map and assigns it to the variable "MapFrame" Set MapFrame = Doc.Shapes.AddContourMap(GridFileName:=Path+"demogrid.grd") 'Fill Contours MapFrame.Overlays(1).FillContours = True 'Set the colors to be gradational from green to blue Set Levels = MapFrame.Overlays(1).Levels n = Levels.Count ColorInc = 255.0 / (n-1) For i=1 To n ColorInc = 255.0 * (i-1) / (n-1) Levels(i).Fill.ForeColor = RGB(0,255-ColorInc,ColorInc) Next i 'Change a specific contour interval to Green Levels(8).Fill.ForeColor = srfColorYellow 'Move first map to lower left MapFrame.Selected = True Doc.Selection.Left = 1.0 Doc.Selection.Top = 4.0 'Deselect All Doc.Selection.DeselectAll 'Create a second contour map and fill contours Set MapFrame2 = Doc.Shapes.AddContourMap(GridFileName:=Path+"demogrid.grd") MapFrame2.Overlays(1).FillContours = True 'Set the colors to be gradational from blue to white Set Levels2 = MapFrame2.Overlays(1).Levels m = Levels2.Count ColorInc2 = 255.0 / (m-1) For j=1 To m ColorInc2 = 255.0 * (j-1) / (m-1) Levels2(j).Fill.ForeColor = RGB(ColorInc2,ColorInc2,255) Next j 'Move second map to upper right MapFrame2.Selected = True Doc.Selection.Left = 4.5 Doc.Selection.Top = 10.0 'Turn on screen updating to view maps Doc.Windows(1).Zoom(srfGridZoomFitToWindow) SurferApp.ScreenUpdating = True End Sub