Пример создания базы данных GPS-измерений

Эта страница является черновиком статьи.

Задача

Дано: Имеется много gpx-файлов, полученные из MapSource (BaseCamp)

Получить: Собрать все данные (точки (waypoints) и трэки (tracklogs)) в одном месте. Отсеяв дубли, «ненужные» точки.

Ресурсы: MySQL Server 5.0.67-community-nt via TCP/IP; MySQL GUI 5.1.11; MySQL Connector/ODBC 5.1.12; Microsoft Office 2007

Решение

1. Структура БД

Gpx полученные из MapSource, обладают рядом особенностей:

• заполняются не все «поля»
• собственное расширение (<extensions>)
• дата и время для waypoints пишется как текст в элементы <cmt> и <desc>

Дамп БД:Файл:Gpx db 20130407 2315.zip

[показать]

Пример точки

  <wpt lat="56.8854080" lon="62.2301917">
    <ele>97.2182617</ele>
    <name>218</name>
    <cmt>04-SEP-12 10:54:49</cmt>
    <desc>04-SEP-12 10:54:49</desc>
    <sym>Short Tower</sym>
    <extensions>
      <gpxx:WaypointExtension xmlns:gpxx="http://www.garmin.com/xmlschemas/GpxExtensions/v3">
        <gpxx:DisplayMode>SymbolAndName</gpxx:DisplayMode>
      </gpxx:WaypointExtension>
    </extensions>
  </wpt>

В данном случае меня интересовали: геометрия (lat, lon), имя (name), высота (ele), дата/время (cmt), символ(sym). Содержание <desc> дублирует <cmt>, с точки зрения MapSource: <cmt> - время, <desc> - комментарий к точке, <extensions> влияет только на отображение точки в MapSource. Символ <sym> записывается как string, лучше вынести в отдельную таблицу.

[показать]

Структура таблиц wpt (waypoints) и symtbl (<sym>)

CREATE TABLE `wpt` (
  `id` int(10) unsigned NOT NULL auto_increment,
  `p` point NOT NULL,
  `name` varchar(45) NOT NULL,
  `ele` double default NULL,
  `cmt` datetime default NULL,
  `sym` int(10) unsigned NOT NULL,
  PRIMARY KEY  (`id`))

CREATE TABLE `symtbl` (
  `id` int(10) unsigned NOT NULL auto_increment,
  `desc` varchar(45) NOT NULL,
  PRIMARY KEY  (`id`))

[показать]

Пример трека

  <trk>
    <name>ACTIVE LOG</name>
    <extensions>
      <gpxx:TrackExtension xmlns:gpxx="http://www.garmin.com/xmlschemas/GpxExtensions/v3">
        <gpxx:DisplayColor>Blue</gpxx:DisplayColor>
      </gpxx:TrackExtension>
    </extensions>
    <trkseg>
      <trkpt lat="57.0097966" lon="63.6981842">
        <ele>165.4841309</ele>
        <time>2012-09-03T01:27:07Z</time>
      </trkpt>
    </trkseg>
  </trk>

Трек имеет только имя и множество точек, тип которых – wptType, но с более аскетичным содержанием. Здесь надо заметить, что элемент содержит время в Univeral Coordinated Time (UTC), в отличии от локального в <cmt>, следует выбрать единое время для БД и привести к нему все значения. Для удобства следует получить linestring, для отображения трэка, но желательно сохранить время для каждой точки трэка. Также удобно знать время трэка, по первой точке. Для трэков с одной точкой поле trk_line=null. Также надо учитывать, что трэк может содержать несколько сегментов (Track Segment), хотя MapSource кажется, так не делает, вместо этого создавая новый трэк. Создадим таблицы, для треков и точек треков, у последних получится два внешних ключа trk_id и nseg, хотя nseg получается «висячим» - так как никуда не указывает…

[показать]

Структура таблиц trk(tracklogs) и trkpt (Track Point)

CREATE TABLE `trk` (
  `id` int(10) unsigned NOT NULL auto_increment,
  `name` varchar(45) default NULL,
  `trk_line` linestring default NULL,
  `dt` datetime default NULL,
  PRIMARY KEY  (`id`))

CREATE TABLE `trkpt` (
  `id` int(10) unsigned NOT NULL auto_increment,
  `trk_id` int(10) unsigned NOT NULL,
  `nseg` int(10) unsigned NOT NULL default '1',
  `p` point NOT NULL,
  `ptime` datetime default NULL,
  `ele` double default NULL,
  PRIMARY KEY  (`id`))

Функция для заполнения `trk_line`

Я это называю - "собирать бисер". В SFA нет функций для редактирования геометрии (в PostGIS и Oracle Spatila - есть). По хорошему надо использовать WKB - но как сделать это на SQL - я не знаю. Поэтому использую WKT и колдую с текстом (longText, по началу использовал text - как то не хватило...). У MySQL есть пара неприятных моментов связанных с геометрией: при попытке создать в хранимке определённую геометрию (например LINESTRING) - MySQL меняет функцию на создание просто геометрии (и внезапно получаем MULTIPOINT, хотя может это косяк моей версии), поэтому я использовал geomfromtext и в строке явно указывал тип геометрии. При объявлении "Declare p1, p2 point;" p1, p2 - это указатели, а значит при set p1=p2 мы получаем два указателя на один объект. Что бы скопировать точку приходится городить такое : Set p1 = geomfromtext(concat('Point(', X(CrP), ' ', Y(CrP), ')'));

[показать]

CreateTrkLine

PROCEDURE `CreateTrkLine`(nid int)
BEGIN
  Declare done int default 0;
  declare coup, i int default 0;
  Declare p1, p2, CrP point;
  Declare CrLn LineString;
  Declare Cur1 Cursor for
   SELECT p FROM `gpx_db`.`trkpt` where trk_id=nid and nseg=1;
  Declare Continue Handler For not found set done = 1;

  Open Cur1;
  Repeat
   Fetch Cur1 into CrP;
    if Not Done then
     case i
      when 0 then
       Set p1 = geomfromtext(concat('Point(', X(CrP), ' ', Y(CrP), ')'));
      when 1 then
       Set CrLn = geometryfromtext(concat('LineString(',x(p1),' ',y(p1),',',x(CrP),' ',y(CrP),')'));
      else
       Set CrLn = `LS_AddPoint`(CrLn, CrP);
     end case;
     Set i=i+1;
    End if;
  Until done End Repeat;
  Close Cur1;

  update trk set `trk_line`=CrLn where id=nid;
END $$

[показать]

Функция для добавления Point к LineString

FUNCTION `LS_AddPoint`(Ls LineString, np point) RETURNS linestring
BEGIN
  Declare I, ICount Integer default 1;
  Declare nStr longText;
  Declare crP Point;
  Set ICount = NumPoints(Ls) + 1;
  Set nStr = 'LineString(';
  while I < ICount do
   Set crP = PointN(Ls, I);
   Set nStr = Concat(nStr, X(crP), ' ', Y(crP), ',');
   set I = I + 1;
  end while;
  Set nStr = Concat(nStr, X(nP), ' ', Y(nP), ')');
  Return LineFromText(nStr);
END $$

1. Импорт данных

Для разработки модуля импорта данных, я выбрал VBA, по двум причинам: наиболее удобный IDE из доступных у меня на рабочей машине; наличие опыта и наработок. Перед началом работы, необходимо подключить Microsoft XML v6.0 (работа с XML) и Microsoft ActiveX Data Objects 2.8 Library (подключение БД). Также я использовал WinAPI, а именно GetOpenFileNameA из comdlg32.dll. Изначально, было решено, разделить чтение и запись, что бы передать данные используются структуры: wpt_rec и trk_rec. В начале разработки, в отладочных целях, данные записывались на Лист в Excel'е - данный код приведён в листингах, но закомментирован. Некрасиво получилось то, что фильтрация исходных данных происходить в разных местах: для точек - при чтении XML'я (If cWPT.cmt <> "" Then 'У "ненужных" точек cWPT.cmt=""), для треков в начале записи в БД (If nTRK.s(0).p(0).time <> "" Then). Так же разделено преобразование даты/время, но здесь это оправданно - как было сказано выше, в точках и трэках время записано по разному.

Запуск импорта - test1.

Файл с макросами (xlsm):Файл:Imp gpx.zip

[показать]

Обработка XML'я

'Переменные для записи данных на Лист
Dim gI As Integer, gJ As Integer
Dim cRange As Range

Public Type wpt_rec
'waypoints
 lat As Double
 lon As Double
 name As String
 ele As Double
 cmt As String 'select str_to_date('15-AUG-12 9:38:50', '%d-%M-%Y %H:%i:%s')
 sym As Integer
End Type

Public Type trk_pt_rec
'Track Point
 lat As Double
 lon As Double
 ele As Double
 time As String
End Type

Public Type trk_seg
'Track Segment
 p() As trk_pt_rec
End Type

Public Type trk_rec
'tracklogs
 name As String
 s() As trk_seg
End Type

Public Sub OpenGPX(crFile As String)
'Обрабока gpx
 Dim i As Integer
 Dim ObjDoc As MSXML2.DOMDocument60
 Dim nNode As IXMLDOMNode
 '
 Set ObjDoc = New MSXML2.DOMDocument60
 ObjDoc.Load crFile 'Открываем
 ObjDoc.setProperty "SelectionNamespaces", "xmlns=""http://www.topografix.com/GPX/1/1"""

 For i = 0 To ObjDoc.DocumentElement.ChildNodes.Length - 1
 'получаем узел и назначаем метод обработки, в зависемости от типа
  Set nNode = ObjDoc.DocumentElement.ChildNodes.Item(i)
  If nNode.BaseName = "wpt" Then Work_wpt1 nNode
  If nNode.BaseName = "trk" Then Work_trk1 nNode
 Next i
End Sub

Public Sub test1()
'Открываем gpx'ы
 Dim i As Integer
 Dim arr
 'StartWorksheet 'Получаем Лист
 Start1 'Подключаемся к БД
 arr = Split(OpenFile(0), Chr(0))
 'Проверяем количество файлов
 If UBound(arr) = 1 Then
  OpenGPX (arr(0))
 Else
  For i = 1 To UBound(arr) - 1
   OpenGPX (arr(0) & "\" & arr(i))
  Next i
 End If
 'MsgBox "Good"
End Sub

Public Sub Work_wpt1(nWPT As IXMLDOMNode)
'Обработка waypoints
 Dim i As Integer, symid As Integer
 Dim cWPT As wpt_rec
 Dim nNode As IXMLDOMNode
 'nwpt
 cWPT.lat = nWPT.Attributes.Item(0).Text
 cWPT.lon = nWPT.Attributes.Item(1).Text
 'cRange.Cells(gI, 3).Value = nwpt.ChildNodes.Item(1).Text
 For i = 0 To nWPT.ChildNodes.Length - 1
  Set nNode = nWPT.ChildNodes.Item(i)
  Select Case nNode.BaseName 'Обрабатываем потомков
   Case "name": cWPT.name = nNode.Text
   Case "ele": cWPT.ele = nNode.Text
   Case "cmt": cWPT.cmt = nNode.Text
   Case "sym": cWPT.sym = GetSymId(nNode.Text)
    'cRange.Cells(gI, 6).Value = symid
    'cRange.Cells(gI, 7).Value = nNode.Text
  End Select
 Next i
 If cWPT.cmt <> "" Then 'У "ненужных" точек cWPT.cmt=""
  'cRange.Cells(gI, 1).Value = cWPT.lat
  'cRange.Cells(gI, 2).Value = cWPT.lon
  'cRange.Cells(gI, 3).Value = cWPT.name
  'cRange.Cells(gI, 4).Value = cWPT.ele
  'cRange.Cells(gI, 5).Value = cWPT.cmt
  'cRange.Cells(gI, 6).Value = cWPT.sym
  'cRange.Cells(gI, 8).Value = SearchWPT(cWPT)
  InsWPT cWPT 'Отправляем waypoints в БД
 End If
 'gI = gI + 1
End Sub

Public Sub StartWorksheet()
' Получаем Лист
 Dim l1 As Worksheet
 Set Worksheet = Worksheets.Item("Лист1")
 Set cRange = Worksheet.Cells
 gI = 1: gJ = 1
 'cRange.Cells(1, 1).Value = "good"
End Sub

Public Function Work_trkseg1(nTRKseg As IXMLDOMNode) As trk_seg
'Обработка Track Segment
 Dim i, J, np As Integer
 Dim WorkStr As String
 'Dim cP As trk_pt_rec
 Dim nNode As IXMLDOMNode
 Dim nNode2 As IXMLDOMNode
 'nTRK
 np = 0
 For i = 0 To nTRKseg.ChildNodes.Length - 1
  Set nNode = nTRKseg.ChildNodes.Item(i)
  Select Case nNode.BaseName 'Обрабатываем потомков
   Case "trkpt"
    ReDim Preserve Work_trkseg1.p(np)
    Work_trkseg1.p(np).lat = nNode.Attributes.Item(0).Text
    Work_trkseg1.p(np).lon = nNode.Attributes.Item(1).Text
    For J = 0 To nNode.ChildNodes.Length - 1
     Set nNode2 = nNode.ChildNodes.Item(J)
     Select Case nNode2.BaseName 'Обрабатываем потомков
      Case "ele": Work_trkseg1.p(np).ele = nNode2.Text
      Case "time" 'Форматируем время
       WorkStr = nNode2.Text
       WorkStr = Replace(WorkStr, "T", " ")
       WorkStr = Replace(WorkStr, "Z", "")
       Work_trkseg1.p(np).time = WorkStr
     End Select
    Next J
    'Work_trkseg1.p(np) = cP
    np = np + 1
  End Select
 Next i
End Function

Public Sub Work_trk1(nTRK As IXMLDOMNode)
'Обработка tracklogs
 Dim i, trkseg As Integer
 Dim cTRK As trk_rec
 Dim nNode As IXMLDOMNode
 'nTRK
 trkseg = 0
 For i = 0 To nTRK.ChildNodes.Length - 1
  Set nNode = nTRK.ChildNodes.Item(i)
  Select Case nNode.BaseName 'Обрабатываем потомков
   Case "name": cTRK.name = nNode.Text
   Case "trkseg"
    ReDim Preserve cTRK.s(trkseg)
    cTRK.s(trkseg) = Work_trkseg1(nNode)
    trkseg = trkseg + 1
  End Select
 Next i
 'WrTrk cTRK
 InsTRK cTRK 'Отправляем tracklogs в БД
End Sub

Public Sub WrTrk(cTRK As trk_rec)
'Обработка Track для записи на Лист
 Dim i, J As Integer
 For i = 0 To UBound(cTRK.s)
  For J = 0 To UBound(cTRK.s(i).p)
   'cRange.Cells(gI, 1).Value = cTRK.name
   'cRange.Cells(gI, 2).Value = I + 1
   'cRange.Cells(gI, 3).Value = cTRK.s(I).p(J).lat
   'cRange.Cells(gI, 4).Value = cTRK.s(I).p(J).lon
   'cRange.Cells(gI, 5).Value = cTRK.s(I).p(J).ele
   'cRange.Cells(gI, 6).Value = cTRK.s(I).p(J).time
   gI = gI + 1
  Next J
 Next i
 'InsTRK cTRK
End Sub

[показать]

Загрузка в БД

Dim MyConnect As ADODB.Connection

Public Function ConnectToMySQL() As ADODB.Connection
 'Подключаемся к БД
 Set ConnectToMySQL = New ADODB.Connection
 ConnectToMySQL.ConnectionString = "Driver={MySQL ODBC 5.1 Driver};Server=localhost;Database=gpx_DB;User=guest;Password=guest;Option=3;"
 ConnectToMySQL.Open
End Function

Public Sub Start1()
'Подключаемся к БД
 Set MyConnect = ConnectToMySQL
End Sub

'"SELECT id FROM `gpx_db`.`symtbl` where `desc`="
Public Function GetSymId(SymDesc As String) As Integer
' Обрабатываем <sym>, получаем ключ из symtbl
 Dim StrSQL As String
 Dim MyRS As ADODB.Recordset
 '
 Set MyRS = New ADODB.Recordset
 Set MyRS.ActiveConnection = MyConnect
 MyRS.Source = "SELECT id FROM `gpx_db`.`symtbl` where `desc`=""" & SymDesc & """;"
 MyRS.Open
 If MyRS.BOF And MyRS.EOF Then
  InsSymDesc (SymDesc)
  GetSymId = GetSymId(SymDesc)
 Else
  GetSymId = MyRS.fields(0).Value
 End If
End Function

'insert into `gpx_db`.`symtbl` values (null,'Restaurant')
Public Sub InsSymDesc(SymDesc As String)
'Добавляем новое значение <sym>
 MyConnect.Execute "insert into `gpx_db`.`symtbl` values (null,""" & SymDesc & """);"
End Sub

'SELECT * FROM wpt w where p=geomfromtext('POINT(60.5513457 59.5433567)') and cmt=str_to_date('15-AUG-12 9:38:50', '%d-%M-%Y %H:%i:%s');
Public Function SearchWPT(nWPT As wpt_rec) As Integer
 'Ищем waypoints в БД
 Dim StrSQL As String
 Dim MyRS As ADODB.Recordset
 '
 Set MyRS = New ADODB.Recordset
 Set MyRS.ActiveConnection = MyConnect
 MyRS.Source = "SELECT id FROM wpt w where p=geomfromtext(""POINT(" & nWPT.lon & " " & nWPT.lat & ")"") and cmt=" & _
  "str_to_date(""" & nWPT.cmt & """, ""%d-%M-%Y %H:%i:%s"");"
 MyRS.Open
 If MyRS.BOF And MyRS.EOF Then
  SearchWPT = 0
 Else
  SearchWPT = MyRS.fields(0).Value
 End If
End Function

'select str_to_date('15-AUG-12 9:38:50', '%d-%M-%Y %H:%i:%s')
Public Sub InsWPT(nWPT As wpt_rec)
'Добавляем waypoints в БД
 If SearchWPT(nWPT) = 0 Then 'Проверяем наличие
 'geomfromtext('Point(0 0)')
 MyConnect.Execute "insert into `gpx_db`.`wpt` values (null,geomfromtext(""Point(" & nWPT.lon & " " & nWPT.lat & ")""), """ & nWPT.name & _
  """, " & nWPT.ele & ", str_to_date(""" & nWPT.cmt & """, '%d-%M-%Y %H:%i:%s'), " & nWPT.sym & ");"
 End If
End Sub

'SELECT id FROM trk t where name='ACTIVE LOG' and dt='2012-08-15 09:51:32';
Public Function SearchTRK(nTRK As trk_rec) As Integer
 'Ищем tracklogs в БД
 Dim StrSQL As String
 Dim MyRS As ADODB.Recordset
 '
 Set MyRS = New ADODB.Recordset
 Set MyRS.ActiveConnection = MyConnect
 MyRS.Source = "SELECT id FROM trk where name=""" & nTRK.name & """ and dt=CONVERT_TZ(str_to_date(""" & nTRK.s(0).p(0).time & _
  """, '%Y-%m-%d %H:%i:%s'),'+00:00','+6:00');"
 'MyRS.Source = "select SearchTrk(" & nTRK.s(0).p(0).lon & ", " & nTRK.s(0).p(0).lat & ", CONVERT_TZ(str_to_date(""" & nTRK.s(0).p(0).time & _
 ' """, '%Y-%m-%d %H:%i:%s'),'+00:00','+6:00'))"
 MyRS.Open
 If MyRS.BOF And MyRS.EOF Then
  SearchTRK = 0
 Else
  SearchTRK = MyRS.fields(0).Value
 End If
End Function

Public Function InsTRK(nTRK As trk_rec) As Integer
 'Добавляем tracklogs в БД
 Dim res As Integer
 '
 If nTRK.s(0).p(0).time <> "" Then
  res = SearchTRK(nTRK)
  If res = 0 Then
   MyConnect.Execute "insert into `gpx_db`.`trk` values (null, """ & nTRK.name & """, 0, null, CONVERT_TZ(str_to_date(""" & _
    nTRK.s(0).p(0).time & """, '%Y-%m-%d %H:%i:%s'),'+00:00','+6:00'));"
   res = SearchTRK(nTRK)
   InsTRKpts nTRK, res
   MyConnect.Execute "call CreateTrkLine(" & res & ");"
  End If
  InsTRK = res
 End If
End Function

Public Sub InsTRKpts(nTRK As trk_rec, TRK_id As Integer)
'Добавляем Track Point в БД
 Dim i, J As Integer
 '
 For i = 0 To UBound(nTRK.s)
  For J = 0 To UBound(nTRK.s(i).p)
   MyConnect.Execute "insert into `gpx_db`.`trkpt` values (null, " & TRK_id & ", " & i + 1 & _
    ", geomfromtext(""Point(" & nTRK.s(i).p(J).lon & " " & nTRK.s(i).p(J).lat & ")""), " & _
    "CONVERT_TZ(str_to_date(""" & nTRK.s(i).p(J).time & """, '%Y-%m-%d %H:%i:%s'),'+00:00','+6:00'), " & _
    nTRK.s(i).p(J).ele & ");"
  Next J
 Next i
End Sub

[показать]

OpenFile

Private Const OFN_ALLOWMULTISELECT As Long = &H200
Private Const OFN_CREATEPROMPT As Long = &H2000
Private Const OFN_ENABLEHOOK As Long = &H20
Private Const OFN_ENABLETEMPLATE As Long = &H40
Private Const OFN_ENABLETEMPLATEHANDLE As Long = &H80
Private Const OFN_EXPLORER As Long = &H80000
Private Const OFN_EXTENSIONDIFFERENT As Long = &H400
Private Const OFN_FILEMUSTEXIST As Long = &H1000
Private Const OFN_HIDEREADONLY As Long = &H4
Private Const OFN_LONGNAMES As Long = &H200000
Private Const OFN_NOCHANGEDIR As Long = &H8
Private Const OFN_NODEREFERENCELINKS As Long = &H100000
Private Const OFN_NOLONGNAMES As Long = &H40000
Private Const OFN_NONETWORKBUTTON As Long = &H20000
Private Const OFN_NOREADONLYRETURN As Long = &H8000& 'see comments
Private Const OFN_NOTESTFILECREATE As Long = &H10000
Private Const OFN_NOVALIDATE As Long = &H100
Private Const OFN_OVERWRITEPROMPT As Long = &H2
Private Const OFN_PATHMUSTEXIST As Long = &H800
Private Const OFN_READONLY As Long = &H1
Private Const OFN_SHAREAWARE As Long = &H4000
Private Const OFN_SHAREFALLTHROUGH As Long = 2
Private Const OFN_SHAREWARN As Long = 0
Private Const OFN_SHARENOWARN As Long = 1
Private Const OFN_SHOWHELP As Long = &H10
Private Const OFS_MAXPATHNAME As Long = 260

Public Type OpenFileName
        lStructSize As Long
        hwndOwner As Long
        hInstance As Long
        lpstrFilter As String
        lpstrCustomFilter As String
        nMaxCustFilter As Long
        nFilterIndex As Long
        lpstrFile As String
        nMaxFile As Long
        lpstrFileTitle As String
        nMaxFileTitle As Long
        lpstrInitialDir As String
        lpstrTitle As String
        flags As Long
        nFileOffset As Integer
        nFileExtension As Integer
        lpstrDefExt As String
        lCustData As Long
        lpfnHook As Long
        lpTemplateName As String
End Type

Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" _
(pOpenfilename As OpenFileName) As Long

Public Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" _
(pOpenfilename As OpenFileName) As Long

Public Function OpenFile(crHwnd As Long, Optional Directory As String) As String
  Dim strTemp As String
  Dim OpenFileName As OpenFileName
  With OpenFileName
    .lStructSize = Len(OpenFileName)
    .hwndOwner = crHwnd
    .lpstrFilter = "gpx (" & "gpx" & ")" & Chr$(0) & "*.gpx" & Chr$(0)
    .lpstrFile = Space$(254)
    .nMaxFile = 255
    .lpstrFileTitle = Space$(254)
    .nMaxFileTitle = 255
    .lpstrInitialDir = Directory
    .lpstrTitle = "Выбор Файла"
    .flags = OFN_EXPLORER Or OFN_ALLOWMULTISELECT
    '.lpstrDefExt = "gpx"
    If GetOpenFileName(OpenFileName) Then
      strTemp = (Trim(.lpstrFile))
      OpenFile = Mid(strTemp, 1, Len(strTemp) - 1)
    End If
  End With
End Function
'
Public Function SaveFile(crHwnd As Long, Optional Directory As String) As String
  Dim strTemp As String
  Dim OpenFileName As OpenFileName
  With OpenFileName
    .lStructSize = Len(OpenFileName)
    .hwndOwner = crHwnd
    .lpstrFilter = "GPX (" & "gpx" & ")" & Chr$(0) & "*.gpx" & Chr$(0)
    .lpstrFile = Space$(254)
    .nMaxFile = 255
    .lpstrFileTitle = Space$(254)
    .nMaxFileTitle = 255
    .lpstrInitialDir = Directory
    .lpstrTitle = "Выбор Файла"
    .flags = OFN_EXPLORER Or OFN_ALLOWMULTISELECT
    .lpstrDefExt = "gpx"
    If GetSaveFileName(OpenFileName) Then
      strTemp = (Trim(.lpstrFile))
      SaveFile = Mid(strTemp, 1, Len(strTemp) - 1)
    End If
  End With
End Function

Использование

QGIS
AutoCAD Map 3D

Ссылки

gpx.xsd
MapSource
GpxExtensions