Ağırlık Merkezi Noktası Oluşturma Makrosu (Center of Mass Point Creation Macro)

netcad-alan-agirlik-merkezi-nokta-uret

sabangul67@gmail.com
Mayıs 17, 20255 dk okuma2 görüntülenme

Parsel Alanlarında Ağırlık Merkezi Noktası Oluşturma ve Özelleştirme Makrosu 🌟

Create and Customize Center of Mass Points for Parcel Areas


Bu makro, NetCAD yazılımında parsel alanlarının ağırlık merkezi noktalarını otomatik olarak oluşturur ve bu noktaları kullanıcı tarafından belirlenen tabakalara yerleştirir. Kullanıcı, mevcut tabakaları seçebilir veya yeni bir tabaka oluşturabilir. Ayrıca, nokta isimlerine metin ekleme, çıkarma veya olduğu gibi bırakma gibi özelleştirme seçenekleri sunar. Makro, seçilen alanların ağırlık merkezlerini hesaplar, noktalar oluşturur ve bu noktaları belirtilen tabakaya kırmızı renkte kaydeder. İşlem sonunda, üretilen nokta sayısı ve tabaka bilgisi kullanıcıya bildirilir. Harita mühendisleri için zaman tasarrufu sağlayan bu araç, parsel yönetimi ve planlama süreçlerini kolaylaştırır.

This macro automates the creation of center of mass points for parcel areas in NetCAD software, placing them in user-specified layers. Users can choose existing layers or create new ones. It offers customization options like adding, removing, or keeping point names as is. The macro calculates the center of mass for selected areas, generates points, and saves them in the chosen layer in red. Upon completion, it informs the user about the number of points created and the layer used. This tool saves time for surveyors, streamlining parcel management and planning processes.


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

  • Tabaka Seçimi: Kullanıcı, ağırlık merkezi noktalarının yazılacağı tabakayı mevcut tabakalar listesinden seçer veya yeni bir tabaka adı girer.
  • Metin Özelleştirme: Nokta isimlerine metin ekleme (başına veya sonuna), metin silme veya olduğu gibi bırakma seçenekleri sunulur. Örneğin, “PARSEL_” gibi bir metni nokta adına ekleyebilirsiniz.
  • Alan Seçimi: Kullanıcı, ağırlık merkezi noktası oluşturulacak parsel alanlarını seçer.
  • Nokta Üretimi: Makro, seçilen alanların ağırlık merkezlerini hesaplar ve her bir alan için bir nokta üretir. Noktalar, kırmızı renkte belirtilen tabakaya kaydedilir.
  • Sonuç Bildirimi: İşlem tamamlandığında, kaç nokta üretildiği ve hangi tabakaya kaydedildiği kullanıcıya bir mesaj kutusu ile bildirilir. Eğer nokta üretilemezse, hata mesajı gösterilir.
  • Layer Selection: The user selects an existing layer for the center of mass points or enters a new layer name.
  • Text Customization: Options to add text (to the start or end), remove text, or keep point names unchanged are provided. For example, you can add “PARCEL_” to point names.
  • Area Selection: The user selects the parcel areas for which center of mass points will be generated.
  • Point Generation: The macro calculates the center of mass for each selected area and creates a point. Points are saved in the specified layer in red.
  • Result Notification: Upon completion, a message box informs the user of the number of points created and the layer used. If no points are generated, an error message is displayed.


Etiket ( Labels )

Harita Mühendisliği, NetCAD Makro, Ağırlık Merkezi, Parsel Yönetimi, Otomasyon, Nokta Üretimi, Tabaka Seçimi, Metin Özelleştirme, Harita Planlama, Kadastro Çalışmaları, Parsel Analizi, NetCAD Yazılımı, Harita Otomasyonu, Ağırlık Merkezi Noktası, Parsel Numarası, Harita Verimliliği, NetCAD Programlama, Harita Mühendisleri İçin Araçlar, Otomatik Nokta Oluşturma, Tabaka Yönetimi

Surveying, NetCAD Macro, Center of Mass, Parcel Management, Automation, Point Generation, Layer Selection, Text Customization, Map Planning, Cadastre Studies, Parcel Analysis, NetCAD Software, Mapping Automation, Center of Mass Point, Parcel Number, Mapping Efficiency, NetCAD Programming, Tools for Surveyors, Automatic Point Creation, Layer Management


📝 Netcad NVB Code

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
 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]")

' Tabaka seçimi için combo box oluştur
BD1.GetCombo "tabaka", "Parsel No Hangi Tabakaya Yazılsın: ", "0", 0
 for i = 1 to .numlayers - 1
 BD1.AddCombo .LayerNameOf(i)
 next

' Mevcut tabaka veya yeni tabaka seçimi için radio button
BD2.Getradio "secim","Noktalar Hangi Tabakada Oluşturulsun?","Mevcut Tabakalar|Yeni Tabaka" ,0

' Yeni tabaka adı girişi
BD3.Getstring "yenitabaka","Yeni Tabaka Adı: ","sagul_agirlik_merkezi",50

' Metin özelleştirme seçenekleri ve metin girişi
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

' Yeni seçim kümesi ve nesne oluştur
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+1ecz
 j = SEL.GetSelectedObject(i, o) ' objeyi ve gercek indeksini al
 set p=.getplineExt(o)
 o.renk = red ' rengini kırmızı 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

' İşlem sonucu bildirimi
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
VB

netcad-alan-agirlik-merkezi-nokta-uret

Yazar

sabangul67@gmail.com

Bu yazarın yayınladığı diğer içerikleri inceleyebilirsiniz.

Tüm yazıları