• Non sono ammesse registrazioni con indirizzi email temporanei usa e getta

Mappe GoogleEarth dei ripetitori TV

J

jumpjack

Digital-Forum Master
Registrato
3 Giugno 2004
Messaggi
870
Ho creato una piccola macro Excel per automatizzare la creazione di mappe dei ripetitori:
http://win98.altervista.org/mappe-dtt.html


screenshot1.JPG
 
Ultima modifica:
grazie.
Ho mandato il link anche ai gestori del sito otgtv, cosi' magari le implementano direttamente loro. ;-)
 
jumpjack ha scritto:
grazie.
Ho mandato il link anche ai gestori del sito otgtv, cosi' magari le implementano direttamente loro. ;-)
Clicca per espandere...
ti ho mandato una piccola correzione in un messaggio privato
 
Storm75 ha scritto:
Bellissimo e utilissimo servizio!!!!!!

Grazie;)

Ps. Peccato però che le coordinate non sono precisissime!:eusa_think:
Clicca per espandere...
ah, io non c'entro :eusa_whistle:, le scopiazzo soltanto! :D
 
jumpjack ha scritto:
Ho creato una piccola macro Excel per automatizzare la creazione di mappe dei ripetitori:
http://win98.altervista.org/mappe-dtt.html
Clicca per espandere...


Verifica il calcolo con longitudine inferiore a 10, esempio 908.
Io l'ho corretto così:

Sub CreaMappa()
Dim temp2 As Double
SEPAR = "."
intestazione = "<?xml version='1.0' encoding='UTF-8'?><kml xmlns='http://www.opengis.net/kml/2.2' xmlns:gx='http://www.google.com/kml/ext/2.2' xmlns:kml='http://www.opengis.net/kml/2.2' xmlns:atom='http://www.w3.org/2005/Atom'><Document><name>DTT.kml</name><Style id='sh_ylw-pushpin'><IconStyle><scale>1.3</scale><Icon><href>http://maps.google.com/mapfiles/kml/pushpin/ylw-pushpin.png</href></Icon><hotSpot x='20' y='2' xunits='pixels' yunits='pixels'/></IconStyle></Style><Style id='sn_ylw-pushpin'><IconStyle><scale>1.1</scale>"
intestazione = intestazione + "<Icon><href>http://maps.google.com/mapfiles/kml/pushpin/ylw-pushpin.png</href></Icon><hotSpot x='20' y='2' xunits='pixels' yunits='pixels'/></IconStyle></Style><Style id='sh_ylw-pushpin0'><IconStyle><scale>1.3</scale><Icon><href>http://maps.google.com/mapfiles/kml/pushpin/ylw-pushpin.png</href></Icon><hotSpot x='20' y='2' xunits='pixels' yunits='pixels'/></IconStyle></Style><StyleMap id='msn_ylw-pushpin'><Pair><key>normal</key><styleUrl>#sn_ylw-pushpin0</styleUrl></Pair><Pair><key>highlight</key><styleUrl"
intestazione = intestazione + ">#sh_ylw-pushpin0</styleUrl></Pair></StyleMap><Style id='sn_ylw-pushpin0'><IconStyle><scale>1.1</scale><Icon><href>http://maps.google.com/mapfiles/kml/pushpin/ylw-pushpin.png</href></Icon><hotSpot x='20' y='2' xunits='pixels' yunits='pixels'/></IconStyle></Style><StyleMap id='msn_ylw-pushpin0'><Pair><key>normal</key><styleUrl>#sn_ylw-pushpin</styleUrl></Pair><Pair><key>highlight</key><styleUrl>#sh_ylw-pushpin</styleUrl></Pair></StyleMap><Folder><name>DTT</name><open>1</open>"
Placemark = "<Placemark><name>#nome#</name><description>#descr#</description><LookAt><longitude>#lon#</longitude><latitude>#lat#</latitude><altitude>0</altitude><range>37377.4627302017</range><tilt>0</tilt><heading>-0.09207230591840906</heading><altitudeMode>relativeToGround</altitudeMode></LookAt><styleUrl>#msn_ylw-pushpin</styleUrl><Point><coordinates>#lon#,#lat#,0</coordinates></Point></Placemark>"
piede = "</Folder></Document></kml>"

Open "test.kml" For Output As #1
Print #1, intestazione

riga = 2
While Cells(riga, 1) <> ""
ParteIntera = Mid$(Cells(riga, 9), 1, 2)
ParteDecimale = Val(Mid$(Cells(riga, 9), 3, 2)) / 60
Totale = ParteIntera + ParteDecimale
TotaleStringa = Mid$(Str$(Totale), 1, 8)
LAT = TotaleStringa
ParteIntera = Mid$(Right$("0000" & Cells(riga, 8), 4), 1, 2)
ParteDecimale = Val(Mid$(Right$("0000" & Cells(riga, 8), 4), 3, 2)) / 60
ParteDecimale = Val(Mid$(Cells(riga, 8), 3, 2)) / 60
Totale = ParteIntera + ParteDecimale
TotaleStringa = Mid$(Str$(Totale), 1, 8)
LON = TotaleStringa
Nome = Cells(riga, 3) & " (" & Cells(riga, 6) & ", " & Cells(riga, 10) & "km.)"
Descrizione = "Canale: " & Cells(riga, 3) & vbCrLf & "Località trasmittente:" & Cells(riga, 5) & vbCrLf & "Comune trasmittente: " & Cells(riga, 6) & vbCrLf & "Bussola (azimuth): " & Cells(riga, 11) & vbCrLf & "Distanza trasmittente: " & Cells(riga, 10) & "km."
DaStampare = Replace(Placemark, "#nome#", Nome)
DaStampare = Replace(DaStampare, "#lat#", LAT)
DaStampare = Replace(DaStampare, "#lon#", LON)
DaStampare = Replace(DaStampare, "#descr#", Descrizione)
Print #1, DaStampare
riga = riga + 1
Wend

Print #1, piede
Close #1
End Sub
 
Ultima modifica:
Devi accedere o registrarti per poter rispondere.
Indietro
Alto Basso