Take "snapshot" from OSM Web, max 50000 NODE.
Example, Guggenheim Bilbao:
https://www.openstreetmap.org/export#ma ... 3/-2.93285
And export it in "osm" (xml text) format.
Another complex example, my little town, Sopelana:
https://www.openstreetmap.org/#map=15/43.3792/-2.9816 (this with almost 50000 NODES)
Using FILL Routine from:
viewtopic.php?t=24242&start=15
named: fill.bas
Code: Select all
Sub fill_polygon(a() As Long, bound As Integer, ByVal c As ULong)
'translation of a c snippet by Angad
' jepalza: variable "bound"
'source of c code: http://code-heaven.blogspot.it/2009/10/simple-c-program-for-scan-line-polygon.html
Dim As Long i, j, k, dy, dx, x, y, temp
Dim As Long xi(0 to bound)
Dim As Single slope(0 to bound)
'join first and last vertex
a(bound, 0) = a(0, 0)
a(bound, 1) = a(0, 1)
For i = 0 To bound - 1
dy = a(i+1, 1) - a(i, 1)
dx = a(i+1, 0) - a(i, 0)
If (dy = 0) Then slope(i) = 1.0
If (dx = 0) Then slope(i) = 0.0
If (dy <> 0) AndAlso (dx <> 0) Then slope(i) = dx / dy
Next i
For y = 0 to RESX - 1
k = 0
' using FB's short-cut operators (which C doesn't have!)
For i = 0 to bound - 1
If (a(i, 1) <= y AndAlso a(i+1, 1) > y) OrElse _
(a(i, 1) > y AndAlso a(i+1, 1) <= y) Then
xi(k) = CLng(a(i, 0) + slope(i) * (y - a(i, 1)))
k += 1
End If
Next i
For j = 0 to k - 2
'Arrange x-intersections in order
For i = 0 To k - 2
If (xi(i) > xi(i + 1)) Then
temp = xi(i)
xi(i) = xi(i + 1)
xi(i + 1) = temp
End If
Next i
Next j
'line filling
For i = 0 To k - 2 Step 2
Line (xi(i), y)-(xi(i + 1) + 1, y), c
Next i
Next y
End Sub
Code: Select all
' variables de uso general
Dim As String sa, sc
Dim As Integer a, b, c, d, e, f, g, h, n
Dim shared As Integer RESX,RESY,MICOLOR
RESX=1280
RESY=1000
#Include "fill.bas"
' WAY ID, NODO ID, numero de nodos leidos, num. de bordes leidos, num. de ways leidas, y su numero de nodos internos
Dim As ulong WID,NID
Dim As Integer NODES,BOUNDS,WAYS,WAYSN
Dim As ULong REF ' las asociaciones leidas dentro de los WAY
Dim As Double LAT,LON ' NODES
Dim As Double MINLAT,MAXLAT,MINLON,MAXLON ' BOUNDS
Dim As Integer MAXNODES=50000 ' por el momento, maximo en 50k, por que es el limite impuesto por OSM en los EXPORT!!
MINLAT=9999
MAXLAT=-9999
MINLON=9999
MAXLON=-9999
BOUNDS=0
Dim As Integer hayway=0 ' si hay WAY se activa para ir leyendo todos los nodos que lo componen
Dim shared As Double nodosc(MAXNODES,1) ' latitud y longitud de nodos leidos
Dim shared As ULong nodosi(MAXNODES) ' su indentificacion
Dim shared As uLong waysi(5000,1000) ' ways leidas y su asociaciones de nodos dentro del way, vamos, la polilinea
Dim As Integer x1,x2,y1,y2,xini,yini
Dim As Double factorx,factory ' no es real, falla en cuadratura, pero es suficiente para ver mapa
ScreenRes RESX,RESY,32
Line(0,0)-(RESX,RESY), RGB(255,255,255),bf ' fondo blanco , para fondo negro quitar
Dim Shared As long w(1000,1) ' guarda las coord. X e Y para la rutina de relleno FILL
sc=Command
If sc="" Then sc="Guggenheim_Bilbao.osm" ' para pruebas
Open sc For Input As 1
'Open "salida.txt" For Output As 2
While Not Eof(1)
Line Input #1, sa
If InStr(sa,"<node ") Then
a=InStr(sa,"visible=")
If Mid(sa,a+8,5)="false" Then end If
a=InStr(sa,"id=")
NID=Val(Mid(sa,a+4))
a=InStr(sa,"lat=")
LAT=Val(Mid(sa,a+5))
a=InStr(sa,"lon=")
LON=Val(Mid(sa,a+5))
'Print "NODO :";NODE,NID,LAT,LON
nodosc(NODES,0)=LON
nodosc(NODES,1)=LAT
nodosi(NODES)=NID
' si no se localiza BOUNDS, los calculo segun leo NODOS
If BOUNDS=0 Then
if LAT<MINLAT Then MINLAT=LAT
if LAT>MAXLAT Then MAXLAT=LAT
if LON<MINLON Then MINLON=LON
if LON>MAXLON Then MAXLON=LON
factorx=RESX/Abs(MAXLON-MINLON)
factory=RESY/Abs(MAXLAT-MINLAT)
End If
'Sleep
NODES+=1
If NODES>MAXNODES Then Print "Superados 50000 nodos!!!":Sleep:end
EndIf
If InStr(sa,"<bounds ") Then
a=InStr(sa,"minlat=")
MINLAT=Val(Mid(sa,a+8))
a=InStr(sa,"maxlat=")
MAXLAT=Val(Mid(sa,a+8))
a=InStr(sa,"minlon=")
MINLON=Val(Mid(sa,a+8))
a=InStr(sa,"maxlon=")
MAXLON=Val(Mid(sa,a+8))
Print "BOUND ENCONTRADO:";BOUNDS,MINLAT,MAXLAT,MINLON,MAXLON':sleep
factorx=RESX/Abs(MAXLON-MINLON)
factory=RESY/Abs(MAXLAT-MINLAT)
BOUNDS+=1
EndIf
' si tenemos WAY vamos leyendo sus asociaciones
If hayway=1 Then
If InStr(sa,"<nd ") Then
a=InStr(sa,"ref=")
REF=Val(Mid(sa,a+5))
waysi(WAYS-1,n)=REF
'Print WAYS,REF
n+=1
EndIf
EndIf
If InStr(sa,"<way ") Then
a=InStr(sa,"visible=")
If Mid(sa,a+8,5)="false" Then end If
a=InStr(sa,"id=")
WID=Val(Mid(sa,a+4)) ' no es necesario por ahora, pero lo guardo para un futuro
'Print "WAY :";WAYS,WID
'sleep
WAYS+=1
n=0
hayway=1
EndIf
If InStr(sa,"</way>") Then ' se acabo, salimos de buscar WAY
'For f=0 To a
' w(f,0)=0
' w(f,1)=0
'Next
a=0
'Print "BOUND:";BOUNDS,MINLAT,MAXLAT,MINLON,MAXLON
'ScreenLock
MICOLOR=RGB(Rnd(1)*255,Rnd(1)*255,Rnd(1)*255)
For f=0 To n-1
NID=waysi(WAYS-1,f)
For g=0 To NODES-1
If NID=nodosi(g) Then
LON=nodosc(g,0)
LAT=nodosc(g,1)
EndIf
Next
'Print NID,LON,LAT
If a Then
x2=((LON-MINLON)*factorx)'*1000
y2=((LAT-MINLAT)*factory)'*1000
'Print x1,y1,x2,y2
Line (x1,RESY-y1)-(x2,RESY-y2),MICOLOR
x1=x2
y1=y2
w(a,0)=x1
w(a,1)=RESY-y1
a+=1
EndIf
If a=0 Then
a=1
x1=((LON-MINLON)*factorx)'*1000
y1=((LAT-MINLAT)*factory)'*1000
xini=x1 ' las guardo para luego calcular poligono cerrado o no
yini=y1
w(a-1,0)=x1
w(a-1,1)=RESY-y1
EndIf
Next
'ScreenUnLock
' si coinciden punto de entrada y salida, es poligono cerrado, rellenamos
If xini=x1 And yini=y1 And a<1000 Then ' si el FILL tiene mas de 1000 elementos, no actua, porque da error
fill_polygon w(),a-1,MICOLOR
EndIf
If BOUNDS=0 Then
Exit while
EndIf
hayway=0
EndIf
Wend
' activar para ver los NODOS
'ScreenLock
' For g=0 To NODES-1
' NID=nodosi(g)
' LON=nodosc(g,0)
' LAT=nodosc(g,1)
' x2=((LON-MINLON)*factorx)'*1000
' y2=((LAT-MINLAT)*factory)'*1000
' Circle (x2,RESY-y2),2,NID
' Next
'ScreenUnLock
Print "WAY TOTAL :";WAYS
Print "NODE TOTAL :";NODES
Print "BOUND TOTAL :";BOUNDS
If BOUNDS=0 Then Print "BOUND CALCULADO:";MINLAT,MAXLAT,MINLON,MAXLON
Close 1, 2
Print "...FIN"
sleep
-is not perfect, not control about NODES number, and maybe can fail.
-colors is random, only for fun
It's good skeleton for a big maps project!!
edit: little bug with bound out