NetCAD Projelerini Google Earth KML Formatına Dönüştürme Makrosu
Convert NetCAD Projects to Google Earth KML Format Macro 🚀
Bu makro, NetCAD yazılımında oluşturulan coğrafi bilgi sistemi (GIS) projelerini hızlı ve kolay bir şekilde Google Earth’te görüntülenebilen KML (Keyhole Markup Language) formatına dönüştürmek için tasarlanmıştır. 📍 Makro, poligonlar, çizgiler, noktalar ve metin objeleri gibi farklı veri türlerini destekler ve her bir objenin özelliklerini (örneğin, parsel numarası, tabaka, renk kodu, alan farkı) KML dosyasına ayrıntılı bir şekilde aktarır. Ayrıca, kullanıcı dostu bir arayüzle sesli bildirimler sunar ve projeksiyon ayarlarını otomatik olarak yapılandırır. Bu makro, harita mühendisleri, şehir plancıları ve GIS uzmanları için büyük bir kolaylık sağlar. 🗺️
This macro is designed to quickly and easily convert Geographic Information System (GIS) projects created in NetCAD into the KML (Keyhole Markup Language) format, viewable in Google Earth. 📍 It supports various data types such as polygons, lines, points, and text objects, transferring each object’s properties (e.g., parcel number, layer, color code, area difference) into the KML file in detail. Additionally, it provides user-friendly voice notifications and automatically configures projection settings. This macro offers significant convenience for surveyors, urban planners, and GIS specialists. 🗺️
Nasıl Çalışır (How Does It Work)
Makro, öncelikle NetCAD projesindeki objeleri (poligonlar, çizgiler, noktalar, metinler) tarar ve her bir objenin özelliklerini analiz eder. Ardından, bu objeleri KML formatına uygun bir yapıya dönüştürerek bir KML dosyası oluşturur. 🛠️ Kullanıcı, Google Earth’e aktarılacak objeleri seçer ve makro, bu objeleri projeksiyon ayarlarına (örneğin, UTM, ITRF, WGS84) göre koordine eder. Sesli uyarılar, işlem sürecini kullanıcıya bildirir. Makro, oluşturulan KML dosyasını otomatik olarak kaydeder ve Google Earth’te açılmak üzere hazır hale getirir. Ayrıca, projenin orijinal yapısını bozmadan geçici NCZ yedek dosyaları oluşturur ve işlem sonunda bu dosyaları siler. 🔄
The macro first scans the objects (polygons, lines, points, texts) in the NetCAD project and analyzes their properties. It then converts these objects into a KML-compatible structure, creating a KML file. 🛠️ The user selects the objects to be exported to Google Earth, and the macro coordinates them according to projection settings (e.g., UTM, ITRF, WGS84). Voice notifications inform the user about the process. The macro automatically saves the generated KML file and prepares it for opening in Google Earth. Additionally, it creates temporary NCZ backup files without altering the original project structure and deletes them upon completion. 🔄
Etiket ( Labels )
KML dönüştürme, NetCAD makro, Google Earth entegrasyonu, GIS makro, harita mühendisliği, coğrafi bilgi sistemi, KML dosyası oluşturma, NetCAD projesi, veri aktarımı, projeksiyon ayarları, poligon dönüştürme, çizgi dönüştürme, nokta dönüştürme, metin dönüştürme, kullanıcı dostu makro, sesli bildirim, otomatik KML oluşturma, GIS veri işleme, harita veri dönüşümü, NetCAD KML aktarımı
KML conversion, NetCAD macro, Google Earth integration, GIS macro, surveying, geographic information system, KML file creation, NetCAD project, data transfer, projection settings, polygon conversion, line conversion, point conversion, text conversion, user-friendly macro, voice notification, automatic KML generation, GIS data processing, map data conversion, NetCAD KML transfer
📝 Netcad NVB Code
'' www.sabangul.com.tr Web Sayfasından İndirilmiştir
' Şaban GÜL , Harita Mühendisi
' Her Türlü Hata, İstek ve Öneriler İçin
' sagulnet@gmail.com
' adresine durumu anlatan bir e-posta gönderiniz.
' DİKKAT'
'GIS BAĞLANTI ANAHTARI SİLİNİR YERİNE HESAP ALANI YAZILIR!!!
Sub Main
with Netcad
Dim kmladres
kmladres="C:\\SAGULCAD\\netcadkml\\sagul_kml_"& replace(replace(replace(now,":","_")," ","-"),".","_") &".kml"
dim voice
Set voice = CreateObject("SAPI.SpVoice")
.SetParam PNC_PLINENAME, 1
.SetParam PNC_PLINEHATCHS, 0
.SetParam PNC_PNTNAMES, 1
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim fso, objFolder,f
Set fso = CreateObject("Scripting.FileSystemObject")
Set objFolder = FSO.GetFolder("C:\\")
If Not FSO.FolderExists("C:\\SAGULCAD") Then
objFolder.SubFolders.Add "SAGULCAD"
End If
Set fso = CreateObject("Scripting.FileSystemObject")
Set objFolder = FSO.GetFolder("C:\\SAGULCAD")
If Not FSO.FolderExists("C:\\SAGULCAD\\netcad_modul") Then
objFolder.SubFolders.Add "netcad_modul"
End If
Set fso = CreateObject("Scripting.FileSystemObject")
Set objFolder = FSO.GetFolder("C:\\SAGULCAD")
If Not FSO.FolderExists("C:\\SAGULCAD\\netcadkml") Then
objFolder.SubFolders.Add "netcadkml"
End If
Set fso = CreateObject("Scripting.FileSystemObject")
Set objFolder = FSO.GetFolder("C:\\SAGULCAD\\netcad_modul")
If Not FSO.FolderExists("C:\\SAGULCAD\\netcad_modul\\Makro") Then
objFolder.SubFolders.Add "Makro"
End If
Set fso = CreateObject("Scripting.FileSystemObject")
Set objFolder = FSO.GetFolder("C:\\SAGULCAD\\netcad_modul")
If Not FSO.FolderExists("C:\\SAGULCAD\\netcad_modul\\NCZYEDEK") Then
objFolder.SubFolders.Add "NCZYEDEK"
End If
Set fso = CreateObject("Scripting.FileSystemObject")
Set objFolder = FSO.GetFolder("C:\\SAGULCAD\\netcad_modul\\Makro")
If Not FSO.FolderExists("C:\\SAGULCAD\\netcad_modul\\Makro\\Tanimlar") Then
objFolder.SubFolders.Add "Tanimlar"
End If
dim dosyaoku,frs ,eyups
Set fso = CreateObject("Scripting.FileSystemObject")
Set frs = fso.OpenTextFile("C:\\SAGULCAD\\netcad_modul\\Makro\\Tanimlar\\kmloku.sagul", ForReading, True)
Do While Not frs.AtEndOfStream
dosyaoku= Split(frs.ReadLine,",")
Loop
on error resume next
dim xfsot,xft
if InStr(dosyaoku(0), ",") <> 0 then
MsgBox "İlk Kurulum Hatası Oluştu. Sizin İçin Otomatik Düzelteceğiz",64,"Dikkat"
MsgBox "Düzeltme İşlemi Tamam. Lütfen Makroyu yeniden başlatınız",64,"Dikkat"
Set xfsot = CreateObject("Scripting.FileSystemObject")
Set xft = xfsot.OpenTextFile("C:\\SAGULCAD\\netcad_modul\\Makro\\Tanimlar\\kmloku.sagul", ForWriting, True)
xft.WriteLine ( 2 & "," & 2 & "," & 1 & "," & 1 & "," & "C:\\" )
xft.close
exit sub
end if
frs.Close
dim oto
oto= "C:\\SAGULCAD\\netcad_modul\\NCZYEDEK\\COGRAFI_sagul_"& replace(replace(replace(now,":","_")," ","-"),".","_") & ".ncz"
.SaveToFile oto
.LoadFile oto , fs_bnetcad
With Netcad
dim iiii,coklu1ii
For iiii = 0 to .numobject - 1
Set coklu1ii = .getobject(iiii)
if coklu1ii.tag = opline then
coklu1ii.objname = coklu1ii.area
.putobject iiii, coklu1ii
end if
Next
End With
voice.Rate = 2
voice.Volume = 100
voice.speed=0.5
Say = "lutfen Back-lee-in"
If (Len(Say) > 0) Then
voice.Speak Say
End If
with netcad
'' www.sabangul.com.tr Web Sayfasından İndirilmiştir
' Şaban GÜL , Harita Mühendisi
' Her Türlü Hata, İstek ve Öneriler İçin
' haritaakademi@gmail.com veya sagulnet@gmail.com
' adresine durumu anlatan bir e-posta gönderiniz.
dim pc
set pc = Netcad.NewProjection
''Dikkat : Datum listesine aşağıdaki adresten ulaşabilirsiniz.
' http://sabangul.com.tr/nc-pro-datum
'' Projeksiyon Ayarı
'' Burada projeksiyon için bir kod giriniz
'' Örnek: UTM 3 için 3 giriniz. UTM 6 için 2 giriniz. Coğrafi için 1 giriniz.
pc.ProjectionType =1
'' Datum Ayarı
'' Burada datum için bir kod giriniz
'' Örnek: ITRF için 1, ED50 için 4 , WGS için 0 giriniz.
pc.Datum = 0
'' Dilim Ayarı
'' Burada dilim için bir kod giriniz
'' Örnek: Ankara için 33 girin, Siirt için 42 girin.
pc.SetToCurrentProject true ' projenin dönüşmesini engellemek için konuldu
end with
'.SetToCurrentProject(ConvertObjects)
voice.Speak Say
.NetcadCommand "PROJECT CLEAN 1,1,1,1,1,1"
voice.Speak Say
Dim secimkumesi,obje,i,z,dic
set secimkumesi = .newselectionset
set obje=.newobject
dim tabsay
dim k
tabsay=NCLayerManager.NumLayer
netcad.netcadcommand "REGEN"
Say = "Google Earth a aktarilacak obje sechen"
voice.Speak Say
if secimkumesi.select("Google Earth'e Aktarılacak Dosya Seçiniz ( Şaban GÜL , www.sagul.net )",array(opline,oline,otext,opoint)) then
dim list
Set list = CreateObject("System.Collections.ArrayList")
list.Add "<kml xmlns=" & """" & "http://earth.google.com/kml/2.0" & """" & ">"
list.Add "<Document>"
dim ks
dim tabrenk
Dim rengi
list.Add "- <Style id=½default5½>"
list.Add "- <IconStyle>"
list.Add " <color>00999999</color>"
list.Add " </IconStyle>"
list.Add "- <LabelStyle>"
list.Add " <color>00999999</color>"
list.Add " </LabelStyle>"
list.Add "- <LineStyle>"
list.Add " <color>ff000000</color>"
list.Add " </LineStyle>"
list.Add "- <PolyStyle>"
list.Add " <color>ab0055ff</color>"
list.Add " </PolyStyle>"
list.Add "- <Pair>"
list.Add " <key>normal</key>"
list.Add " <styleUrl>#style0</styleUrl>"
list.Add " </Pair>"
list.Add "- <Pair>"
list.Add " <key>highlight</key>"
list.Add " <styleUrl>#style</styleUrl>"
list.Add " </Pair>"
list.Add " </Style>"
list.Add "- <StyleMap id=½default50½>"
list.Add "- <Pair>"
list.Add " <key>normal</key>"
list.Add " <styleUrl>#default51</styleUrl>"
list.Add " </Pair>"
list.Add "- <Pair>"
list.Add " <key>highlight</key>"
list.Add " <styleUrl>#default5</styleUrl>"
list.Add " </Pair>"
list.Add " </StyleMap>"
list.Add "- <Style id=½default51½>"
list.Add "- <IconStyle>"
list.Add " <color>00999999</color>"
list.Add " </IconStyle>"
list.Add "- <LabelStyle>"
list.Add " <color>00999999</color>"
list.Add " </LabelStyle>"
list.Add "- <LineStyle>"
list.Add " <color>ff000000</color>"
list.Add " </LineStyle>"
list.Add "- <PolyStyle>"
list.Add " <color>ab0055ff</color>"
list.Add " </PolyStyle>"
list.Add "- <Pair>"
list.Add " <key>normal</key>"
list.Add " <styleUrl>#style0</styleUrl>"
list.Add " </Pair>"
list.Add "- <Pair>"
list.Add " <key>highlight</key>"
list.Add " <styleUrl>#style</styleUrl>"
list.Add " </Pair>"
list.Add " </Style>"
list.Add "<Folder>"
list.Add "<name>Sagulnet GE</name>"
list.Add "<ScreenOverlay>"
list.Add "<name>www.sagul.net</name>"
list.Add "<visibility>1</visibility>"
list.Add "<Icon>"
list.Add "<href>https://sagul.net/wp-content/uploads/2019/01/sagulnet.png</href>"
list.Add "</Icon>"
list.Add "<overlayXY x=½0½ y=½1½ xunits=½fraction½ yunits=½fraction½/>"
list.Add "<screenXY x=½0½ y=½1½ xunits=½fraction½ yunits=½fraction½/>"
list.Add "<size x=½0½ y=½0½ xunits=½pixels½ yunits=½pixels½/>"
list.Add "</ScreenOverlay>"
for k=0 to tabsay-1
tabrenk= NCLayerManager.layer(k).colorBGR
rengi = Hex(tabrenk)
list.add "<Folder><name>" & NCLayerManager.Layer(k).name & "</name>"
dim kk
kk=0
for i=0 to secimkumesi.NE-1
z=secimkumesi.getselectedobject(i,obje)
if obje.tabaka=k then
if obje.tag=opline then
kk=kk+1
list.add "<Placemark>"
list.add "<name>"& obje.pname & "</name>"
list.add "<description>"
dim tbksi
with ncLayermanager
tbksi=NCLayerManager.layer(obje.tabaka).name
end with
list.Add "<![CDATA[ "
list.Add "<table style=½height: 26px; width: 267px; border-color: #C0C0C0;½ border=½1½ cellspacing=½0½ cellpadding=½0½>"
list.Add "<tbody>"
list.Add "<tr style=½height: 23px;½>"
list.Add "<td style=½width: 95px; height: 23px;½> Parsel No</td>"
list.Add "<td style=½width: 158px; height: 23px;½> "&obje.pname&"</td>"
list.Add "</tr>"
list.Add "<tr style=½height: 23px;½>"
list.Add "<td style=½width: 95px; height: 23px;½> Tabaka</td>"
list.Add "<td style=½width: 158px; height: 23px;½> "&tbksi&"</td>"
list.Add "</tr>"
list.Add "<tr style=½height: 23px;½>"
list.Add "<td style=½width: 95px; height: 23px;½> Renk Kodu</td>"
list.Add "<td style=½width: 158px; height: 23px;½> "&obje.renk&"</td>"
list.Add "</tr>"
list.Add "<tr style=½height: 23px;½>"
list.Add "<td style=½width: 95px; height: 23px;½> Gis Sinifi</td>"
list.Add "<td style=½width: 158px; height: 23px;½> "&obje.cls&"</td>"
list.Add "</tr>"
list.Add "<tr style=½height: 23px;½>"
list.Add "<td style=½width: 95px; height: 23px;½> Tapu Alani</td>"
list.Add "<td style=½width: 158px; height: 23px;½> "&round(obje.tarea,2)&"</td>"
list.Add "</tr>"
list.Add "<tr style=½height: 23px;½>"
list.Add "<td style=½width: 95px; height: 23px;½> Hesap Alani</td>"
list.Add "<td style=½width: 158px; height: 23px;½> "&round(obje.objname,2)&"</td>"
list.Add "</tr>"
list.Add "<tr style=½height: 23px;½>"
list.Add "<td style=½width: 95px; height: 23px;½> Alan Farki</td>"
list.Add "<td style=½width: 158px; height: 23px;½> "&round(obje.tarea-obje.objname,2)&"</td>"
list.Add "</tr>"
list.Add "</tbody>"
list.Add "</table>"
list.Add ""
list.Add "<img src=½https://sagul.net/wp-content/uploads/2019/01/sagulnet.png½>"
list.Add " ]]>"
list.add "</description>"
list.add "<styleUrl>#default50</styleUrl>"
list.add "<visibility>1</visibility>"
'list.add "<Style><LineStyle><color>" & rengi & "</color></LineStyle><PolyStyle><color>"& rengi & "</color></PolyStyle></Style>"
list.add "<Polygon>"
list.add "<tessellate>1</tessellate>"
list.add "<extrude>1</extrude>"
list.add "<outerBoundaryIs>"
list.add "<LinearRing>"
list.add "<coordinates>"
dim saban,say,pline
say=""
set pline=obje.getObjectAsPline()
for saban=0 to pline.Num-1
say= say & pline.Cor(saban).y & "," & pline.Cor(saban).x & ",0 "
next
say=mid(say,1,len(say)-1)
list.add say
list.add "</coordinates>"
list.add "</LinearRing>"
list.add "</outerBoundaryIs>"
list.add "</Polygon>"
list.add "</Placemark>"
end if
if obje.tag=oline then
kk=kk+1
list.add "<Placemark>"
list.add "<name>sagul_cizgi</name>"
list.add "<description>"&" Çizgi Uzunluğu Hesabı Bu Sürümde Yoktur. Güncellemelerde Gelecektir." &"</description>"
list.add "<styleUrl>#inline</styleUrl>"
list.add "<LineString>"
list.add "<tessellate>1</tessellate>"
list.add "<coordinates>" & obje.p1.y & "," & obje.p1.x & ",0 " &obje.p2.y & "," & obje.p2.x & ",0" & "</coordinates>"
list.add "</LineString>"
list.add "</Placemark>"
end if
if obje.tag=otext then
list.add "<Placemark>"
list.add "<name>"& obje.s &
"</name>"
list.add "<description>" & obje.s & "</description>"
list.add "<styleUrl></styleUrl>"
list.add "<Point>"
list.add "<gx:drawOrder>1</gx:drawOrder>"
list.add "<coordinates>"&obje.p1.y & "," & obje.p1.x & ",0</coordinates>"
list.add "</Point>"
list.add "</Placemark>"
kk=kk+1
end if
if obje.tag=opoint then
list.add "<Placemark>"
list.add "<name>"& obje.pname &"</name>"
list.add "<description>" & obje.pname & "</description>"
list.add "<styleUrl>#msn_open-diamond</styleUrl>"
list.add "<Point>"
list.add "<gx:drawOrder>1</gx:drawOrder>"
list.add "<coordinates>"&obje.p1.y & "," & obje.p1.x & ",0</coordinates>"
list.add "</Point>"
list.add "</Placemark>"
kk=kk+1
end if
end if
next
if kk=0 then list(list.count-1)=""
if kk>0 then list.add "</Folder>"
' .putobject z,obje
Next
list.Add "</Folder>"
list.Add "</Document>"
list.Add "</kml>"
End if
Dim fsot, ft
Set fsot = CreateObject("ADODB.Stream")
fsot.CharSet = "utf-8"
fsot.Type = 2
'Set fsot = CreateObject("Scripting.FileSystemObject") 'sistem objesi oluştur
'Set fsot = CreateObject("VBScript.Regexp")
'fsot.Pattern = "[^a-z0-9\\ç\\ğ\\i\\ı\\ö\\ş\\ü\\Ğ\\Ü\\İ\\Ş\\Ç\\Ö\\ ]"
'fsot.Charset = "ISO-8859-1"
'fsot.Charset = "utf-8"
'fsot.Global = True
'Set ft = fsot.OpenTextFile(kmladres, ForWriting, True) ' dosya kaydetme işlemi
'ft.Charset = "utf-8"
'ft.Pattern = "[^a-z0-9\\ç\\ğ\\i\\ı\\ö\\ş\\ü\\Ğ\\Ü\\İ\\Ş\\Ç\\Ö\\ ]"
Set fsot = CreateObject("ADODB.Stream")
fsot.Open
fsot.Type = 2 'text
fsot.Position = 0
fsot.Charset = "utf-8"
dim sagul,yazdirsgl
for sagul=0 to list.count-1
yazdirsgl=replace(list(sagul),"½","""")
fsot.WriteText yazdirsgl
'ft.WriteLine yazdirsgl
next
list.clear
fsot.SaveToFile kmladres, 2
fsot.close
end with
with Netcad
.NetcadCommand "CLOSE ACTIVEPROJECT"
end with
Say = "tamam"
voice.Speak Say
dim strProgramPath,objShell
'msgbox "İşlem Başarıyla Tamamlandı"
dim objxx
Set objxx = CreateObject("Scripting.FileSystemObject") 'Calls the File System Object
objxx.DeleteFile(oto) 'Deletes the file throught the DeleteFile function
voice.Rate = 0.5
voice.Volume = 100
voice.speed=0.5
Say = "sagul nokta nettt"
If (Len(Say) > 0) Then
voice.Speak Say
End If
if secimkumesi.NE=0 then
exit sub
end if
strProgramPath = kmladres
set objShell = createobject("Wscript.Shell")
objShell.Run strProgramPath
End Subnetcad-projeyi-kml-kaydet
