Alan Objelerinin Ağırlık Merkezine Nokta Üretimi ( Netcad Makro )

Makro Hakkında:

Netcad projenizdeki alan objelerinin ağırlık merkezine nokta üretilir.

• Makroda Üzerinde Çalıştığımız Gelişmeler:
  • Şu anlık üzerinde çalıştığımız bir gelişme bulunmamaktadır. Kullanıcılardan gelen istekler ve editörlerimizin çalışmaları ile olası gelişmeler yayımlanacaktır. Bizi takip ediniz.
• 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,

Uyarılar:

• 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
 With netcad

Dim i,j,o,SEL,tx, p ,TabNo,BD1,BD2,BD3,BD4,tabakam

tabakam=""
 set BD1 = Netcad.NewBDialog("Hangi Tabakada Yazdırılacağını Seçiniz [Harita Akademi, Şaban GÜL]")
 set BD2 = Netcad.NewBDialog("Tabaka Seçimi Yapınız [Harita Akademi, Şaban GÜL]")
 set BD3 = Netcad.NewBDialog("Yeni Tabaka Adı Giriniz [Harita Akademi, Şaban GÜL]")
 set BD4 = Netcad.NewBDialog("Nokta Başına Veya Sonuna Eklenecek Metin [Harita Akademi, Şaban GÜL]")





BD1.GetCombo "tabaka", "Parsel No Hangi Tabakaya Yazılsın: ", "0", 0
 for i = 1 to .numlayers - 1
 BD1.AddCombo .LayerNameOf(i)
 next



BD2.Getradio "secim","Noktalar Hangi Tabakada Oluşturulsun?","Mevcut Tabakalar|Yeni Tabaka" ,0

BD3.Getstring "yenitabaka","Yeni Tabaka Adı: ","sagul_agirlik_merkezi",50



BD4.Getradio "metin","Noktanın Başı veya Sonuna Veri Ekleme","Herhangi İşlem Yapma ( Olduğu Gibi Bırak )|Noktanın Başına Aşağıdaki Metni Ekle|Noktanın Sonuna Aşağıdaki Metni Ekle| Noktadan Aşağıdaki Karakteri Sil" ,0
 BD4.Getstring "metin2","...","",50
 if BD4.showmodal then
 dim saban
 saban=BD4.ValueByName("metin2")
 if BD2.showmodal then

if BD2.ValueByName("secim")=0 then
 if BD1.showmodal then

tabakam=BD1.ValueByName("tabaka")
 with ncLayermanager
 tabakam= .layer(tabakam).Name

end with
 end if

else

if BD3.showmodal then
 tabakam= BD3.ValueByName("yenitabaka")
 end if

end if

if tabakam="" then
 exit sub
 end if



dim elif
 elif=0
 set SEL = .NewSelectionSet ' Yeni kume yarat
 set o = .NewObject
 set p=.Newpoly
 TabNo = Netcad.CreateLayer (tabakam, 4)
 if SEL.SELECT("Ağırlık Merkezi Noktası Oluşturulacak Alanları Seçiniz",array(opline)) then ' istenen turleri kumeye ekle
 for i = 0 to SEL.NE-1 ' kumenin her bir elemani icin
 elif=elif+1
 j = SEL.GetSelectedObject(i, o) ' objeyi ve gercek indeksini al
 set p=.getplineExt(o)
 o.renk = red ' rengini sari yap

dim ruhan
 ruhan=""
 ruhan = o.pname
 if BD4.ValueByName("metin")=0 then ruhan= ruhan
 if BD4.ValueByName("metin")=1 then ruhan= saban & ruhan
 if BD4.ValueByName("metin")=2 then ruhan= ruhan & saban
 if BD4.ValueByName("metin")=3 then ruhan= replace(ruhan,saban,"")
 set tx=.MakePoint(p.CenterOfMass,ruhan,0,TabNo)
 .addobject(tx)

next
 SEL.RedrawAndRewind ' secim kumesini toplu kendi renginde
 end if ' cizdir ve kumeyi basa sardir.
 set SEL = nothing
 set o = nothing

end if
 end if

END with

if elif=0 then
 msgbox ("Nokta üretimi yapılamadı"),64,"Harita Akademi, Şaban GÜL"
 else

msgbox ("Üretilen Nokta Sayısı: "& elif &chr(13)&chr(10)&" Noktalar " & tabakam & " tabakasına alındı." ),64,"Harita Akademi, Şaban GÜL"
 end if

end sub