Scripting Image Capture - Some Examples of My Own Including Plate Solving

[russellhq]

I wanted to start a new thread with a more generic name from the previous Maxim DL one so it might appeal to a wider audience (old thread with script examples can be found here: http://stargazerslounge.com/topic/226124-maxim-dl-scripts/ ).

The scripting ability of ASCOM and other astronomy software packages makes for a very powerful solution to automating an imaging session on the cheap!

So I want to share my work here with the aim to encourage others to join in and see where we can get to! I also want to use this as an opportunity to improve my programming, so any feedback is very welcome!

To start off, my first script in this thread will be one that uploads an image file to astrometry.net and returns the image centre in RA and DEC. This can be useful for issuing a sync command when carrying out your telescope alignment.

A word of caution first, before I get to the script: I'm not the worlds best program writer, my commenting is generally poor and error handling is next to non existent. But with that out the way, here's the first script:

Firstly, to use this script, there are a couple things you need to do:

1) Register with astromety.net. If you already have an account, I would suggest creating a new one as you will fill it images that you probably don't want to keep

2) Update line 10 in the script with your own API Key, you can get more details on finding your key here http://nova.astrometry.net/api_help

3) Run the script from command prompt using csript, otherwise the console output won't work: i.e. cscript astrometry.vbs

Here's the script and the vbs file is attached to the post, compressed in a zip file.

Option Explicit

Dim NovaSession
Dim FileString
Dim strGETResponse
Dim intRetries 'number of times to check for a solution
Dim intTimeout 'milliseconds between each solution check
Dim strAPIkey 'the API key asociated with your astrometry.net account; see http://nova.astrometry.net/api_help for more info
Dim sRa 'Solved right ascension, hours J2000
Dim sDec 'solved declination, degrees J2000
Dim TelescopeDriver

strAPIkey = "" 'Enter your API key here
intRetries = 20
intTimeout = 5000
TelescopeDriver = "EQMOD.Telescope" 'Replace with your Telescope Driver

GetSessionKey
GetImageCentre ReturnFilePath
SyncTelescope

Sub GetSessionKey
	NovaSession = GetArrayElement(GetNovaLoginResponseString, "session")
	WScript.Echo("Session ID: " & NovaSession)
End Sub

Sub GetImageCentre (ByVal strImageFilePath)
	Dim strPostResponse
	dim strResultsJSON
	Dim strSubID
	Dim strJobID
	Dim arrResultsJSON
	
	WScript.Echo("Uploading image...")
	strPostResponse = NovaFilePOST(strImageFilePath)
	WScript.Echo("Image uploaded.")
	strJobID = GetJobNumber(strPostResponse)
	If strJobID = "Job Failed" Then
		WScript.Echo("No solution found")
	Else
	WScript.Echo("Retrieving centre from: http://nova.astrometry.net/api/jobs/" & strJobID & "/calibration/")
	strResultsJSON = BrowserGET("http://nova.astrometry.net/api/jobs/" & strJobID & "/calibration/")
	WScript.Echo("Image centre: RA: " & GetArrayElement(strResultsJSON, "ra") & ": DEC: " & GetArrayElement(strResultsJSON, "dec"))
	WScript.Echo("Imagescale arcsec/pixel: " & GetArrayElement(strResultsJSON, "pixscale"))
	WScript.Echo("Orientation: " & GetArrayElement(strResultsJSON, "orientation"))
	sRa = GetArrayElement(strResultsJSON, "ra") / 15
	sDec = GetArrayElement(strResultsJSON, "dec")
	End If
End Sub

Sub SyncTelescope 'syncs telescope to passed coordinates
   Dim Tel ' ASCOM telescope
   Set Tel = Nothing
   Set Tel = CreateObject(TelescopeDriver)
   'Tel.SyncToCoordinates RaNow, DecNow 'JNOW coordinates
   'Tel.SlewToCoordinates RaNow, DecNow 'JNOW coordinates
   WScript.Echo("Synchronising & slewing telescope to co-ordinates: RA " & Degrees2HMS(sRa*15) & " DEC " & Degrees2DMS(sDec))
   Tel.SyncToCoordinates sRa, sDec 'J2000 coordinates
   Tel.SlewToCoordinates sRa, sDec 'J2000 coordinates
   WScript.Echo("Slew complete.")
   Set Tel = Nothing
End Sub

Function GetNovaLoginResponseString
	'This function logs into astrometry.net and returns the server response
	Dim strURL
	Dim strHeader(1)
	Dim strBody
		
	strURL = "http://nova.astrometry.net/api/login"
	strHeader(0) = "Content-Type"
	strHeader(1) = "application/x-www-form-urlencoded"
	strBody = "request-json=" & URLEncode("{""apikey"": """ & strAPIkey & """}", False)
	WScript.Echo("Logging in to astrometry.net...")
	GetNovaLoginResponseString = BrowserPOST(strURL, strHeader, strBody)
	WScript.Echo("Logged in.")
End Function

Function GetJobNumber (ByVal strPostJSONresponse)
	'Function returns job number of successful plate solve
	' If the job is not solved in the alloted time, "Job Failed" is returned
	Dim strSubmissionResponse
	Dim strJobResponse
	Dim strSubID
	Dim strProcessingFinishedCheck
	Dim strJobNumber
	Dim strJobSuccess
	Dim bolCheck
	Dim intCount
	
	intCount = 0
	strSubID = GetArrayElement(strPostJSONresponse, "subid")
	WScript.Echo("Submission ID: " & strSubID)
	bolCheck = True
	strProcessingFinishedCheck = "None"
	WScript.Sleep 1000
	WScript.Echo("Checking file processing status...")
	Do while bolCheck = True
		strSubmissionResponse = BrowserGET("http://nova.astrometry.net/api/submissions/" & strSubID & "/")
		strProcessingFinishedCheck = GetArrayElement(strSubmissionResponse, "processing_finished")
		If strProcessingFinishedCheck = "None" then
			WScript.Echo("Processing...")
			WScript.Sleep 1000
		Else
			strJobNumber = CleanJobNumber(GetArrayElement(strSubmissionResponse, "jobs"))
			strJobSuccess = GetArrayElement (BrowserGET("http://nova.astrometry.net/api/jobs/" & strJobNumber & "/"), "status")
			If strJobSuccess = "String not found" Then
				strJobSuccess = "Not started"
				Else
			End If
			WScript.Echo("Job Status: " & strJobSuccess)
			If strJobSuccess = "success" then
				GetJobNumber = strJobNumber
				WScript.Echo("Job ID: " & strJobNumber)
				WScript.Echo("Plate solving finised successfully")
				bolCheck = False
			Else
				intCount = intCount + 1
				If intCount > 10 Then
					bolCheck = False
					GetJobNumber = "Job Failed"
					WScript.Echo("Plate solve failed.")
				Else
					WScript.Echo("Rechecking server in " & intTimeout/1000 & " seconds...")
					WScript.Sleep intTimeout
				End If
			End If
		End If
	Loop
End Function

Function GetArrayElement (ByVal strSessionResponse, ByVal strKey)
	Dim strElement
	Dim arrJSON
	arrJSON = ParseJSON(strSessionResponse)
	strElement = SearchArray(arrJSON, strKey)
	GetArrayElement = strElement
End Function

Function NovaFilePOST (ByVal strImageFilePath)
	'This function posts the image file to astrometry.net and returns the server response
	
	Dim strURL
	Dim strHeader(1)
	Dim strBodyStart
	Dim strBodyEnd
	Dim strBody
	Dim strBoundary
	
	strURL = "http://nova.astrometry.net/api/upload/"
	strBoundary = "MyBoundary012345678987654321"
	strHeader(0) = "Content-Type"
	strHeader(1) = "multipart/form-data; boundary= " & strBoundary
	
	strBodyStart = "--" & strBoundary & vbCrlf
	strBodyStart = strBodyStart & "Content-Disposition: form-data; name=""request-json""" & vbCrlf & vbCrlf
	strBodyStart = strBodyStart & "{""session"": """
	strBodyStart = strBodyStart & NovaSession
	strBodyStart = strBodyStart & """, ""allow_commercial_use"": ""d"", ""allow_modifications"": ""d"", ""publicly_visible"": ""y""}"
	strBodyStart = strBodyStart & vbCrlf
	strBodyStart = strBodyStart & "--" & strBoundary & vbCrlf
	strBodyStart = strBodyStart & "Content-Disposition: form-data; name=""file""; filename=""test.jpg""" & vbCrlf
	strBodyStart = strBodyStart & "Content-Type: octet-stream" & vbCrlf & vbCrlf
	strBodyEnd = vbCrlf & "--" & strBoundary & "--" & vbCrlf ' end of body terminator
	strBody = FormData (strBodyStart, strBodyEnd, strImageFilePath)
	
	NovaFilePOST = BrowserPOST(strURL, strHeader, strBody)
End Function

Function URLEncode(StringToEncode, UsePlusRatherThanHexForSpace)
  Dim TempAns, CurChr, iChar
  CurChr = 1
  Do Until CurChr - 1 = Len(StringToEncode)
    iChar = Asc(Mid(StringToEncode, CurChr, 1))
    If (iChar > 47 And iChar < 58)  Or (iChar > 64 And iChar < 91) Or (iChar > 96 And iChar < 123) Then
      TempAns = TempAns & Mid(StringToEncode, CurChr, 1)
    ElseIf iChar = 32 Then
      If UsePlusRatherThanHexForSpace Then
        TempAns = TempAns & "+"
      Else
        TempAns = TempAns & "%" & Hex(32)
      End If
    Else
      TempAns = TempAns & "%" & Right("00" & Hex(Asc(Mid(StringToEncode, CurChr, 1))), 2)
    End If
    CurChr = CurChr + 1
  Loop
  URLEncode = TempAns
End Function

Function BrowserPOST (ByVal URL, ByVal Header(), ByVal BodyData)
	Dim objHTTP
	'Set objHTTP = CreateObject("Microsoft.XMLHTTP")
	'Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
	'Set objHTTP = CreateObject("MSXML2.XMLHTTP")
	Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
		objHTTP.open "POST", URL, False	
	objHTTP.setRequestHeader Header(0), Header(1)
	objHTTP.send BodyData
	BrowserPOST = objHTTP.responseText
	Set objHTTP = Nothing
End Function

Function BrowserGET (ByVal URL)
	Dim objHTTP
	'Set objHTTP = CreateObject("Microsoft.XMLHTTP")
	'Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
	'Set objHTTP = CreateObject("MSXML2.XMLHTTP")
	Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
		objHTTP.open "GET", URL, False	
		objHTTP.send ""
	strGETResponse = objHTTP.responseText
	BrowserGET = strGETResponse
	Set objHTTP = Nothing
End Function

Function FormData(ByVal strFormStart, ByVal strFormEnd, ByVal strFilePath)
	'This function turns the body data of a POST request into a binary variable
	' and returns this variable.
	Const adLongVarBinary = 205
	Dim ado, rs
	Dim lngCount
	Dim bytFormData, bytFormStart, bytFormEnd, bytFile
	'Dim strFormStart, strFormEnd, strDataPair
	
	'Read the file into a byte array
	Set ado = CreateObject("ADODB.Stream")
	ado.Type = 1
	ado.Open
	ado.LoadFromFile strFilePath
	bytFile = ado.Read
	ado.Close
	
	Set rs = CreateObject("ADODB.Recordset")
	rs.Fields.Append "FormData", adLongVarBinary, Len(strFormStart) + LenB(bytFile) + Len(strFormEnd)
	rs.Open
	rs.AddNew
	'Convert form data so far to zero-terminated byte array
	For lngCount = 1 To Len(strFormStart)
		bytFormStart = bytFormStart & ChrB(Asc(Mid(strFormStart, lngCount, 1)))
	Next
	rs("FormData").AppendChunk bytFormStart & ChrB(0)
	bytFormStart = rs("formData").GetChunk(Len(strFormStart))
	rs("FormData") = ""
	'Get the end boundary as a zero-terminated byte array
	For lngCount = 1 To Len(strFormEnd)
		bytFormEnd = bytFormEnd & ChrB(Asc(Mid(strFormEnd, lngCount, 1)))
	Next
	rs("FormData").AppendChunk bytFormEnd & ChrB(0)
	bytFormEnd = rs("formData").GetChunk(Len(strFormEnd))
	rs("FormData") = ""
	'Now merge it all
	rs("FormData").AppendChunk bytFormStart
	rs("FormData").AppendChunk bytFile
	rs("FormData").AppendChunk bytFormEnd
	bytFormData = rs("FormData")
	rs.Close
	Set ado = Nothing
	Set rs = Nothing
	FormData = bytFormData

End Function

Function ParseJSON(ByVal strJSON)
	'This function parses a JSON string returned from astrometry.net 
	' and returns the result as a 2-dimensional array
	Dim arrFirstPass
	Dim arrSecondPass
	Dim arrTemp
	Dim intRow
	Dim intQuotes
	arrFirstPass = Split(strJSON, ", """)
	
	'clean up data
	For intRow = 0 to UBound(arrFirstPass)
		arrFirstPass(intRow) = Replace(arrFirstPass(intRow), "{", " ")
		arrFirstPass(intRow) = Replace(arrFirstPass(intRow), "}", " ")
		arrFirstPass(intRow) = Replace(arrFirstPass(intRow), """", " ")
		arrFirstPass(intRow) = Trim(arrFirstPass(intRow))
	Next
	
	ReDim arrSecondPass(2, intRow - 1)
	For intRow = 0 to UBound(arrSecondPass, 2)
		arrTemp = Split(arrFirstPass(intRow), ":", 2)
		arrSecondPass(0, intRow) = Trim(arrTemp(0))
		arrSecondPass(1, intRow) = Trim(arrTemp(1))
		Erase arrTemp
	Next
	ParseJSON = arrSecondPass
End Function

Function SearchArray(ByVal arrData, ByVal strSearchString)
	'This function searches through each row of the first column and returns
	' the element in the second column of the corresponding matched row.
	' If the search string is not found, the fuction returns "String not found"
	Dim intRow	
	For intRow = 0 to UBound(arrData, 2)
		If arrData(0, intRow) = strSearchString	Then
			SearchArray = arrData(1, intRow)
			Exit Function
		Else
			SearchArray = "String not found"
		End If
	Next
End Function

Function CleanJobNumber(ByVal strNo)
	'This function removes unwanted characters from the job number string
	' and returns the job number.
	strNo = Replace(strNo, "[", " ")
	strNo = Replace(strNo, "]", " ")
	strNo = Trim(strNo)
	CleanJobNumber = strNo
End Function

Function ReturnFilePath()
	'This function opens a dialogue to allow the user to select an image file.
	' The file path is then returned.
	Dim wShell
	Dim oExec
	Dim sFileSelected
	
	Set wShell=CreateObject("WScript.Shell")
	Set oExec=wShell.Exec("mshta.exe ""about:<input type=file id=FILE><script>FILE.click();new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).WriteLine(FILE.value);close();resizeTo(0,0);</script>""")
	sFileSelected = oExec.StdOut.ReadLine
	wscript.echo sFileSelected
	ReturnFilePath = sFileSelected
	Set wShell = Nothing
	Set oExec = Nothing
End Function

Function Degrees2DMS(ByVal val) 'Converts decimal degrees to D:M:S format
   Dim AsUtil 'ASCOM Utilities object
   Set AsUtil = CreateObject("ASCOM.Utilities.Util")
   Degrees2DMS = AsUtil.DegreesToDMS(val, "D ", "M ", "S ", 0)
End Function

Function Degrees2HMS(ByVal val) 'Converts decimal degrees to H:M:S format
   Dim AsUtil 'ASCOM Utilities object
   Set AsUtil = CreateObject("ASCOM.Utilities.Util")
   Degrees2HMS = AsUtil.DegreesToHMS(val, "H ", "M ", "S ", 0)
End Function

astrometry.zip

[WillieBuning]

Russel, thanx for your code, I changed it a little bit for automation purpose, works great, however when i upload FITS files and Or bigger JPG files to Astrometry.net I have a time out event, maybe (hopefully) you have an Idea?

Thanks for your answer.

Greetings from Zwolle Netherlands.

Willie.