Bu makronun 2023 yılında hazırlanan güncel sürümü ile toplu sorgu dosyası yükleme işleminide yapabilirsiniz. Yeni sürüme gitmek için tıklayınız.

TKGM Tarafından yapılan değişiklikler ile 2019 yılından sonra yapılan sorgulamalar artık açılmıyor. Bu değişikliğe karşı Parsel Sorgulama Dosyası Açılmasının 2019 ( 3. sürüm ) sürümünü yaptık ve yayımladık.

Parsel Sorgulama Dosyası Koordinatlandırma 2019

Makro Hakkında:

Tapu ve Kadastro Müdürlüğünün sunduğu Parsel sorgulama hizmeti ile size sunulan sorgulama sonucunu koordinatlarınıda indirerek netcad projesine atabilirsiniz. Bunun için parsel sorgulama sayfasında sorgulama yaptıktan sonra parselin üzerini tıkladığınızda karşınıza gelen ekrandan dosya indirme seçeneğini tıklayınız. Buradan parsel sorgulama yaptığınız parsele ait koordinat ve bilgilerinin bulunduğu .json dosyasını indiriniz. İndirdiğiniz dosyayı Netcad üzerinden parsel sorgulama dosyasının Netcad ile Açılması makrosunu kullanarak parsel sorgulama sonucunu netcad üzerinden görebilirsiniz.

Program Güncellemesi Notları

Parsel Sorgulama Yazılımımız 01.10.2017 tarihi itibari ile güncellenmiştir. Güncelleme ile bazı hatalar giderilmiş, makronun daha hızlı çalışması sağlanmıştır. Yapılan Değişiklikler Aşağıdaki gibidir.

  • 67.Satır Hatası Çözüldü.
  • Makroda hata çıkması halinde kendi kendine çözümlüyor
  • Ekran Arayüzü yeniden tasarlandı.
  • Tabaka seçim ekranı kaldırıldı.
  • Alan Adı Gözükmüyor Hatası Alınıyordu. Bu hata çözümlendi.
  • Projenin Alan Adları ve Nokta Adları Otomatik Açılacak, Alan Taraması Kapatılacaktır.




Dosyanın İndirilmesi

  • Tapu ve Kadastro Genel Müdürlüğü Parsel Sorgulama İnternet Sayfasını Ziyaret Ediniz.  https://parselsorgu.tkgm.gov.tr/ web sitesine giriniz. Parseli Sorguladıktan sonra aşağıda görünen butona basınız
  • Kaydetme seçeneklerinden Geo Json seçiniz ve İndir’e Basınız.İndirdiğiniz dosyayı bilgisayarınıza depolayınız. ( kaydediniz )
  • Ardından Makroyu Çalıştırınız.
  • Öncelikle dosya seçiniz.  
  • Daha sonra dönüşüm yapmak istiyorsanız Datum, Dilim numarasını seçip proje dönüşümüne evet deyiniz.
  • Burada dikkat etmeniz gereken tüm projenizde dönüşüm yapılacağından bu işlemi yeni proje açarak yapınız.
  • Şimdilik ED50, ITRF, Coğrafi Seçenekleri vardır. İsteğe bağlı ilerleyen sürümlerde değişebilir.

Sonuç:

  • Birden Fazla Dosya Eklemek İsteyen Dönüşecek Koordinat Sistemini Coğrafi Seçip, Dönüşüme Hayır Demeleri Halinde Tüm Projeleri tek tek ekleyebilirler. Tüm dosyalar eklendikten sonra Netcad üzerinden Coğrafiden UTM’e Dönüşüm yapabilirler.
  • Ayrıntılı bilgi için bize ileti gönderebilirsiniz.
  • Toplu dosya ekleme özelliği 3. sürümde yayımlanacaktır

Etiketler: Basit düzey makro, Netcad, Makro, Pratik Netcad, Netcad Araçları, Netcad tabaka, netcad seçim, Pratik Netcad, Netcadde nasıl yapılır,netcad menü, netcad araç, nvb, ücretsiz makro, harita makro, parsel sorgu, koordinat, indir, ED50, ITRF, COĞRAFİ, Datum, dönüşüm

Uyarılar:

  • Dosyayı indirerek veya yükleyerek tüm sorumluluğu kabul etmiş sayılırsınız.
  • Dosyayı netcadde açarken yeni proje oluşturup açınız. Aksi halde önceki projeniz bozulur ve bu işlemi geri alamayabilirsiniz.
  • İndirilen dosyadaki koordinatlar kesinlikle kesinlik arz etmez, resmi işlemlerde kullanılmaz. Sadece bilgilendirme amaçlıdır.
  • Netcad makrolarında hiçbir metni veya karakteri değiştirmeyiniz. Aksi halde makro işlevsiz hale gelebilir veya hatalı işlev ile karşılaşabilirsiniz.
  • Bu Makronun Çalışması için bilgisayarınızın C Sürücüsünün içerisine klasör ve dosyalar oluşturulur.  Makronun çalışması için bu klasörlere de ihtiyaç duyulmaktadır.
    • C Sürücüsü içerisine Sagul isimli klasör oluşturulur.
    • C:\Sagul klasörünün içerisine Netcad isimli klasör oluşturulur.
    • C:\Sagul\Netcad klasörünün içerisine Makro isimli klasör oluşturulur.
    • C:\Sagul\Netcad\Makro klasörünün içerisine Tanimlar isimli klasör oluşturulur.
    • C:\Sagul\Netcad\Makro\Tanimlar klasörü içerisine jsonoku.sagul isimli dosya oluşturulur.
    • .sagul dosya türünü not defteri ile açabilir ve görüntüleyebilirsiniz.
    • Bu makroyu çalıştırarak bu klasörleri ve dosyaları oluşturmaya izin vermiş ve sorumluluğu kendiniz almış olacaksınız.

Video Dosyası:

İndirme Linkleri:

Yeni Sürüm İndirme Linki-1: Google Drive ( Harita Akademi )

Reklam Gelirleri Desteklediğimiz Yardım Kuruluşlarına Bağışlanacaktır. Lütfen Neden Reklam Var Şeklinde İleti Göndermeyiniz.




Makro Açık Kaynak Kodu:

'' 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:\Sagul") Then
 objFolder.SubFolders.Add "Sagul"
 End If

Set fso = CreateObject("Scripting.FileSystemObject")
 Set objFolder = FSO.GetFolder("C:\Sagul")
 If Not FSO.FolderExists("C:\Sagul\Netcad") Then
 objFolder.SubFolders.Add "Netcad"
 End If

Set fso = CreateObject("Scripting.FileSystemObject")
 Set objFolder = FSO.GetFolder("C:\Sagul\Netcad")
 If Not FSO.FolderExists("C:\Sagul\Netcad\Makro") Then
 objFolder.SubFolders.Add "Makro"
 End If



Set fso = CreateObject("Scripting.FileSystemObject")
 Set objFolder = FSO.GetFolder("C:\Sagul\Netcad\Makro")
 If Not FSO.FolderExists("C:\Sagul\Netcad\Makro\Tanimlar") Then
 objFolder.SubFolders.Add "Tanimlar"
 End If



dim dosyaoku,frs ,eyups
 Set fso = CreateObject("Scripting.FileSystemObject")
 Set frs = fso.OpenTextFile("C:\Sagul\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 "İlk Kurulum Hatası Oluştu. Sizin İçin Otomatik Düzelteceğiz",0,"Dikkat"
 Set xfsot = CreateObject("Scripting.FileSystemObject")
 Set xft = xfsot.OpenTextFile("C:\Sagul\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 2. Sürüm ,[Harita Akademi, Şaban GÜL]")
 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.GetCombo "item1","Dönüştürülecek Koordinat Sistemi (UTM3)","Dönüşüm Yapma|ED50|ITRF" ,sgul1
 BD.GetCombo "item2","Dönüştürülecek Dilim Numarası","27|30|33|36|39|42|45" ,sgul2
BD.GetCombo "item3","Koordinat Dönüşümünde Projede Dönüşsün mü ? ","Hayır|Evet" ,sgul3
 if BD.showmodal then
 xlspath = BD.ValueByName("sabangul")
 Dim fsot, ft
 Set fsot = CreateObject("Scripting.FileSystemObject")
 Set ft = fsot.OpenTextFile("C:\Sagul\Netcad\Makro\Tanimlar\jsonoku.sagul", ForWriting, True)
 dim gul1,gul2,gul3,gul4
 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













if XLSpath=-1 or XLSpath="" then
 msgbox "Dosya Seçilmedi"
exit sub
 end if





Dim Satir ,o ,a ,c1,c2,c3,c4,c5,c6

Set fso = CreateObject("Scripting.FileSystemObject")
 Set f = fso.OpenTextFile(BD.ValueByName("sabangul"), ForReading, True)



set BD = Nothing


 hakademi1= "SAGUL_ALAN"
 hakademi2= "SAGUL_NOKTA"
 hakademi3= "SAGUL_TABLO"
 hakademi4= ""

a= F.ReadLine
 a= replace(a,"[[[","$")
 a= replace(a,"]]]","$")



if ahmet<>0 then
 dim pc
 set pc = Netcad.NewProjection
 pc.ProjectionType =1
 pc.Zone = 36
 pc.Datum = 0
 pc.SetToCurrentProject FALSE

end if



dim elif,yaren,gul,ruhan
 satir=Split(a,"$")
 elif = satir(0)
 yaren= satir(1)
 gul= satir(2)
 ruhan=""



dim saban,soner,olcayto,sagul1,sagul2
 saban=""""
 soner="},properties:{"
 olcayto="}}],type:FeatureCollection,crs:{type:name,properties:{name:EPSG:4326}}}"
 sagul1=replace(yaren,"],[","$")

sagul2 =Replace(gul,saban,"")
 sagul2 =Replace(sagul2,soner,"")
 sagul2 =Replace(sagul2,olcayto,"")
 sagul2 =Replace(sagul2,","," ")



dim sagulnet,sagulnet1,sagulnet2,sagul_1,sagul_2,sagul_3,sagul_4,sagul_5,nitelik
 sagulnet1=Split(sagul2,"Alan")
 sagulnet2=Split(sagul2,"m2")
 sagul_1=replace(sagulnet2(0),sagulnet1(0),"")
 sagul_2=replace(sagul_1,"Alan:","")
 sagul_3=replace(sagul_2," ","")

sagul_4 = replace(sagul2,sagul_2,sagul_3)
 sagul_5 = replace(sagul_4,"m2","")

sagulnet=replace(sagul_5,"ParselNo","")
 sagulnet=replace(sagulnet,"Alan","")
 sagulnet=replace(sagulnet,"Mevkii","")
 sagulnet=replace(sagulnet,"Nitelik","")
 sagulnet=replace(sagulnet,"Ada","")
 sagulnet=replace(sagulnet,"Ilce","")
 sagulnet=replace(sagulnet,"Il","")
 sagulnet=replace(sagulnet,"Pafta","")
 sagulnet=replace(sagulnet,"Mahalle","")

nitelik=Split(sagulnet," :")

dim n1,n2,n3,n4,n5,n6,n7,n8,n9
 n1= replace(nitelik(0),":","") ' parsel no
 n2= nitelik(1) ' Alan
 n3= nitelik(2) ' Mevkii
 n4= nitelik(3) ' Nitelik
 n5= replace(nitelik(4)," ","") ' Ada
 n6= nitelik(5) ' Il
 n7= nitelik(6) ' Ilce
 n8= nitelik(7) ' Pafta
 n9= nitelik(8) ' Mahalle

dim ili,ilcesi,mahallesi,adaparseli,alani,mevkiisi,paftasi,cinsi

ili= n6
 ilcesi= n7
 mahallesi= n9
 adaparseli= n5 & "_" & n1
 alani= n2
 mevkiisi= n3
 paftasi= n8
 cinsi= n4
 paftasi= n8

dim x,kubilay ,satir2
 dim i,j,p
 dim yasin
 dim soner1,soner2
 Satir=Split(sagul1,"$")
 kubilay=0

set p = nothing
 set p = .NewPoly
 for each x in satir
 kubilay=kubilay+1
 Satir2=Split(x,",")
 soner1= satir2(0)
 soner2= satir2(1)
 p.AddCoor(.NewC(soner1,soner2,0))



.AddObject .MakePoint(.newc(soner1,soner2,0), kubilay,"SAGULNET" ,ha1)
 next
 set o = .MakePline(adaparseli,POLYCLOSED+POLYFILLED+16,alani,ha2,0,0,p)
 .AddObject o



set o = nothing
 set p = nothing



f.Close





if ahmet<>0 then

set pc = Netcad.NewProjection
 pc.ProjectionType =3
 pc.Zone = furkan
 pc.Datum = ahmet
 if uncu=1 then
 pc.SetToCurrentProject true
 else
 pc.SetToCurrentProject false
 end if
 end if







.findworld







dim secim,c,obj,yazi,layerno ,yaz1,yaz2,yaz3,yaz4,yaz5,yaz6,yaz7,yaz8,yaz9,yaz10,asilyazi,yaziboy,koorx
 set secim = .NewSelectStatus()
 set c = .newc(0,0,0)







asilyazi=2
 yaziboy=3
 layerno=.foundlayer("TXT_KOORDINAT")

if .SelectPoint("Tablonun Yerleştirileceği Yeri Seçiniz", c, 2) then

koorx=c.x
 koorx=koorx+2

c.x=koorx-(yaziboy)
 set yaz1=.maketext(c, adaparseli & " No'lu Parsel Bilgileri",0,0,asilyazi,0,"1",ha3)
 c.x=koorx-(yaziboy*2)
 set yaz2=.maketext(c, "İli: " & ili,0,0,asilyazi,0,"1",ha3)
 c.x=koorx-(yaziboy*3)
 set yaz3=.maketext(c, "İlçesi: " & ilcesi,0,0,asilyazi,0,"1",ha3)
 c.x=koorx-(yaziboy*4)
 set yaz4=.maketext(c, "Mahallesi: " & mahallesi,0,0,asilyazi,0,"1",ha3)
 c.x=koorx-(yaziboy*5)
 set yaz5=.maketext(c, "Alanı: " & alani,0,0,asilyazi,0,"1",ha3)
 c.x=koorx-(yaziboy*6)
 set yaz6=.maketext(c, "Cinsi: " & cinsi,0,0,asilyazi,0,"1",ha3)
 c.x=koorx-(yaziboy*7)
 set yaz7=.maketext(c, "Paftası: " & paftasi,0,0,asilyazi,0,"1",ha3)
 c.x=koorx-(yaziboy*8)
 set yaz8=.maketext(c, "Mevkiisi: " & mevkiisi,0,0,asilyazi,0,"1",ha3)



.addobject(yaz1)
 .addobject(yaz2)
 .addobject(yaz3)
 .addobject(yaz4)
 .addobject(yaz5)
 .addobject(yaz6)
 .addobject(yaz7)
 .addobject(yaz8)

'.AddObject .MakeLine(.newc(c.y,c.x+(asilyazi*3),0), .newc(c.y+asilyazi*25,c.x+(asilyazi*3),0), .CreateLayer("TABAKA1",yellow), 0, 0)



end if







End With









End Sub




Önceki Sürüm:

TKGM Parsel Sorgu Dosyasının Koordinatlarının İndirilmesi ve Netcad ile Açılması (Netcad Makro)

19 Responses

  1. Merhabalar Şaban Bey bu paylaşımınız için size çok teşekkür ederim elinize emeğinize bilginize sağlık. Macro yu kullanarak bir deneme çalışması yapmak istedim ve parsel sorgulama sayfasından parsel koordinatlarını indirdim macro yu çalıştırarak ITRF 96 33-3 koordinat dönüşümünü gerçekleştirdim fakat dönüşüm sonucu parselde aynı yöne doğru 2cm kayma olduğunu gördüm aplikasyon için çok önemli bir sorun değil tabiki fakat bunun sebebini merak ettim acaba düzeltilme durumu varmı. Tekrardan teşekkür ederim iyi çalışmalar.

  2. Merhaba,
    yeni sürümde 1. satır 0. kolon ayrıştırma hatası alıyorum. Düzeltmek için ne yapmam gerekli.

  3. Şaban Bey dün çalışan makro bugün hatalı dönüşüm yapıyor. Parsel sorgu dan indirdiğimiz dosyayı dönüştürmek istedik fakat koordinatları dönüşüm yapmıyor Y:29.71, X:38.72 sabit kalıyor makro bozulmuş olabilir mi acaba ilgilenirseniz sevinirim. İyi çalışmalar.

  4. merhabalar şaban bey, öncelikle makronuz bizim için çok faydalı oldu bunun için teşekkür etsek az. fakat bir kaç sorum var;

    birincisi aynı netcad dosyasına ikinci makroyu açtığım zaman proje dönüşsün kısmını hayır bile seçsem çok farklı yönlere atıyor parselleri yanyana olsa bile bunu nasıl önlerim?

    ikincisi ise birden fazla parseli aynı anda makro ile çalıştırmamın imkanı var mıdır, tek tek çok uğraşlı oluyor?

  5. Şaban bey,
    İşini ve mesleğini severek yapan insanları hep takdir etmişimdir. Takdir ederim seni de…
    Bu veriyi Autocad’e aktarma hakkında da videolarınızı bekliyoruz 🙂
    Belki çok kolay bişey ama bi türlü çözemedik…

  6. merhaba üstat. Macroyu bir süre kullandım işime yaradı teşekkür ederim. Sanırım tkgm koordinat indirme kısmını kapattı bu sorunu nasıl çözebiliriz? saygılar..

  7. Merhabalar Şaban Bey bu paylaşımınız için size çok teşekkür ederim elinize emeğinize bilginize sağlık. Macro yu kullanarak bir deneme çalışması yapmak istedim ve parsel sorgulama sayfasından parsel koordinatlarını indirdim macro yu çalıştırarak ITRF 96 30-3 koordinat dönüşümünü gerçekleştirdim fakat dönüşüm sonucu parselde koordinatlar aynı çıkıyor acaba ben nerde yanliş yapıyorum

  8. Şaban bey merhaba;
    Netcad 7.6 versiyonunda makroyu ilk çalıştırdığımda “İlk Kurulum Hatası Oluştu. Sizin İçin Otomatik Düzelteceğiz” uyarısı aldım. Makro çalıştı ancak parsel ölçeksiz ve sıfır noktasına geldi. Yardımcı olurmusunuz?

  9. slm şaban bey öncelikle paylaşımlarınız ve emeğiniz için çok teşekkür ederim elinize sağlık yalnız şöyle bir sorun oluyor çok büyük bir alan olupda içerisinde de küçük parseller olduğunda yani orman ve hazine arazilerinin içerisinde tarlalar oluyor ya öyle alan indirdiğimde hatlar ve alan bozuk geliyor dış hat içerdeki alana bağlı geliyor ve karışıyor ve alan çevrilmiyor, buna bir çare bulamazmısınız . teşekkür ederim iyi çalışmalar.

  10. gerçekten çok iyi bir program olmuş elinize emeğinize sağlık ancak linkten indirilen makroda karakterler de hata var ve sonuca ulaşılamıyor.bu sayfadaki makronun içini kopyala yapıştır yapınca sonuca ulaştım.

  11. slm şaban bey daha önce sıkıntısız kullanıyordum bu makroyu yalnız pc ye format attırdım netcad yeniden yükledim şimdi sadece noktaları atıyor alan atmıyor neden acaba yardımcı olursanız sevinirim kolay gelsin.

Gökhan DEMİREL için bir yanıt yazın Yanıtı iptal et

E-posta adresiniz yayınlanmayacak. Gerekli alanlar * ile işaretlenmişlerdir