TKGM Parsel Sorgu KML Dosyalarını Netcad ile Dönüştürme Makrosu: Harita Mühendisleri için Hızlı Çözüm 🚀
TKGM Parcel Query KML File Conversion Macro for Netcad: Fast Solution for Surveying Engineers 🚀
Bu makro, Netcad yazılımında TKGM (Tapu ve Kadastro Genel Müdürlüğü) tarafından sağlanan KML formatındaki parsel sorgu dosyalarını Netcad projelerine dönüştürmek için geliştirilmiştir. Harita mühendisleri ve teknik kullanıcılar için tasarlanan bu araç, parsel bilgilerini (il, ilçe, mahalle, ada, parsel numarası, alan, pafta, nitelik, mevkii vb.) okuyarak Netcad ortamında görselleştirir ve koordinat dönüşümünü gerçekleştirir. Kullanıcı dostu arayüzü, tek bir KML dosyasını veya bir klasördeki tüm KML dosyalarını toplu olarak işleme imkanı sunar. WGS84, ED50 veya ITRF koordinat sistemleri arasında dönüşüm yapabilir ve 27, 30, 33, 36, 39, 42, 45 gibi dilim numaralarını destekler. Makro, veri tabakalarını otomatik olarak oluşturur, projeye entegre eder ve manuel işlemleri en aza indirir, böylece harita mühendislerinin iş akışını hızlandırır.
This macro is developed to convert KML format parcel query files provided by TKGM (General Directorate of Land Registry and Cadastre) into Netcad projects. Designed for surveying engineers and technical users, it reads parcel details (city, district, neighborhood, plot, parcel number, area, sheet, quality, location, etc.), visualizes them in the Netcad environment, and performs coordinate transformations. Its user-friendly interface allows processing of a single KML file or all KML files in a folder in bulk. It supports coordinate system transformations between WGS84, ED50, or ITRF and zone numbers like 27, 30, 33, 36, 39, 42, and 45. The macro automatically creates data layers, integrates them into the project, and minimizes manual tasks, streamlining the workflow for surveying engineers.
Nasıl Çalışır (How Does It Work)
Makro, Netcad yazılımında çalışmak üzere VBScript ile yazılmıştır ve aşağıdaki adımları izler:
Toplu İşleme: Bir klasördeki tüm KML dosyalarını otomatik olarak işler ve her biri için ayrı Netcad projeleri oluşturabilir.
Makro, hata kontrolü içerir ve ilk çalıştırmada yapılandırma dosyasını otomatik olarak düzeltir. Esnek ve kullanıcı dostu yapısı, TKGM KML dosyalarını hızlıca işlemek isteyen harita mühendisleri için idealdir.
Klasör ve Dosya Yapısı Oluşturma: “C:\SABANGUL\Netcad\Makro\Tanimlar” yolunda gerekli klasörleri oluşturur ve yapılandırma dosyalarını kaydeder.
Tabaka Yönetimi: “SAGUL”, “SAGUL_NOKTA”, “SAGUL_ALAN” ve “SAGUL_TABLO” adında tabakalar oluşturur ve Netcad parametrelerini (çizgi isimleri, nokta isimleri vb.) ayarlar.
Kullanıcı Arayüzü: Bir diyalog penceresi üzerinden kullanıcıya KML dosya seçimi, koordinat sistemi (WGS84, ED50, ITRF), dilim numarası ve projede dönüşüm yapılıp yapılmayacağı seçeneklerini sunar.
KML Dosya İşleme: TKGM KML dosyasındaki parsel bilgileri okunur, Türkçe karakter sorunları (ör. “Ão” yerine “Ü”) düzeltilir ve veriler (il, ilçe, mahalle, ada, parsel, alan vb.) ayrıştırılır.
Koordinat Dönüşümü: Seçilen koordinat sistemi ve dilim numarasına göre dönüşüm yapılır. Dönüşüm, projeye entegre edilebilir veya bağımsız olarak gerçekleştirilebilir.
Veri Görselleştirme: Parsel sınırları poligon olarak, noktalar ise etiketli olarak Netcad projesine eklenir. Her mahalle için ayrı tabakalar oluşturulur ve rastgele renklerle görselleştirilir.
The macro is written in VBScript for Netcad software and follows these steps:
Folder and File Structure Creation: Creates necessary folders at “C:\SABANGUL\Netcad\Makro\Tanimlar” and stores configuration files.
Layer Management: Creates layers named “SAGUL”, “SAGUL_NOKTA”, “SAGUL_ALAN”, and “SAGUL_TABLO” and configures Netcad parameters (line names, point names, etc.).
User Interface: Offers a dialog window for selecting KML files, coordinate systems (WGS84, ED50, ITRF), zone numbers, and whether to apply transformations to the project.
KML File Processing: Reads parcel data from TKGM KML files, corrects Turkish character issues (e.g., “Ão” to “Ü”), and parses details (city, district, neighborhood, plot, parcel, area, etc.).
Coordinate Transformation: Performs transformations based on the selected coordinate system and zone number, with options to integrate into the project or process independently.
Data Visualization: Adds parcel boundaries as polygons and points as labeled objects to the Netcad project. Separate layers are created for each neighborhood with random colors.
Batch Processing: Automatically processes all KML files in a folder, creating separate Netcad projects for each.
The macro includes error handling and auto-corrects the configuration file on first run. Its flexible and user-friendly design is ideal for surveying engineers processing TKGM KML files quickly.
Etiket ( Labels )
TKGM parsel sorgu, KML dosya dönüşüm, Netcad makro, harita mühendisliği, parsel dönüşüm, koordinat dönüşümü, WGS84, ED50, ITRF, toplu dosya işleme, veri görselleştirme, harita akademi, Şaban GÜL, parsel bilgileri, KML işleme
TKGM parcel query, KML file conversion, Netcad macro, surveying engineering, parcel conversion, coordinate transformation, WGS84, ED50, ITRF, batch file processing, data visualization, mapping academy, Şaban GÜL, parcel details, KML processing
📝 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
' haritaakademi@gmail.com veya sagulnet@gmail.com
' adresine durumu anlatan bir e-posta gönderiniz.
Sub Main
Dim sagultabaka, fk
With NCLayerManager
.Add "@SAGUL",6
.Add "SAGUL_NOKTA", 32
.Add "SAGUL_ALAN", 48
.Add "SAGUL_TABLO", 24
End With
With netcad
.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:\SABANGUL") Then
objFolder.SubFolders.Add "SABANGUL"
End If
Set fso = CreateObject("Scripting.FileSystemObject")
Set objFolder = FSO.GetFolder("C:\SABANGUL")
If Not FSO.FolderExists("C:\SABANGUL\Netcad") Then
objFolder.SubFolders.Add "Netcad"
End If
Set fso = CreateObject("Scripting.FileSystemObject")
Set objFolder = FSO.GetFolder("C:\SABANGUL\Netcad")
If Not FSO.FolderExists("C:\SABANGUL\Netcad\Makro") Then
objFolder.SubFolders.Add "Makro"
End If
Set fso = CreateObject("Scripting.FileSystemObject")
Set objFolder = FSO.GetFolder("C:\SABANGUL\Netcad\Makro")
If Not FSO.FolderExists("C:\SABANGUL\Netcad\Makro\Tanimlar") Then
objFolder.SubFolders.Add "Tanimlar"
End If
Dim dosyaoku, frs, eyups
Set fso = CreateObject("Scripting.FileSystemObject")
Set frs = fso.OpenTextFile("C:\SABANGUL\Netcad\Makro\Tanimlar\jsonoku.sagul", ForReading, True)
On Error Resume Next
Do While Not frs.AtEndOfStream
dosyaoku = Split(frs.ReadLine,",")
Loop
Dim xfsot, xft
If InStr(dosyaoku(0), ",") <> 0 Then
MsgBox "Bu makro aygıtınızda ilk defa çalıştırıldığından dolayı işlem gerçekleştirilemedi. Sizin İçin Otomatik Düzelteceğiz. ",0,"Dikkat"
Set xfsot = CreateObject("Scripting.FileSystemObject")
Set xft = xfsot.OpenTextFile("C:\SABANGUL\Netcad\Makro\Tanimlar\jsonoku.sagul", ForWriting, True)
xft.WriteLine ( 2 & "," & 2 & "," & 1 )
xft.Close
Refresh
End If
frs.Close
Dim sgul1, sgul2, sgul3, sgul4, sgul5
sgul1 = dosyaoku(0)
sgul2 = dosyaoku(1)
sgul3 = dosyaoku(2)
Dim BD, XLSpath, BD_SAGUL, tabaka, hakademi1, hakademi2, hakademi3, hakademi4, ha1, ha2, ha3, ha4
hakademi1 = "SAGUL_NOKTA"
hakademi2 = "SAGUL_ALAN"
hakademi3 = "SAGUL_TABLO"
hakademi4 = ""
For tabaka = 0 To .numlayers - 1
If .LayerNameOf(tabaka) = hakademi1 Then ha1 = tabaka
Next
For tabaka = 0 To .numlayers - 1
If .LayerNameOf(tabaka) = hakademi2 Then ha2 = tabaka
Next
For tabaka = 0 To .numlayers - 1
If .LayerNameOf(tabaka) = hakademi3 Then ha3 = tabaka
Next
For tabaka = 0 To .numlayers - 1
If .LayerNameOf(tabaka) = hakademi4 Then ha4 = tabaka
Next
Set BD = Netcad.NewBDialog("PARSEL SORGU DOSYASI AKTARMA www.sabangul.com.tr")
'Set BD_SAGUL = Netcad.NewBDialog("PARSEL SORGU DOSYASI AKTARMA , [Harita Akademi, Şaban GÜL]")
'BD.PutPrompt "DİKKAT:Lütfen www.sabangul.com.tr adresinden uyarıları okuyunuz"
'BD.PutPrompt " "
'BD.GetFileName "sabangul","TKGM Parsel Sorgu Json Dosyasını Seçiniz...","","Json Dosyası|*.json|Tum Dosyalar|*.*","xls"
'BD.GetRAdio "item0","Dosya Yükleme Yöntemi","Tek Dosya Yükle ve Dönüştür|Klasördeki Tüm Dosyalar" ,sgul0
BD.GetRAdio "item3","Koordinat Dönüşümünde Projede Dönüşsün mü ? ","Hayır|Evet" ,sgul3
BD.GetRAdio "item1","Dönüştürülecek Koordinat Sistemi (UTM3)","WGS84|ED50|ITRF" ,sgul1
BD.GetRAdio "item2","Dönüştürülecek Dilim Numarası","27|30|33|36|39|42|45" ,sgul2
If BD.showmodal Then
xlspath = BD.ValueByName("sabangul")
Dim fsot, ft
Set fsot = CreateObject("Scripting.FileSystemObject")
Set ft = fsot.OpenTextFile("C:\SABANGUL\Netcad\Makro\Tanimlar\jsonoku.sagul", ForWriting, True)
Dim gul1, gul2, gul3, gul4, gul0
gul0 = BD.ValueByName("item0")
gul1 = BD.ValueByName("item1")
gul2 = BD.ValueByName("item2")
gul3 = BD.ValueByName("item3")
ft.WriteLine ( gul1 & "," & gul2 & "," & gul3 )
ft.Close
Dim ahmet, furkan, uncu
ahmet = 0
furkan = 33
uncu = 0
If BD.ValueByName("item1") = 0 Then ahmet = 0
If BD.ValueByName("item1") = 1 Then ahmet = 4
If BD.ValueByName("item1") = 2 Then ahmet = 1
If BD.ValueByName("item2") = 0 Then furkan = 27
If BD.ValueByName("item2") = 1 Then furkan = 30
If BD.ValueByName("item2") = 2 Then furkan = 33
If BD.ValueByName("item2") = 3 Then furkan = 36
If BD.ValueByName("item2") = 4 Then furkan = 39
If BD.ValueByName("item2") = 5 Then furkan = 42
If BD.ValueByName("item2") = 6 Then furkan = 45
If BD.ValueByName("item3") = 1 Then uncu = 1
Else
Exit Sub
End If
.NetcadCommand "PROJECT NEW "& "PARSEL SORGU KML DOSYASI DÖNÜŞTÜRÜLMÜŞ DOSYA-sabangul.com.tr"
If gul0 = 1 Then
Set yol = CreateObject("Shell.Application").BrowseForFolder(0,"Taranacak klasörü seçin", 0,"C:\Users\Admin\sss")
If yol Is Nothing Then Exit Sub
Set zx = CreateObject("Scripting.Dictionary")
Set fsox = CreateObject("Scripting.FileSystemObject")
Set dosyax = fsox.getfolder(yol.items.Item.Path).files
y = yol.items.Item.Path
ReDim d(dosyax.count)
For Each j In dosyax
i = i + 1
d(i) = j.name
Dim dosyaad, kisaad, dilimno, dosyatur
dosyaad = d(i)
kisaad = Replace(dosyaad,".kml","")
dosyatur = Replace(dosyaad,kisaad,"")
Dim tirnak
tirnak = """"
If dosyatur = ".kml" Then
Dim SAGULx
Dim fx
Dim fsox
Dim listxx
SAGULx = y & "\" & dosyaad
Set fsox = CreateObject("Scripting.FileSystemObject")
Set fx = fsox.OpenTextFile(SAGULx, ForReading, True)
Set listxx = CreateObject("System.Collections.ArrayList")
Do While Not fx.AtEndOfStream
Linex = fx.readline
listxx.add Linex
Loop
fx.Close
Dim daven
Dim arr, x, arr2
Set listy1 = CreateObject("System.Collections.ArrayList")
Set listy2 = CreateObject("System.Collections.ArrayList")
Set listy3 = CreateObject("System.Collections.ArrayList")
Set p = Nothing
Set p = .NewPoly
Dim il, ilce, mahalle, ada, parsel, alan, pafta, nitelik, mevkii, alan2
Dim ayaz, eliff, ruhan1, ruhan2
For daven = 0 To listxx.count-2
listxx(daven) = Replace(listxx(daven),"Ão","Ü")
listxx(daven) = Replace(listxx(daven),"Å","Ş")
listxx(daven) = Replace(listxx(daven),"Ä","ğ")
listxx(daven) = Replace(listxx(daven),"Ã?","Ç")
listxx(daven) = Replace(listxx(daven),"Ä°","İ")
listxx(daven) = Replace(listxx(daven),"Ã-","Ö")
listxx(daven) = Replace(listxx(daven),"ü","ü")
listxx(daven) = Replace(listxx(daven),"ÅY","ş")
listxx(daven) = Replace(listxx(daven),"ÄY","ğ")
listxx(daven) = Replace(listxx(daven),"ç","ç")
listxx(daven) = Replace(listxx(daven),"ı","ı")
listxx(daven) = Replace(listxx(daven),"ö","ö")
listxx(daven) = Replace(listxx(daven),"Y","")
listxx(daven) = Replace(listxx(daven),"б","ı")
listxx(daven) = Replace(listxx(daven),"Ğ°","İ")
listxx(daven) = Replace(listxx(daven),"ğ±","ı")
listxx(daven) = Replace(listxx(daven),"ğ°","İ")
Next
Dim a1, a2
a1 = 0
a2 = 0
For daven = 1 To listxx.count-2
ayaz = listxx(daven)
If listxx(daven) = " <LinearRing>" And listxx(daven-1) = " <outerBoundaryIs>" Then a1 = daven+1
If listxx(daven) = " </LinearRing>" And listxx(daven+1) = " </outerBoundaryIs>" Then a2 = daven
eliff = listxx(daven+1)
eliff = Replace(eliff," <value>","")
eliff = Replace(eliff,"</value>","")
If InStr(ayaz,"<Data name=" & tirnak &"İl" & tirnak & ">") > 0 Then il = eliff
If InStr(ayaz,"<Data name=" & tirnak &"İlçe" & tirnak & ">") > 0 Then ilce = eliff
If InStr(ayaz,"<Data name=" & tirnak &"Mahalle" & tirnak & ">") > 0 Then mahalle = eliff
If InStr(ayaz,"<Data name=" & tirnak &"Ada" & tirnak & ">") > 0 Then ada = eliff
If InStr(ayaz,"<Data name=" & tirnak &"ParselNo" & tirnak & ">") > 0 Then parsel = eliff
If InStr(ayaz,"<Data name=" & tirnak &"Alan" & tirnak & ">") > 0 Then alan = eliff
If InStr(ayaz,"<Data name=" & tirnak &"Pafta" & tirnak & ">") > 0 Then pafta = eliff
If InStr(ayaz,"<Data name=" & tirnak &"Nitelik" & tirnak & ">") > 0 Then nitelik = eliff
If InStr(ayaz,"<Data name=" & tirnak &"Mevkii" & tirnak & ">") > 0 Then mevkii = eliff
Next
alan2 = Replace(alan,".","")
listy1.clear
Dim ruhan
Dim soner
For ruhan = a1 To a2
soner = listxx(ruhan)
soner = Replace(soner,"<coordinates>","")
soner = Replace(soner,"</coordinates>","")
soner = Replace(soner," ","")
soner = Replace(soner," ","")
soner = Replace(soner," ","")
soner = Replace(soner," ","")
soner = Replace(soner," ","")
soner = Replace(soner," ","")
soner = Replace(soner," ","")
soner = Replace(soner," ","")
listy1.add soner
Next
Set liste1 = CreateObject("System.Collections.ArrayList")
Dim xxs
For daven = 0 To listy1.count-1
liste1.clear
Dim ppp
arr = Split(listy1(daven),",")
For Each xxs In arr
liste1.add (xxs)
Next
Dim max, min, rand, max2, min2, rand2
max = 1
min = 254
Randomize
rand = Int((max-min+1)*Rnd+min)
max2 = 1
min2 = 254
Randomize
rand2 = Int((max2-min2+1)*Rnd+min)
p.AddCoor(.NewC(liste1(0),liste1(1),0))
Set noktaa = .MakePoint(.newc(liste1(0),liste1(1),0), ada & "_" & parsel & "/" & daven+1,"SAGULNET" ,.CreateLayer("N"&"_" & mahalle,rand))
.AddObject noktaa
Next
Set alann = .MakePline(ada & "_" & parsel ,POLYCLOSED+POLYFILLED,6767✅ Makroyu kullanmadan önce lütfen aşağıdaki uyarıları dikkatlice okuyunuz:
• Obje sayısı yüksekse işlem uzun sürebilir ve Netcad yazılımı yanıt veremez hale gelebilir.
• Bu nedenle tüm projelerinizi önceden yedeklemeniz önemle tavsiye edilir.
• Makro çalıştıktan sonra işlemi geri almak mümkün olmayabilir.
• Makrolar periyodik olarak güncellenmektedir; sayfamızı takip ederek güncel sürümleri kullanmaya özen gösteriniz.
💾 Makrolar yalnızca Netcad yazılımında çalışır ve .nps formatında sunulur. Bu format düzenlenemez; özelleştirme talepleriniz için bizimle iletişime geçebilirsiniz.
✉️ Görüş, öneri ve hata bildirimleri için: sabangul67@gmail.com
⚙️ Bu makrolar Kadastro, 2B, Orman, Kamulaştırma, Değerleme, CBS, Halihazır Harita, İmar Planı, Etüt-Proje gibi birçok alanda kullanılabilir.
🔐 Makrolar e-posta eki veya sosyal medya üzerinden paylaşılmaz. Talepte bulunmanız durumunda yalnızca e-posta adresinize bilgilendirme yapılır. Makrolar yalnızca internet sitemiz üzerinden paylaşılır.
📥 Makroları indirerek kullanım sorumluluğunu kabul etmiş sayılırsınız. Oluşabilecek tüm sorunlar kullanıcı sorumluluğundadır.
