'========================================================================== 'CONTAREA2.BAS ' 'This script demonstrates the following: ' ' Calculates the volume and area between contours ' Extracts area and volume information from calculations ' Prints extracted area and volume to the Immediate Window ' and to output file '========================================================================== 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") Debug.Print SurferApp.Version 'Makes Surfer visible SurferApp.Visible = False path1 = SurferApp.Path+"\samples\" path2 = "d:\incoming\" path3 = "d:\program files\golden software\surfer\samples\" 'Input upper surface for volume calculations 'Upper$ = InputBox$("Enter path and grid filename for Upper Surface") Upper$ = GetFilePath( , "grd;dem;ddf",path1, "Upper Surface") If Upper$ ="" Then End 'Creates a volume report to get zMin, zMax, xMin, xMax, yMin, yMax Dim Results() As Double SurferApp.GridVolume(Upper:=Upper$,Lower:=0, _ pResults:= Results, ShowReport:=False) 'Set ZMin and ZMax Dim Grid As Object Set Grid = SurferApp.NewGrid Grid.LoadFile (Upper$, False) ZMin=Grid.zMin ZMax=Grid.zMax XMin=Grid.xMin XMax=Grid.xMax YMin=Grid.yMin YMax=Grid.yMax 'Obtain user defined min, max, and interval cMin= Val(InputBox$("Enter minimum Z contour value", "ZMin", ZMin)) cMax=Val(InputBox$("Enter maximum Z contour value", "ZMax", ZMax)) cInterval=Val(InputBox$("Enter Contour Interval", "CI", "5")) If cInterval = 0 Then End 'Create output file 'OutFile=InputBox$("Enter output path and filename for the area report") Outfile = Left(Upper$,Len(Upper$)-4) + "Report.dat" Open OutFile For Output As #1 'Reports the planar areas between contours to Immediate Window and to File 'Calculates planar area, volumes, and surface areas PrevArea = 0 PrevNegArea = 0 PrevSurf = 0 PrevNegSurf = 0 PrevVol = 0 PrevNegVol = 0 PrevCVal = 0 For CValue=cMin To cMax Step cInterval SurferApp.GridVolume(Upper:=Upper$,Lower:=cValue, pResults:= Results, _ ShowReport:=False) PosVol = Results(srfGVPosVol) NegVol = Results(srfGVNegVol) PosPlanArea = Results(srfGVPosPlanarArea) NegPlanArea = Results(srfGVNegPlanarArea) BlankedPlanArea = Results(srfGVBlankedArea) PosSurfArea = Results(srfGVPosArea) NegSurfArea = Results(srfGVNegArea) If cValue = cMin Then Debug.Print"==============================================================================" Debug.Print " Planar Planar Planar Surface Surface Surface" Debug.Print " Area Area Area Area Area Area Volume Volume Volume" Debug.Print "Contour Above Below Between Above Below Between Above Below Between" Debug.Print "Value Contour Contour Contour Contour Contour Contour Contour Contour Contour" Debug.Print "------------------------------------------------------------------------------" Print #1, " Planar Planar Planar Surface Surface Surface" Print #1, " Area Area Area Area Area Area Volume Volume Volume" Print #1, "Contour Above Below Between Above Below Between Above Below Between" Print #1, "Value Contour Contour Contour Contour Contour Contour Contour Contour Contour" Print #1, "-----------------------------------------------------------------------------" Else 'Debug.Print PrevArea-PosPlanArea 'Print #1, PrevArea-PosPlanArea string1=" " + PrevCVal + " " + PrevArea + " " + PrevNegArea + " " string2=" " + PrevSurf + " " + PrevNegSurf + " " string3=" "+ PrevVol + " " + PrevNegVol + " " Debug.Print string1; PrevArea-PosPlanArea ;string2; PrevSurf-PosSurfArea; string3; PrevVol-PosVol Print#1, string1; PrevArea-PosPlanArea; string2; PrevSurf-PosSurfArea; string3; PrevVol-PosVol End If PrevArea=PosPlanArea PrevNegArea=NegPlanArea PrevSurf=PosSurfArea PrevNegSurf=NegSurfArea PrevVol=PosVol PrevNegVol=NegVol PrevCVal=CValue If CValue = CMax Then Debug.Print " ";CValue;" ";PosPlanArea;" ";NegPlanArea;" ";PosPlanArea;" ";PosSurfArea;" ";NegSurfArea;" ";PosSurfArea;" ";PosVol;" ";NegVol;" ";PosVol Print #1, " ";CValue;" ";PosPlanArea;" ";NegPlanArea;" ";PosPlanArea;" ";PosSurfArea;" ";NegSurfArea;" ";PosSurfArea;" ";PosVol;" ";NegVol;" ";PosVol End If Next MsgBox outfile+" created." End Sub