' conjoinBLN.bas			DS -2009.08
'
'  Converts a multiple-area BLN file into a unified-area polygon, as per:
'
'   http://www.goldensoftware.com/activekb/questions/483
'
'  Encapsulated as a function so this can be used in other scripts.

Sub Main
Debug.Clear

	'start Surfer
	Set surferapp	= CreateObject("Surfer.Application")

	'make a dialog that lets the user select the filetype and path in one step
	bln_file	= GetFilePath("","bln", "", "Choose a blanking file to unify",0)

	'exit if user cancelled
	If bln_file	= "" Then End

	conjoinBLN(bln_file)

	Debug.Print "Conjoined blanking file saved as " + Left(bln_file,InStr(bln_file,".bln")-1) + "_conjoined" + Right(bln_file,Len(bln_file)-InStrRev(bln_file,".")+1)

	surferapp.Quit
End Sub

'Use a Surfer Plot document to batch convert one set of images to another type.
' Choose export method based on which version of Surfer is running (Surfer 7 not well-supported!)
Public Function conjoinBLN(bln_file As String)

		'get the current instance of surfer and add a new plot
		Set surferapp		= GetObject(,"Surfer.Application")
		Set wrksheet		= surferapp.Documents.Open(bln_file)

		visible_state		= surferapp.Visible'Record surfer's visibility state
		'surferapp.Visible	= False'hide the app  for increased speed


		'record the number of total rows
		total_rows		= wrksheet.UsedRange.LastRow

		'give the master header row the correct number of vertices
		wrksheet.UsedRange.Cells(1,1,1,1).Value = total_rows -1

		'copy the master vertex to the clipboard so it can be used to close all subsequent polygons
		wrksheet.UsedRange.Cells(2,1,2,2).Copy

		'an integer to let us pick up where we leave off
		Dim place_holder As Long
		place_holder	= 3

		'scan the worksheet until we hit the first BLN header, delete that row, and stop. (this boundary is already closed by the master vertex)
		For i = place_holder To total_rows Step 1

			'Get values for cells a(i) and b(i)
			a 	= wrksheet.UsedRange.Cells(i,1,i,1).Value
			b	= wrksheet.UsedRange.Cells(i,2,i,2).Value

			'check for header rows based on (a) float modulo & (b) blanking flag
			If (a-(Int(a)/1)*1 = 0) And (b = 0.0 Or b = 1.0) Then'               if speed becomes an issue, consider removing the "(a-(Int(a)/1)*1 = 0) And" portion of this line
				wrksheet.UsedRange.Cells(i,1,i,2).Delete(wksDeleteUp)
				place_holder	= i
				i = total_rows
			End If
		Next i

		'scan the worksheet, and if the row is a BLN polygon header replace it with the first vertex so that the polygons are unified
		For i = place_holder To total_rows Step 1

			a 	= wrksheet.UsedRange.Cells(i,1,i,1).Value
			b	= wrksheet.UsedRange.Cells(i,2,i,2).Value

			If a-(Int(a)/1)*1 = 0 And (b = 0.0 Or b = 1.0) Then
				wrksheet.UsedRange.Cells(i,1,i,2).Paste
			End If

		Next i

		'close the worksheet, save the file
		wrksheet.Close(srfSaveChangesYes, Left(bln_file,InStr(bln_file,".bln")-1) + "_conjoined" + Right(bln_file,Len(bln_file)-InStrRev(bln_file,".")+1) )

		surferapp.Visible	= visible_state 'Restore the visibility state
End Function