NSGI coordinate transformation call from Excel [WIP] #vba #api #excel #nsgi

nsgi-coordinates-trans-api.bas

Public Function CFormat(ParamArray arr() As Variant) As String
    Dim i As Long
    Dim temp As String
    temp = CStr(arr(0))
    For i = 1 To UBound(arr)
        myVal = arr(i)
        If IsNull(myVal) Then
            myVal = "null"
        End If
        
        temp = Replace(temp, "{" & i - 1 & "}", CStr(myVal))
    Next
    CFormat = temp
End Function

Private Function IndexOf(arr1 As Variant, vFind As Variant) As Variant
Dim i As Long
For i = LBound(arr1) To UBound(arr1)
    If arr1(i) = vFind Then
        IndexOf = i
        Exit Function
    End If
Next i
IndexOf = Null
End Function


Public Function NsgiTransformRange(rng As Range, myColumns As String, sourceCrs As String, targetCrs As String) As Variant
    Dim temp() As Variant
    ReDim temp(rng.Rows.Count - 1, rng.columns.Count - 1)
    
    Dim items() As String
    items = Split(myColumns, ",")
    
    Dim xIndex As Variant
    Dim yIndex As Variant
    Dim zIndex As Variant
    
    xIndex = IndexOf(items, "x")
    yIndex = IndexOf(items, "y")
    zIndex = IndexOf(items, "z")
    Debug.Print CFormat("zIndex={0}, yIndex={1}, xIndex={2}, rng.Rows.Count={3}", zIndex, yIndex, xIndex, rng.Rows.Count)
    
    'Dim rowCount As Integer
    Dim featuresStr As String
    featuresStr = ""
    processedRows = 0
    
    For x = 1 To rng.Rows.Count
        Dim xVal, yVal, zVal As Variant
        
        xVal = rng.Cells(x, xIndex + 1).Value
        yVal = rng.Cells(x, yIndex + 1).Value
        zVal = Null
        
        
        If Not IsNull(zIndex) Then
            zVal = rng.Cells(x, zIndex).Value
            coordStr = CFormat("{0},{1},{2}", xVal, yVal, zVal)
        Else
            coordStr = CFormat("{0},{1}", xVal, yVal)
        End If
        Debug.Print CFormat("coordStr={0}", coordStr)
        
        Dim ftStr As String
        ftStr = CFormat("{""type"":""Feature"",""properties"":{},""geometry"":{""type"":""Point"",""coordinates"":[{0}]}}", coordStr)
        If Len(featuresStr) > 0 Then
            ftStr = "," & ftStr
        End If
        featuresStr = featuresStr & ftStr
        processedRows = processedRows + 1
        Dim batchSize As Integer
        batchSize = 10
        
        Debug.Print CFormat("processdedRows={0}, rng.Rows.count={1}", processedRows, rng.Rows.Count)
        ' if finished or multiple of batchsize then do request
        If processedRows = rng.Rows.Count Or (processedRows Mod batchSize) = 0 Then
            
            Dim fc As String
            fc = CFormat("{""type"":""FeatureCollection"",""name"":""punten"",""features"":[{0}]}", featuresStr)
            Dim apiReq As Object
            Set apiReq = CreateObject("WinHttp.WinHttpRequest.5.1")
            Dim url As String
            url = CFormat("https://api.transformation.test.nsgi.nl/v2/transform?source-crs={0}&target-crs={1}", sourceCrs, targetCrs) 'EPSG:7415 EPSG:7931
            
            apiReq.Open "POST", url, False
            apiReq.setRequestHeader "Content-type", "application/json"
            apiReq.send (fc)
            Debug.Print CFormat("POST request to: {0}, status: {1}", url, apiReq.Status)
             
            featuresStr = ""
            responseBody = apiReq.ResponseText
            'TODO: add error handling and feedback to user
            Dim vJSON
            Dim sState As String
            JSON.Parse responseBody, vJSON, sState
            Select Case True
                Case sState <> "Object"
                    MsgBox "Invalid JSON response"
                    Exit Function
                Case Not vJSON.Exists("features")
                    MsgBox "JSON contains no features"
                    Exit Function
                Case Else
                    features = vJSON("features")
                    Dim rowIndex As Integer
                    If rng.Rows.Count < batchSize Then
                        rowIndex = 0
                    Else
                        rowIndex = processedRows - batchSize
                    End If
                    For i = 0 To UBound(features)
                        Debug.Print CFormat("rowIndex:{0}, xIndex:{1}, yIndex:{2}, zIndex:{3}", rowIndex, xIndex, yIndex, zIndex)
                        coords = features(i)("geometry")("coordinates")
                        temp(rowIndex, xIndex) = CStr(coords(0))
                        temp(rowIndex, yIndex) = CStr(coords(1))
                        If Not IsNull(zIndex) Then
                          coordsLen = UBound(coords) - LBound(coords) + 1
                          If coordsLen = 3 Then
                            temp(rowIndex, zIndex) = CStr(coords(2))
                          End If
                        End If
                        rowIndex = rowIndex + 1
                    Next i
            End Select
        End If
    Next x
    NsgiTransformRange = temp
End Function


Sub DebugFun()
    '=MyFunction(;"x,y";"EPSG:7415";"EPSG:7931")
    result = NsgiTransformRange(Range("A2:C21"), "x,y,z", "EPSG:7415", "EPSG:7931")
    ArrayLen = UBound(result) - LBound(result) + 1
    MsgBox CFormat("length of resulting array: {0}", CStr(ArrayLen))
End Sub

Sub DescribeFunction()
    Dim FuncName As String
    Dim FuncDesc As String
    Dim Category As String
    Dim ArgDesc(1 To 4) As String
    
    FuncName = "NsgiTransformRange"
    FuncDesc = "Transforms a range of coordinates with the NSGI Coordinates Transformation API"
    ArgDesc(1) = "Range with coordinates"
    ArgDesc(2) = "Axis order of range, use x, y and z in comma delimited string, i.e: ""y,x,z"""
    ArgDesc(3) = "Source CRS identifier in form of EPSG:XXXX, see list of supported CRSs in API"
    ArgDesc(4) = "Target CRS identifier in form of EPSG:XXXX, see list of supported CRSs in API"
    
    Application.MacroOptions _
      Macro:=FuncName, _
      Description:=FuncDesc, _
      Category:=Category, _
      ArgumentDescriptions:=ArgDesc
End Sub