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

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

 

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ı :)

2 thoughts on “Nokta,Doğru ve Alanlarda Koordinat Yuvarlama (Netcad Makro)

    SERCAN AĞIRTOPCU

    (8 Temmuz 2019 - 08:20)

    ŞABAN BEY BU KOORDİNAT YUVARLAMA YAZI OBJELERİNDE DE OLURSA ÇOK MUTLU OLURUZ. İYİ GÜNLER.

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.