Skip to main content

Slovenian Postal Codes v. 2

In my previous blog post I gave a list of Slovenian postal codes based on a revision of an online source. Below I give you a Google based object oriented VBA solution, which easily generalizes to parsing of other xml sources. Geocoding can have an enormous impact on presentations and requires a careful processing. I use an automated VBA routine inspired by the code below, but still find that inspection is necessary. Often there are several loations of observations, businesses or respondents in a survey, that have to pinpointed using auxiliary information, which depends on the problem at hand. Have a look at www.hellmund-laier.dk

VBA module


Option Explicit

Public xmlDoc As
MSXML2.DOMDocument60

Public Function lat(searchfield As String)
Dim googleUrl As String
googleUrl = "http://maps.googleapis.com/maps/api/geocode/xml?address=" & searchfield & "&sensor=false"
Set xmlDoc = New MSXML2.DOMDocument60
xmlDoc.async = False
xmlDoc.Load (googleUrl)
lat = xmlDoc.SelectSingleNode("GeocodeResponse/result/geometry/location/lat").Text
End Function

Public Function lng(searchfield As String)
lng = xmlDoc.SelectSingleNode("GeocodeResponse/result/geometry/location/lng").Text
End Function



Example


lng function call must follow a lat function call which instantiates the MSXML2.DOMDocument object.

In Excel with contents 1000,+Slovenia in cell A1, we place coordinate values in two separate cells using a single Google Map query  =lat(A1) superseeded by =lng(A1). The queries to the XML object return the values 46.0363798 and 14.4896074.
To get things working you have to check Microsoft XML, v6.0 in the References... menu item found in the Tools menu of the VBA editor.

Supplementary note


I needed to convert a unicode input string to UTF-8 encoding. Below is the complete VBA module source including a converter suggested by Mycopka.

The UTF-8 encoded input string Forbindelsesvejen 116,+9400,+Nørresundby,+Denmark  returns values 57.0706070 and 9.9386770.



Source


Option Explicit



Public Declare PtrSafe Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As String, ByVal lpUsedDefaultChar As Long) As Long

Public Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)

Private Const m_bIsNt As Boolean = True

Public Const CP_UTF8 = 65001

Public xmlDoc As MSXML2.DOMDocument60



'Purpose:Convert Unicode string to UTF-8.

Public Function UTF8_Encode(ByVal strUnicode As String, Optional ByVal bHTML As Boolean = True) As String
   Dim i                As Long
   Dim TLen             As Long
   Dim lPtr             As Long
   Dim UTF16            As Long
   Dim UTF8_EncodeLong  As String
   TLen = Len(strUnicode)
   If TLen = 0 Then Exit Function
   If m_bIsNt Then
      Dim lngBufferSize    As Long
      Dim lngResult        As Long
      Dim bytUtf8()        As Byte
      'Set buffer for longest possible string.
      lngBufferSize = TLen * 3 + 1
      ReDim bytUtf8(lngBufferSize - 1)
      'Translate using code page 65001(UTF-8).
      lngResult = WideCharToMultiByte(CP_UTF8, 0, StrPtr(strUnicode), _
         TLen, bytUtf8(0), lngBufferSize, vbNullString, 0)
      'Trim result to actual length.
      If lngResult Then
         lngResult = lngResult - 1
         ReDim Preserve bytUtf8(lngResult)
         'CopyMemory StrPtr(UTF8_Encode), bytUtf8(0&), lngResult
         UTF8_Encode = StrConv(bytUtf8, vbUnicode)
         ' For i = 0 To lngResult
         '    UTF8_Encode = UTF8_Encode & Chr$(bytUtf8(i))
         ' Next
      End If
   Else
      For i = 1 To TLen
         ' Get UTF-16 value of Unicode character
         lPtr = StrPtr(strUnicode) + ((i - 1) * 2)
         CopyMemory UTF16, ByVal lPtr, 2
         'Convert to UTF-8
         If UTF16 < &H80 Then                                      ' 1 UTF-8 byte
            UTF8_EncodeLong = Chr$(UTF16)
         ElseIf UTF16 < &H800 Then                                 ' 2 UTF-8 bytes
            UTF8_EncodeLong = Chr$(&H80 + (UTF16 And &H3F))              ' Least Significant 6 bits
            UTF16 = UTF16 \ &H40                                   ' Shift right 6 bits
            UTF8_EncodeLong = Chr$(&HC0 + (UTF16 And &H1F)) & UTF8_EncodeLong  ' Use 5 remaining bits
         Else                                                      ' 3 UTF-8 bytes
            UTF8_EncodeLong = Chr$(&H80 + (UTF16 And &H3F))              ' Least Significant 6 bits
            UTF16 = UTF16 \ &H40                                   ' Shift right 6 bits
            UTF8_EncodeLong = Chr$(&H80 + (UTF16 And &H3F)) & UTF8_EncodeLong  ' Use next 6 bits
            UTF16 = UTF16 \ &H40                                   ' Shift right 6 bits
            UTF8_EncodeLong = Chr$(&HE0 + (UTF16 And &HF)) & UTF8_EncodeLong   ' Use 4 remaining bits
         End If
         UTF8_Encode = UTF8_Encode & UTF8_EncodeLong
      Next
   End If
   'Substitute vbCrLf with HTML line breaks if requested.
   If bHTML Then
      UTF8_Encode = Replace$(UTF8_Encode, vbCrLf, "")
   End If
End Function

Public Function lat(searchfield As String)
Dim googleUrl As String
googleUrl = "http://maps.googleapis.com/maps/api/geocode/xml?address=" & UTF8_Encode(searchfield) & "&sensor=false"
Set xmlDoc = New MSXML2.DOMDocument60
xmlDoc.async = False
xmlDoc.Load (googleUrl)
lat = xmlDoc.SelectSingleNode("GeocodeResponse/result/geometry/location/lat").Text
End Function

Public Function lng(searchfield As String)
lng = xmlDoc.SelectSingleNode("GeocodeResponse/result/geometry/location/lng").Text
End Function

Comments

Popular posts from this blog

HackRF on Windows 8

This technical note is based on an extract from thread. I have made several changes and added recommendations. I have experienced lot of latency using GnuRadio and HackRF on Pentoo Linux, so I wanted to try out GnuRadio on Windows.



HackRF One is a transceiver, so besides SDR capabilities, it can also transmit signals, inkluding sweeping a given range, uniform and Gaussian signals. Pentoo Linux provides the most direct access to HackRF and toolboxes. Install Pentoo Linux on a separate drive, then you can use osmocom_siggen from a terminal to transmit signals such as near-field GSM bursts, which will only be detectable within a meter.









Installation of MGWin and cmake: Download and install the following packages:
- MinGW Setup (Go to the Installer directory and download setup file)
- CMake (I am using CMake 3.2.2 and I installed it in C:\CMake, this path is important in the commands we must send in the MinGW shell)
Download and extract the packages respectively in the path C:\MinGW\msys\…

Example: Beeswarm plot in R

library(foreign)

data <- read.dta("C:/Users/hellmund/Documents/MyStataDataFile.dta")

names(data)

install.packages('beeswarm')

library(beeswarm)

levels(data$group)

png(file="C:/Users/hellmund/Documents/il6.png", bg="transparent")

beeswarm(data$il6~data$group,data=data, method=c("swarm"),pch=16,pwcol=data$Gender,xlab='',ylab='il6',ylim=c(0,20))

legend('topright',legend=levels(data$Gender),title='Gender',pch=16,col=2:1)

boxplot(data$il6~data$group, data=data, add = T, names = c("","",""), col="#0000ff22")

dev.off()

RPITX - a transmitter along frequencies from 130kHz to 500MHz

Great news. Raspberry Pi can now emit RF signals along a much wider range than previously publicized. It is three years since a team at Robotics Imperial College London wrote PiFM, a FM transmitter based on C and Python for the Raspberry Pi. PiFM enabled even novice Raspberians to setup a fm transmitter. RPITX by Evariste Okcestbon sets a new standard and may see a wide range of applications compared to PiFM. By design it is both more versatile and closer to the needs of a radio amateur. It is able to transmit at lower frequencies than even the HackRF, as it includes frequencies between 130kHz and 1MHz, though it is not capable of transmitting above 500MHz at this point. Innovations in electronics are still possible on Raspberry Pi, a modest platform for the auteur with the modest budget and a deep understanding of a well-documented interface and architecture. RPITX is available from GitHub. A third argument in the fcntl function open lacked in several source files (9th november …