Tapu Alanlarının Sıfırlanması (Netcad Makro)

Makro Hakkında:

  • Netcad projenizdeki tapu alanlarının sıfırlanmasını sağlar.
  • Basit Düzey Makro Sınıfındadır.
  • Makroda Üzerinde Çalıştığımız Gelişmeler:
    • Bu makroda geliştirmeyi düşündüğümüz herhangi bir algoritma yoktur.
  • 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, tapu alan, tapu alan sıfırlama

Uyarılar:

  • Yapılan işlemde önceki tapu alanları silinecektir ( sıfırlanacaktır ).
  • Bu işlem sadece excel dosyasındaki parsel numaralarının bulunduğu sütundaki parseller ile projenizdeki parsellerde alan adları aynı olan alan objelerine uygulanır.
  • Bu işlemde geri alma işlemi tek tek yapılmaktadır. Bu nedenle ciddi anlamda yapacağınız değişikliklerde geri alma işleminiz çok uzun sürebilir.
  • 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.

İndirme Linkleri:

İndirme Linki-1: Google Drive ( Harita Akademi )

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

set BD = Netcad.NewBDialog("Tapu Alanlarının Sıfırlanması [Harita Akademi, Ş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



if BD.showmodal then
 sagul= BD.ValueByName("sagulnet")
 if sagul=1 then
 set BD2 = Netcad.NewBDialog("Tapu Alanlarının Sıfırlanması [Harita Akademi, Ş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ı Sıfırlanacak Alanları Seç",1,array(oPline),ss)
 set o = ss.objects(0) ' Secim objesinin ilk objesini al
 o.tarea=0 ' rengini sari yap
 .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ı Sıfırlanacak 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
 o.tarea = 0 ' rengini sari yap
 .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
 obj.tarea=0
 .PUTOBJECT .CUROBJPOS,OBJ

loop
 end with

End Sub

 

Yazar: Şaban GÜL

Amacımız herkese yardımcı olabilmek. Haritacılık ile sınırlı kalmayıp birçok sektöre girmeye RAMAK kaldı :)

Bir cevap yazın

E-posta hesabınız yayımlanmayacak. Gerekli alanlar * ile işaretlenmişlerdir

This site uses Akismet to reduce spam. Learn how your comment data is processed.