Home / Netcad Makro / Netcad-Macro-Text / Yazı Değerleri Toplama ve Çıkarma Makrosu (Text Values Addition and Subtraction Macro)

Yazı Değerleri Toplama ve Çıkarma Makrosu (Text Values Addition and Subtraction Macro)

Yazı Değerlerini Kolayca Toplayın ve Çıkarın: NetCAD için Pratik Makro Çözümü 🚀


Bu makro, NetCAD ortamında proje üzerindeki yazıların sayısal değerlerini toplamak veya çıkarmak için geliştirilmiştir. Kullanıcı dostu bir arayüzle, seçilen yazıların değerlerini hızlıca hesaplar, sonuçları ekranda gösterir veya mesaj kutusuyla bildirir. Ayrıca, seçilen yazıları özel bir tabakaya taşıma ve ortalama hesaplama gibi ek özellikler sunar. Tek tek veya toplu seçim yapma seçenekleriyle esneklik sağlar. Harita mühendisleri ve CAD kullanıcıları için zaman kazandıran bu araç, Şaban GÜL tarafından geliştirilmiştir.


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

Makro, NetCAD’in VBScript dilinde yazılmıştır ve şu adımları izler:

  1. Kullanıcı Arayüzü: Makro çalıştığında, bir diyalog kutusu açılır. Kullanıcı, toplama veya çıkarma işlemi, seçim türü (tek tek veya toplu), tabaka taşıma tercihi ve sonuç gösterim yöntemini seçer.
  2. Değer Girişi: İlk değer, toplama veya çıkarma işlemine başlangıç noktası olarak alınır.
  3. Seçim Süreci: Kullanıcı, yazı objelerini tek tek veya toplu olarak seçer. Seçilen yazıların sayısal değerleri, belirtilen işlem türüne göre (toplama/çıkarma) hesaplanır.
  4. Tabaka Yönetimi: Eğer seçilirse, yazılar “sagul_yazitopla” adlı bir tabakaya taşınır.
  5. Sonuç Gösterimi: Hesaplama tamamlandığında, toplam değer, seçilen yazı sayısı ve ortalama bir mesaj kutusunda gösterilir. Alternatif olarak, sonuç proje ekranına yazdırılabilir.
    Bu makro, özellikle büyü

Etiket ( Labels )

yazı toplama, yazı çıkarma, NetCAD makro, CAD otomasyonu, harita mühendisliği, Şaban GÜL, toplu seçim, tabaka yönetimi, ortalama hesaplama, proje yönetimi, VBScript makro, SagulCAD, kullanıcı dostu makro, hızlı hesaplama, CAD araçları


📝 Netcad NVB Code

17.05.2025 tarihli güncelleme ile artık çıkarmada yapılabilmektedir.

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 secim,c,layerno,obj,yaz1,yaz2,yaz3,yaz4,top,o,sagul,sel,i,j,elifyaren ,yazi,ruhan,gulailesi ,saban,kop
 Dim BD
 with netcad
 on error resume next
 set BD = Netcad.NewBDialog("Yazı Değerleri Toplama/Çıkarma [SagulCAD, Şaban GÜL]")
             
 BD.putprompt " Toplama/Çıkarmaya Başlanacak İlk Değer:"
BD.Getfloat "item1","",0,10
 BD.Getradio "item5","İşlem Türü Seçiniz: ","Toplama|Çıkarma" ,0

 BD.Getradio "item2","Proje Üzerindeki Seçim Türü:","Tek Tek Seçim|Toplu Seçim" ,1
 BD.Getradio "item3","Seçilenleri SAGUL_YAZITOPLA Tabakasına Al","Evet|Hayır" ,1
 BD.Getradio "item4","Sonuç Gösterimi","Sadece Mesaj Olarak Göster|Sonucu Ekrada Yazdır|Hem Mesaj Göster Hem Ekrana Yazdır" ,0

if BD.showmodal then
 sagul=1
 elifyaren=1


dim tc
sagul= BD.ValueByName("item2")
 elifyaren= BD.ValueByName("item3")
 ruhan= BD.ValueByName("item4")
 tc= BD.ValueByName("item5")
 gulailesi=0


 if sagul=0 then
 set secim = .NewSelectStatus()
 set c = .newc(0,0,0)

top= BD.ValueByName("item1")
 set yazi = .NewSelectStatus

while .SelectObjectInstant ("Toplam/Çıkarma yapılacak yazıları seçiniz. İşlem tamamlandıktan sonra fare ile sağ tıklayınız",1,array(otext),yazi)
 set o = yazi.objects(0)
 kop=top
if tc=0 then
 top=top+o.s
 else
  top=top-o.s
 end if
if kop<>top then
 gulailesi=gulailesi+1
 end if

if elifyaren=1 then
 o.tabaka=.createlayer("sagul_yazitopla",2)
 end if

.PutObject yazi.indexs(0), o
 wend
 End if



if sagul=1 then

top= BD.ValueByName("item1")
 set SEL = .NewSelectionSet ' Yeni kume yarat
 set o = .NewObject
 if SEL.SELECT("Toplam Yapılacak Yazıları Seçiniz",array(otext)) 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
 kop=top


 if tc=0 then
 top=top+o.s
 else
  top=top-o.s
 end if

if kop<>top then

gulailesi=gulailesi+1
 end if



if elifyaren=1 then
 o.tabaka=.createlayer("sagul_yazitopla",2)
 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 if

set c = nothing
 set yazi = nothing
 set o = nothing

if ruhan=0 or ruhan=2 then
 saban= round(top/gulailesi ,2)
 msgbox ("Seçilen Değerler Toplamı: "& top &chr(13)&chr(10)&" Toplam " & gulailesi & " tane seçildi." &chr(13)&chr(10)&" Ortalama= " & saban )  &chr(13)&chr(10)& "  **İlk Değer (" & BD.ValueByName("item1") & ") hesaba katılmamıştır"          ,64,"SagulCAD, Şaban GÜL"



end if

if ruhan=1 or ruhan=2 then
 set secim = .NewSelectStatus()
 set c = .newc(0,0,0)
 set yazi = .NewSelectStatus

if .SelectPoint("Nokta seç", c, 2) then
 set yaz1=.maketext(c,top,0,0,2,0,"1",.createlayer("ROL_CEPHE_1",4))
 .addobject(yaz1)
 end if

eND if

set o = nothing



eND if
 end with
 end sub
VB

netcad-yazi-deger-toplama-cikarma

17.05.2025 tarihli güncelleme ile çıkarma özelliğide gelmiştir.

' 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 secim,c,layerno,obj,yaz1,yaz2,yaz3,yaz4,top,o,sagul,sel,i,j,elifyaren ,yazi,ruhan,gulailesi ,saban,kop
 Dim BD
 with netcad
 on error resume next
 set BD = Netcad.NewBDialog(" Seçilen Objedeki Yazıları Toplama [Şaban GÜL]")

 ' Kullanıcıdan toplama için başlangıç değeri alınır
 BD.Getfloat "item1","Toplama Başlanacak İlk Değer: ",0,5
 ' Seçim türü: tek tek veya toplu
 BD.Getradio "item2","Proje Üzerindeki Seçim Türü","Tek Tek Seçim|Toplu Seçim" ,1
 ' Seçilenlerin özel tabakaya alınıp alınmayacağı
 BD.Getradio "item3","Seçilenleri SAGUL_YAZITOPLA Tabakasına Al","Evet|Hayır" ,1
 ' Sonuç gösterim tercihi
 BD.Getradio "item4","Sonuç Gösterimi","Sadece Mesaj Olarak Göster|Sonucu Ekrada Yazdır|Hem Mesaj Göster Hem Ekrana Yazdır" ,0

 if BD.showmodal then
  sagul=1
  elifyaren=1

  sagul= BD.ValueByName("item2")
  elifyaren= BD.ValueByName("item3")
  ruhan= BD.ValueByName("item4")
  gulailesi=0
  if sagul=0 then
   set secim = .NewSelectStatus()
   set c = .newc(0,0,0)

   top= BD.ValueByName("item1")
   set yazi = .NewSelectStatus

   ' Tek tek seçim döngüsü
   while .SelectObjectInstant ("Toplam yapılacak yazıları seçiniz. İşlem tamamlandıktan sonra fare ile sağ tıklayınız",1,array(otext),yazi)
    set o = yazi.objects(0)
    kop=top
    top=top+o.s

    if kop<>top then
     gulailesi=gulailesi+1
    end if

    if elifyaren=1 then
     o.tabaka=.createlayer("sagul_yazitopla",2)
    end if

    .PutObject yazi.indexs(0), o
   wend
  End if

  if sagul=1 then
   top= BD.ValueByName("item1")
   set SEL = .NewSelectionSet ' Yeni kume yarat
   set o = .NewObject
   if SEL.SELECT("Toplam Yapılacak Yazıları Seçiniz",array(otext)) 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
     kop=top
     top=top+o.s

     if kop<>top then
      gulailesi=gulailesi+1
     end if

     if elifyaren=0 then
      o.tabaka=.createlayer("sagul_yazitopla",2)
     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 if

  set c = nothing
  set yazi = nothing
  set o = nothing

  ' Mesaj kutusu ile sonuç gösterimi
  if ruhan=0 or ruhan=2 then
   saban= round(top/gulailesi ,2)
   msgbox ("Seçilen Değerler Toplamı: "& top &chr(13)&chr(10)&" Toplam " & gulailesi & " tane seçildi." &chr(13)&chr(10)&" Ortalama= " & saban ),64,", Şaban GÜL"
  end if

  ' Ekrana sonuç yazdırma
  if ruhan=1 or ruhan=2 then
   set secim = .NewSelectStatus()
   set c = .newc(0,0,0)
   set yazi = .NewSelectStatus

   if .SelectPoint("Nokta seç", c, 2) then
    set yaz1=.maketext(c,top,0,0,2,0,"1",.createlayer("SAGUL_TOPLAM",4))
    .addobject(yaz1)
   end if
  eND if

  set o = nothing
 eND if
 end with
end sub
⚠️ 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: