Home / Netcad Makro / Tapu Alanlarını Hesap Alanına Dönüştürme Makrosu (Convert Parcel Areas to Calculated Areas Macro)

Tapu Alanlarını Hesap Alanına Dönüştürme Makrosu (Convert Parcel Areas to Calculated Areas Macro)

Tapu Alanlarını Hızlı ve Kolay Hesap Alanına Çevirme Makrosu 🚀


Bu makro, NetCAD yazılımında tapu alanlarını hızlı bir şekilde hesap alanına dönüştürmek için tasarlanmıştır. 🗺️ Kullanıcı dostu arayüzü ile proje genelinde, belirli bir tabakada veya seçilen alan objeleri üzerinde işlem yapabilir. Ayrıca, tapu alanı zaten mevcutsa işlem yapmama seçeneği sunar, böylece veri kaybı önlenir. Makro, farklı seçim yöntemleri ile esneklik sağlar ve özellikle harita mühendisleri için zaman tasarrufu sağlar. 🔧


Nasıl Çalışır (How Does It Work)

Makro, NetCAD ortamında çalışır ve kullanıcıya dört farklı yöntem sunar:

  1. Tüm Projedeki Alan Objeleri: Projedeki tüm alan objelerini tarar ve tapu alanlarını hesap alanına çevirir.
  2. Bir Tabakadaki Alan Objeleri: Kullanıcının seçtiği tabakadaki alan objeleri üzerinde işlem yapar.
  3. Ekrandan Tek Tek Seçilen Alan Objeleri: Kullanıcının manuel olarak seçtiği objeler üzerinde çalışır.
  4. Seçim Kümesi Oluşturarak Alan Seç: Bir seçim kümesi oluşturarak toplu işlem yapar.

Ek olarak, “Tapu Alanı Varsa İşlem Yapma” seçeneği ile mevcut tapu alanlarını korur. Makro, objeleri tarar, alan hesaplamalarını yapar ve sonuçları NetCAD projesine kaydeder. Kullanıcı, seçim yaptıktan sonra makro otomatik olarak işlemi tamamlar. 🛠️


Etiket ( Labels )

NetCAD makro, tapu alanı, hesap alanı, harita mühendisliği, alan hesaplama, VBScript makro, kullanıcı dostu makro, NetCAD otomasyon, tapu alanı dönüştürme, harita yazılımı, mühendislik makrosu, alan yönetimi, NetCAD eklentisi, tapu hesaplama, harita otomasyonu, VBScript programlama, NetCAD araçları, harita mühendisi araçları, alan seçimi, proje yönetimi


📝 Netcad NVB Code

VB
' 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 obj,BD,BD2,sagul,i,RUHAN,j,o,SS,SEL ,sagul2
 with Netcad

set BD = Netcad.NewBDialog("Tapu Alanlarının Hesap Alanı Yapılması [SagulCAD, Şaban GÜL]")

BD.Getradio "sagulnet","Bir Yöntem Seçiniz","Tüm Projedeki Alan Objeleri|Bir Tabakadaki Alan Objeleri|Ekrandan Tek Tek Seçilen Alan Objeleri| Seçim Kümesi Oluşturarak Alan Seç" ,0

BD.Getcheck "sagulnet2","Tapu Alanı Varsa İşlem Yapma" ,0

if BD.showmodal then
 sagul= BD.ValueByName("sagulnet")
 sagul2= BD.ValueByName("sagulnet2")
 if sagul=1 then
 set BD2 = Netcad.NewBDialog("Tapu Alanlarının Hesap Alanı Yapılması [SagulCAD, Şaban GÜL]")
 BD2.GetCombo "tabaka", "Alanların bulunduğu tabakayı seçiniz : ", 0, 0
 for i = 1 to .numlayers - 1
 BD2.AddCombo .LayerNameOf(i)
 next

if BD2.showmodal then
 else
 exit sub
 end if

if sagul=1 then
 RUHAN= BD2.ValueByName("tabaka")
 end if
 with nclayermanager
 ruhan= .layer(ruhan).name
 end with
 end if

end if

if sagul=2 then
 set ss = .NewSelectStatus ' Anlik Secim objesi yarat
 while .SelectObjectInstant("Tapu Alanı Hesap Alanı Yapılacak Alanları Seç",1,array(oPline),ss)
 set o = ss.objects(0) ' Secim objesinin ilk objesini al

 if sagul2=1 then
 if t.area=0 then o.tarea=o.area 
 else
 o.tarea=o.area
 end if

 .PutObject ss.indexs(0), o ' objeyi geri koy
 .DrawObject o,-1 ' kendi rengi ile ciz
 set o = nothing
 wend
 set ss = nothing

exit sub
 end if

if sagul=3 then
 with Netcad
 set SEL = .NewSelectionSet ' Yeni kume yarat
 set o = .NewObject
 if SEL.SELECT("Tapu Alanı Hesap Alanı Yapılacak Alan Kümesini Seç",array(opline)) then ' istenen turleri kumeye ekle
 for i = 0 to SEL.NE-1 ' kumenin her bir elemani icin
 j = SEL.GetSelectedObject(i, o) ' objeyi ve gercek indeksini al
 if sagul2=1 then
 if t.area=0 then o.tarea=o.area 
 else
 o.tarea=o.area
 end if

 .putobject j, o ' objeyi geri koy
 next
 SEL.RedrawAndRewind ' secim kumesini toplu kendi renginde
 end if ' cizdir ve kumeyi basa sardir.
 set SEL = nothing
 set o = nothing
 end with
 exit sub
 end if

if sagul=0 then
 .SetFilter nothing, array(), array(opline)
 end if

if sagul=1 then
 .SetFilter nothing, array(BD2.ValueByName("tabaka")), array(opline)
 end if

do

set obj=.getnextobject
 if obj is nothing then
 exit do
 end if
 .drawobject obj,102
 if sagul2=1 then
 if t.area=0 then o.tarea=o.area
 else
 o.tarea=o.area
 end if

 .PUTOBJECT .CUROBJPOS,OBJ

loop
 end with

End Sub
VB

netcad-tapu-alani-esittir-hesap-alani

⚠️ Dikkat! Netcad Makrosu Kullanımı Hakkında Bilgilendirme

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.
Etiketlendi: