contarea.bas

surfer开发脚本

'==========================================================================
'CONTAREA.BAS
'
'This script demonstrates the following:
'
'	Calculates the volume and area
'	Extracts area and volume information from calculations
'	Prints extracted area and volume to the Immediate Window
'										and to output file
'
'												TB 11/98 Surfer 6
'
'												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")

	'Makes Surfer visible
	SurferApp.Visible = False
	
	'Input upper surface for volume calculations
	Upper$ = InputBox$("Enter path and grid filename for 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")
	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	
End Sub