Nokta,Doğru ve Alanlarda Koordinat Yuvarlama (Netcad Makro)

Makro Hakkında:

• Nokta, Doğru ve Alan objelerinde koordinatların sizin belirlediğiniz hane kadar yuvarlatılması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, noktalarda koordinat yuvarla, doğrularda koordinat yuvarla, alanlarda koordinat yuvarla,

14.02.2024 Tarihli Duyurumuz: Bu sayfadaki makrolarımız 10 yıl önce hazırlanmış olup artık desteklenmemekte ve daha geliştirilmiş versiyonu SAGULCAD modülü ile yine ücretsiz sunulmaktadır. Aşağıda verilen Bağlantılar hala çalışmaktadır fakat en geç 31.12.2025 tarihinde kaldırılması planlanmaktadır. Aynı makroyu SAGULCAD modülü içerisinde bulabileceğinizi unutmayınız. Lütfen aşağıdaki makroları kullanmayınız.

Uyarılar:

• Yapılan işlemde önceki objelerin koordinatları korunmayacaktır.
• Bu işlem seçtiğiniz tüm objelere uygulanır.
• Bu işlemi yaparak koordinatlar değişebileceğinden uzunluk, açı, alan gibi değerlerin değişebileceğini unutmayınız.
• 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.
• Bu makroda Kilitli olan tabakalardaki objelerde işlem görecektir. Bu nedenle işlem görmek istemediğiniz tabakaları kilitlemek yerine kapatınız.
• 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 BD,by ,bz
 set BD = Netcad.NewBDialog("Nokta,Doğru ve Alanlarda Koordinat Yuvarlama [Harita Akademi, Şaban GÜL]")
 BD.GetInteger "item1","Duyarlık Giriniz: ",2
 BD.GetFloat "item2","Verilen kot değerine getir (-1 Değiştirme) ",-1,3
 if BD.showmodal then
 by=BD.ValueByName("item1")
 bz=BD.ValueByName("item2")
 end if
 set BD = Nothing
 Dim i,j,o,SEL ,ad,ii,j3
 dim c1 ,x,y,y1,x1,p ,yn,xn

'işlemlerin yapıldığı bölüm



with netcad
 set SEL = .NewSelectionSet ' Seçim kümesi oluştur.
 set o = .NewObject
 if SEL.SELECT("Duyarlık değişecek objeleri seçiniz...",array(opoint,oline,opline)) then ' istenen turleri kumeye ekle
 for i = 0 to SEL.NE-1
 j = SEL.GetSelectedObject(i, o)
 'Noktalar içim
 if o.tag = 1 then
 yuvarla o.p1.y,o.p1.x,y,x,by
 o.p1.y=y
 o.p1.x=x
 end if
 'Hatlar İçin
 if o.tag = 2 and by<>-1 then
 yuvarla o.p1.y,o.p1.x,y,x,by
 o.p1.y=y
 o.p1.x=x
 yuvarla o.p2.y,o.p2.x,y,x,by
 o.p2.y=y
 o.p2.x=x
 end if
 'Çoklu doğrular için
 if o.tag = 7 and by<>-1 then
 set p = .getplineext(o)
 for j3 = 0 to p.num-1
 y1= p.cor(j3).y
 x1= p.cor(j3).x
 yuvarla y1,x1,y,x,by
 p.cor(j3).y=y
 p.cor(j3).x=x
 if bz<>-1 then
 p.cor(j3).z=bz 'isteğe bağlı
 end if
 next
 .putplineext o,p
 end if
 o.renk = yellow
 .PutObject J, o
 NEXT
 SEL.RedrawAndRewind
 set o = nothing
 END if
 set SEL = nothing
 set o = nothing
 end with
 end sub







sub yuvarla(ys,xs,c,d,k)
 c= formatnumber(ys,k ,,,0)
 d= formatnumber(xs,k ,,,0)
 end sub