netcad-makro

Netcad Üzerinden Parsel Sorgulama Makrosu

Netcad projesi üzerinden bir parselin TKGM Parsel SORGULAMA sistemi üzerinden sorgulaması otomatik yapılabilir. Bunun için projeksiyon tanımlanması gerekir. Ardından mouse tıklaması ile otomatik TKGM Parsel Sorgulamaya gidilir.

sabangul67@gmail.com
Mayıs 18, 20257 dk okuma2 görüntülenme

Makro Ne İşe Yarar? 🔍

Bu makro, Netcad üzerinde tıkladığınız bir noktayı seçtiğiniz koordinat sistemi (ITRF96 veya ED50) ve dilim orta meridyenine (27°-45°) göre enlem ve boylam’a çevirir. Ardından, bu koordinatları kullanarak Tapu ve Kadastro Genel Müdürlüğü’nün parsel sorgulama sayfasını tarayıcınızda otomatik açar. 📍

  • Kolaylık: Kadastro projelerinde parsel bilgilerine hızlı erişim. ⏩
  • Esneklik: 3° veya 6° dilim, ITRF96/ED50 koordinat sistemleri desteklenir. 🛠️
  • Kullanıcı Dostu: Seçimleriniz kaydedilir, tekrar açtığınızda aynı ayarlarla başlar. 💾

Nasıl Kurulur? 🛠️

Makroyu Netcad’e eklemek çok basit! Aşağıdaki adımları takip edin:

  1. Dosyayı İndirin: Makro dosyasını (ParselSorgulama.vbs) buradan indirin. 📥
  2. Netcad’e Kopyalayın: Dosyayı Netcad’in makro klasörüne (genelde C:\\Program Files\\Netcad\\Macros) kopyalayın. 📂
  3. Makroyu Çalıştırın: Netcad’de Makro > Makro Çalıştır menüsünden ParselSorgulama.vbs’yi seçin. ▶️

💡 İpucu: Makroyu sık kullanıyorsanız, Netcad toolbar’ına bir kısayol ekleyebilirsiniz. Netcad yardım dosyalarından “Makro Kısayolu Ekleme” bölümüne göz atın!

Makro Nasıl Kullanılır? 🎯

Makroyu çalıştırdığınızda, aşağıdaki adımları izleyeceksiniz:

  1. Ayarları Seçin: Açılan diyalog penceresinde şu seçimleri yapın:
    • Dilim: 3° veya 6° dilim seçin (genelde 3° kullanılır). 📏
    • Koordinat Sistemi: ITRF96 veya ED50 seçin. 🌍
    • Dilim Orta Meridyeni: 27, 30, 33, 36, 39, 42 veya 45 seçin (projenizin bölgesine göre). 🗺️
    Seçimleriniz otomatik kaydedilir, bir sonraki açışta aynı ayarlar gelir! 💾
  2. Nokta Seçin: Netcad ekranında bir noktaya tıklayın. Parsel, yol veya herhangi bir nokta olabilir. 🖱️
  3. Sonucu Görün: Makro, tıklanan noktanın enlem/boylam’ını hesaplar ve tarayıcınızda parsel sorgulama sayfasını açar. 🌐
  4. Tekrarlayın: İptal edene kadar yeni noktalar seçip sorgulamaya devam edebilirsiniz. 🔄

📌 Örnek: Bir kadastro projesinde çalışıyorsunuz. Parsel sınırına tıkladınız, makro ITRF96 ve 36° meridyenini kullanarak koordinatları hesapladı ve parselsorgu.tkgm.gov.tr’de parsel bilgilerini açtı. Artık ada/parsel numaralarını anında görebilirsiniz! 🎉

Sıkça Sorulan Sorular ❓

  • 🧐 Hangi koordinat sistemini seçmeliyim?
    Türkiye’de genelde ITRF96 kullanılır. Projenizin koordinat sistemine göre ITRF96 veya ED50 seçin.
  • 🤔 Dilim orta meridyenini nasıl bileceğim?
    Projenizin bulunduğu bölgeye göre değişir. Örneğin, Ankara için genelde 33° veya 36° kullanılır. Proje belgelerinizi kontrol edin.
  • 😕 Makro hata verirse ne yapmalıyım?
    İnternet bağlantınızı kontrol edin ve doğru koordinat sistemi seçtiğinizden emin olun. Sorun devam ederse, makro dosyasını yeniden yüklemeyi deneyin.

Faydalı İpuçları 🌟

Yoğun projelerde, toolbar’a makro kısayolu ekleyerek zaman kazanın. ⏱️

Seçimleriniz C:\\Sagul\\Netcad\\Makro\\Tanimlar\\parselsorgulama.sagul dosyasına kaydedilir. Bu dosyayı yedekleyin! 💾

Netcad projenizde koordinat sistemini önceden kontrol edin, yanlış sistem hatalı sonuçlar verebilir. ⚠️

Detaylar ola

📝 Netcad NVB Code

VB
' Şaban GÜL Tarafından Üretilmiştir
' Daha Fazlası İçin: www.sabangul.com
' Hata, İstek ve Öneriler İçin: sabangul67@gmail.com
' Makro Başlığı: Tıklanan Noktayı Parsel Sorgulama Sisteminde Açma
' Makro Hakkında:
' - Bu makro, Netcad üzerinde kullanıcının tıkladığı bir noktayı seçilen koordinat sistemi (ITRF96/ED50) ve dilim orta meridyenine göre enlem/boylam’a çevirir.
' - Çevrilen koordinatlar, parselsorgu.tkgm.gov.tr adresinde otomatik olarak açılır.
' - Kullanıcı, diyalog penceresinden dilim (3°/6°), koordinat sistemi ve dilim orta meridyenini (27-45) seçer.
' - Varsayılan seçimler C:\\Sagul\\Netcad\\Makro\\Tanimlar\\parselsorgulama.sagul dosyasına kaydedilir ve tekrar açıldığında kullanılır.
' - Örnek: Kadastro projesinde bir parselin üzerine tıklayın, makro otomatik olarak parsel sorgulama sayfasını açsın.

Sub Main
    ' Değişken tanımlamaları (sabangul_ öneki ile)
    Dim sabangul_cr, sabangul_dom6, sabangul_x6, sabangul_y6, sabangul_dom3, sabangul_x3, sabangul_y3
    Dim sabangul_a, sabangul_b, sabangul_k0, sabangul_f, sabangul_f1, sabangul_e, sabangul_eisq
    Dim sabangul_ei, sabangul_kc1, sabangul_kc2, sabangul_kc3, sabangul_kc4, sabangul_sin1
    Dim sabangul_yayuzunlugu, sabangul_mu, sabangul_phi, sabangul_c1, sabangul_t1, sabangul_n1
    Dim sabangul_r1, sabangul_d, sabangul_fact1, sabangul_fact2, sabangul_fact3, sabangul_fact4
    Dim sabangul_lofact1, sabangul_lofact2, sabangul_lofact3, sabangul_deltalong
    Dim sabangul_zoneDOM, sabangul_rawEnlem, sabangul_enlem, sabangul_boylam
    Dim sabangul_enlemderece, sabangul_enlemdakika, sabangul_enlemsaniye
    Dim sabangul_boylamderece, sabangul_boylamdakika, sabangul_boylamsaniye
    Dim sabangul_pi, sabangul_objShell, sabangul_url, sabangul_x, sabangul_y
    Dim sabangul_secim, sabangul_fso, sabangul_f

    With Netcad
        ' Sabit değer: Pi
        sabangul_pi = 3.141592654

        ' Ayar dosyasını oku (varsayılan değerler için)
        Set sabangul_fso = CreateObject("Scripting.FileSystemObject")
        If Not sabangul_fso.FolderExists("C:\\Sagul\\Netcad\\Makro\\Tanimlar") Then
            sabangul_fso.CreateFolder("C:\\Sagul\\Netcad\\Makro\\Tanimlar")
        End If
        If sabangul_fso.FileExists("C:\\Sagul\\Netcad\\Makro\\Tanimlar\\parselsorgulama.sagul") Then
            Set sabangul_f = sabangul_fso.OpenTextFile("C:\\Sagul\\Netcad\\Makro\\Tanimlar\\parselsorgulama.sagul", 1)
            sabangul_dilim = sabangul_f.ReadLine()
            sabangul_koordinat = sabangul_f.ReadLine()
            sabangul_dilimorta = sabangul_f.ReadLine()
            sabangul_f.Close
        Else
            sabangul_dilim = "3"
            sabangul_koordinat = "ITRF96"
            sabangul_dilimorta = "36"
        End If

        ' Diyalog penceresi oluştur (sabangul.com ibaresi ile)
        Set sabangul_secim = .NewBDialog("Parsel Sorgulama [sabangul.com]")
        sabangul_secim.GetCombo "dilim", "Dilim: ", sabangul_dilim, 0
        sabangul_secim.GetCombo "koordinat", "Koordinat Sistemi: ", sabangul_koordinat, 0
        sabangul_secim.GetCombo "dilimorta", "Dilim Orta Meridyeni: ", "27|30|33|36|39|42|45", sabangul_dilimorta
        sabangul_secim.PutPrompt "Daha Fazlası İçin: www.sabangul.com"
        If sabangul_secim.ShowModal Then
            ' Kullanıcı seçimlerini kaydet
            Set sabangul_f = sabangul_fso.OpenTextFile("C:\\Sagul\\Netcad\\Makro\\Tanimlar\\parselsorgulama.sagul", 2, True)
            sabangul_f.WriteLine sabangul_secim.ValueByName("dilim")
            sabangul_f.WriteLine sabangul_secim.ValueByName("koordinat")
            sabangul_f.WriteLine sabangul_secim.ValueByName("dilimorta")
            sabangul_f.Close

            ' DOM ayarlaması
            If sabangul_secim.ValueByName("dilimorta") = 0 Then
                sabangul_dom3 = 27
            ElseIf sabangul_secim.ValueByName("dilimorta") = 1 Then
                sabangul_dom3 = 30
            ElseIf sabangul_secim.ValueByName("dilimorta") = 2 Then
                sabangul_dom3 = 33
            ElseIf sabangul_secim.ValueByName("dilimorta") = 3 Then
                sabangul_dom3 = 36
            ElseIf sabangul_secim.ValueByName("dilimorta") = 4 Then
                sabangul_dom3 = 39
            ElseIf sabangul_secim.ValueByName("dilimorta") = 5 Then
                sabangul_dom3 = 42
            ElseIf sabangul_secim.ValueByName("dilimorta") = 6 Then
                sabangul_dom3 = 45
            End If

            ' Geçici nokta oluştur
            Set sabangul_cr = .newc(0, 0, 0)
            While .SelectPoint("Herhangi Bir Nokta Seç [sabangul.com]", sabangul_cr, -1)
                ' Koordinatları al
                sabangul_x3 = CDbl(sabangul_cr.x)
                sabangul_y3 = CDbl(sabangul_cr.y)

                ' Koordinat sistemi parametreleri
                If sabangul_secim.ValueByName("koordinat") = 0 Then
                    ' ITRF96 GRS80
                    sabangul_a = 6378137
                    sabangul_b = 6356752.31410
                Else
                    ' ED50 HAYFORD
                    sabangul_a = 6378388
                    sabangul_b = 6356911.9
                End If

                ' Dilim ayarlaması
                If sabangul_secim.ValueByName("dilim") = 0 Then
                    sabangul_k0 = 0.9996 ' 3 Derece
                    sabangul_dom6 = (((sabangul_dom3 + 3) / 6) + 30)
                    sabangul_y6 = (sabangul_y3 - 500000) * sabangul_k0 + 500000
                    sabangul_x6 = (sabangul_x3 * sabangul_k0)
                Else
                    sabangul_k0 = 1 ' 6 Derece
                    sabangul_dom6 = sabangul_dom3
                    sabangul_y6 = sabangul_y3
                    sabangul_x6 = sabangul_x3
                End If

                ' Enlem/Boylam hesaplama
                sabangul_f = (sabangul_a - sabangul_b) / sabangul_a
                sabangul_f1 = 1 / sabangul_f
                sabangul_e = Sqr(1 - (sabangul_b / sabangul_a) * (sabangul_b / sabangul_a))
                sabangul_eisq = sabangul_e * sabangul_e / (1 - (sabangul_e * sabangul_e))
                sabangul_ei = (1 - Sqr(1 - sabangul_e * sabangul_e)) / (1 + Sqr(1 - sabangul_e * sabangul_e))
                sabangul_kc1 = 3 * sabangul_ei / 2 - 27 * sabangul_ei^3 / 32
                sabangul_kc2 = 21 * sabangul_ei^2 / 16 - 55 * sabangul_ei^4 / 32
                sabangul_kc3 = 151 * sabangul_ei^3 / 96
                sabangul_kc4 = 1097 * sabangul_ei^4 / 512
                sabangul_x = 500000 - (sabangul_y6)
                sabangul_y = sabangul_x6
                sabangul_yayuzunlugu = sabangul_x6 / sabangul_k0
                sabangul_mu = sabangul_yayuzunlugu / (sabangul_a * (1 - (sabangul_e^2 / 4) - 3 * (sabangul_e^4 / 64) - 5 * (sabangul_e^6 / 256)))
                sabangul_phi = sabangul_mu + sabangul_kc1 * Sin(2 * sabangul_mu) + sabangul_kc2 * Sin(4 * sabangul_mu) + sabangul_kc3 * Sin(6 * sabangul_mu) + sabangul_kc4 * Sin(8 * sabangul_mu)
                sabangul_c1 = sabangul_eisq * (Cos(sabangul_phi)^2)
                sabangul_t1 = Tan(sabangul_phi)^2
                sabangul_n1 = sabangul_a / ((1 - (sabangul_e * Sin(sabangul_phi))^2)^(1 / 2))
                sabangul_r1 = sabangul_a * (1 - sabangul_e * sabangul_e) / (1 - (sabangul_e * Sin(sabangul_phi))^2)^(3 / 2)
                sabangul_d = sabangul_x / (sabangul_n1 * sabangul_k0)
                sabangul_fact1 = sabangul_n1 * Tan(sabangul_phi) / sabangul_r1
                sabangul_fact2 = ((sabangul_d * sabangul_d) / 2)
                sabangul_fact3 = (5 + (3 * sabangul_t1) + (10 * sabangul_c1) - (4 * sabangul_c1 * sabangul_c1) - (9 * sabangul_eisq)) * (sabangul_d^4 / 24)
                sabangul_fact4 = (61 + 90 * sabangul_t1 + 298 * sabangul_c1 + 45 * sabangul_t1 * sabangul_t1 - 252 * sabangul_eisq - 3 * sabangul_c1 * sabangul_c1) * sabangul_d^6 / 720
                sabangul_lofact1 = sabangul_d
                sabangul_lofact2 = (1 + (2 * sabangul_t1) + sabangul_c1) * (sabangul_d^3 / 6)
                sabangul_lofact3 = (5 - 2 * sabangul_c1 + 28 * sabangul_t1 - 3 * sabangul_c1 * sabangul_c1 + 8 * sabangul_eisq + 24 * sabangul_t1 * sabangul_t1) * sabangul_d^5 / 120
                sabangul_deltalong = (sabangul_lofact1 - sabangul_lofact2 + sabangul_lofact3) / (Cos(sabangul_phi))
                sabangul_zoneDOM = 6 * sabangul_dom6 - 183
                sabangul_rawEnlem = 180 * (sabangul_phi - sabangul_fact1 * (sabangul_fact2 + sabangul_fact3 + sabangul_fact4)) / sabangul_pi
                sabangul_enlem = sabangul_rawEnlem
                sabangul_boylam = sabangul_zoneDOM - ((sabangul_deltalong * 180) / sabangul_pi)

                ' URL oluştur ve tarayıcıda aç
                sabangul_url = "https://parselsorgu.tkgm.gov.tr/#ara/cografi/" & CStr(sabangul_enlem) & "/" & CStr(sabangul_boylam)
                Set sabangul_objShell = CreateObject("WScript.Shell")
                sabangul_objShell.Run(sabangul_url)
            Wend

            ' Temizlik
            Set sabangul_cr = Nothing
            Set sabangul_secim = Nothing
            Set sabangul_fso = Nothing
            Set sabangul_f = Nothing
        End If
    End With
End Sub
VB

Yazar

sabangul67@gmail.com

Bu yazarın yayınladığı diğer içerikleri inceleyebilirsiniz.

Tüm yazıları
Devamını Keşfet

Benzer Yazılar