Koordinat Yuvarlama Makrosu(Coordinate Rounding Macro) – Proje İki Hane Çevir

Nokta, Doğru ve Alan Koordinatlarını Hızlıca Yuvarlayın! 🚀

Quickly Round Coordinates for Points, Lines, and Polygons!

Bu makro, Netcad yazılımında kullanılan bir VBScript betiğidir ve koordinat yuvarlama işlemlerini kolaylaştırır. Nokta, doğru ve çoklu doğruların koordinatlarını (x, y ve isteğe bağlı z) kullanıcı tarafından belirlenen duyarlılık seviyesine göre yuvarlar. Ayrıca, kot (z) değerlerini sabit bir değere getirme seçeneği sunar. İşlemler sonucunda objeler sarı renge boyanarak görsel olarak ayırt edilir. Harita mühendisleri ve CAD kullanıcıları için zaman kazandıran, hassasiyet artıran bir araçtır.

This macro is a VBScript designed for Netcad software, simplifying coordinate rounding tasks. It rounds the coordinates (x, y, and optionally z) of points, lines, and polylines to a user-specified precision level. It also allows setting elevation (z) values to a fixed number. Processed objects are highlighted in yellow for easy identification. It’s a time-saving, precision-enhancing tool for surveyors and CAD users.

• Giriş Paneli: Makro çalıştırıldığında, kullanıcıdan bir duyarlılık değeri (örneğin, 2 ondalık basamak) ve isteğe bağlı bir kot (z) değeri istenir. Kot değeri için -1 girilirse, z değeri değiştirilmez. Seçim Kümesi: Kullanıcı, koordinatları yuvarlanacak nesneleri (nokta, doğru veya çoklu doğru) seçer. Yuvarlama İşlemi:
• Noktalar: X ve Y koordinatları belirtilen duyarlılığa yuvarlanır.
• Doğrular: Başlangıç ve bitiş noktalarının X ve Y koordinatları yuvarlanır.
• Çoklu Doğrular: Her bir köşe noktası için X, Y ve isteğe bağlı Z koordinatları yuvarlanır.
• Görsel İşaretleme: İşlem yapılan objeler sarı renge boyanır ve ekran güncellenir. Hata Yönetimi: Makro, kullanıcı dostu bir arayüzle çalışır ve seçim yapılmazsa işlem sonlanır.

• Input Dialog: When the macro runs, it prompts the user to enter a precision level (e.g., 2 decimal places) and an optional elevation (z) value. Entering -1 for z leaves it unchanged.
• Selection Set: The user selects objects (points, lines, or polylines) to round coordinates for.
• Rounding Process:
• Points: X and Y coordinates are rounded to the specified precision.
• Lines: X and Y coordinates of start and end points are rounded.
• Polylines: X, Y, and optionally Z coordinates of each vertex are rounded.
• Visual Feedback: Processed objects are colored yellow, and the screen is refreshed.
• Error Handling: The macro features a user-friendly interface and terminates gracefully if no objects are selected.

koordinat yuvarlama, Netcad makro, VBScript, harita mühendisliği, CAD otomasyon, koordinat düzenleme, hassasiyet ayarı

coordinate rounding, Netcad macro, VBScript, surveying, CAD automation, coordinate editing, precision adjustment

📝 Netcad NVB Code

' 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 [SAGULCAD]")
 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çin
 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

netcad-projeyi-iki-hane-cevir