Alan İçindeki Yazıları Alan Adı Yapma Makrosu (Convert Text Inside Areas to Area Names)

Alan İsimlerini Otomatikleştirin: Netcad VBScript ile Hızlı ve Güvenilir Çözüm

Automate Area Naming: Fast and Reliable Solution with Netcad VBScript

Bu makro, Netcad yazılımında alanlar içindeki yazıları otomatik olarak alan adı (pname) olarak atar. Harita mühendisleri ve CAD kullanıcıları için zaman tasarrufu sağlar. Kullanıcı dostu bir arayüzle, alan ve yazıların bulunduğu tabakaları seçmenize olanak tanır. Ayrıca, değişen alan adlarını isteğe bağlı olarak “0_DEGISEN” adlı yeni bir tabakaya taşır. Hatalı tabaka seçimlerinde uyarı mesajları gösterir ve işlem tamamlandığında başarı bildirimi verir. Harita düzenleme süreçlerini hızlandırır ve manuel hataları en aza indirir. 🗺️

This macro automatically assigns texts within areas as area names (pname) in Netcad software. It saves time for surveyors and CAD users. With a user-friendly interface, it allows selecting layers for areas and texts. Optionally, it moves modified area names to a new layer called “0_DEGISEN.” It displays warnings for invalid layer selections and notifies users upon successful completion. It streamlines map editing and minimizes manual errors.

• Arayüz Açılır: Makro çalıştırıldığında, bir diyalog kutusu açılır. Bu kutuda, alanların ve yazıların bulunduğu tabakaları seçebilirsiniz.
• Tabaka Seçimi: Alanlar ve yazılar için doğru tabakaları listeden seçersiniz.
• Opsiyonel Ayar: Değişen alan adlarının “0_DEGISEN” tabakasına taşınmasını isteğe bağlı olarak etkinleştirebilirsiniz.
• Kontrol ve İşlem: Makro, seçilen tabakalarda alanları ve yazıları tarar. Her alanın içindeki yazıyı bulur ve bu yazıyı alanın adı olarak atar.
• Hata Yönetimi: Eğer tabaka seçilmemişse, uyarı mesajı gösterir ve işlemi durdurur.
• Tamamlama: İşlem bittiğinde, “İşlem Başarıyla Tamamlanmıştır” mesajı gösterir.

• Interface Opens: When the macro runs, a dialog box appears where you can select the layers for areas and texts.
• Layer Selection: Choose the correct layers for areas and texts from the dropdown list.
• Optional Setting: Optionally enable moving modified area names to the “0_DEGISEN” layer.
• Processing: The macro scans the selected layers, finds texts within areas, and assigns them as area names.
• Error Handling: If no layer is selected, it shows a warning and stops the process.
• Completion: Upon completion, it displays a “Process Successfully Completed” message.

Netcad makro, harita mühendisliği, alan adı otomasyonu, VBScript, CAD otomasyonu, alan içindeki yazılar, tabaka yönetimi, harita düzenleme, otomatik alan adı, Netcad yazılımı, harita optimizasyonu, mühendislik makroları, CAD verimliliği, tabaka seçimi, alan adı değiştirme, Netcad

Netcad macro, surveying, area name automation, VBScript, CAD automation, texts inside areas, layer management, map editing, automatic area naming, Netcad software, map optimization, engineering macros, CAD efficiency, layer selection, area name modification

📝 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 SAGUL_DLG,i,alanlar,yazilar,parsel,YaziYazdir,ruhan,elif,sabangul
with netcad
set SAGUL_DLG = .NewBDialog("Alan İçindeki Yazıları Alan Adı Yapma [Şaban GÜL, Harita Mühendisi]")
SAGUL_DLG.GetCombo"sagul1","Alanlar Hangi Tabakada ?", "",1
for i = 0 to .numlayers - 1
SAGUL_DLG.AddCombo .LayerNameOf(i)
next
SAGUL_DLG.GetCombo"sagul2","Yazılar Hangi Tabakada ?", "", 1
for i = 0 to .numlayers - 1
SAGUL_DLG.AddCombo .LayerNameOf(i)
next
SAGUL_DLG.Getcheck "sagul3","Alan Adı Değişenleri 0_DEGISEN tabakasına al", 0
if SAGUL_DLG.showmodal then
alanlar=SAGUL_DLG.ValueByName("sagul1")
yazilar=SAGUL_DLG.ValueByName("sagul2")

if SAGUL_DLG.ValueByName("sagul3") = 1 then
with nclayermanager
.add "0_DEGISEN",4
end with
end if
 sabangul= SAGUL_DLG.ValueByName("sagul3")
if alanlar="" then
Msgbox "Alan Tabakası Bulunamadı",0,"Dikkat!"
Exit Sub
End if
if yazilar="" then
Msgbox "Yazı Tabakası Bulunamadı" ,0,"Dikkat!"
Exit Sub
End if
' 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.

set SAGUL_DLG = Nothing
.SetFilter nothing, array(alanlar), array(opline)
for i = 0 to .numobject-1
.BackMessage
set parsel = .getobject(i) ' i. objeyi al
if parsel.tabaka=alanlar and parsel.tag = opline then 'parsel.tag = opline and 
YaziYazdir= parsel.pname
.SetMessage YaziYazdir
.SetFilter .ObjectExtends(Parsel), array(yazilar), array(otext) 
Do
set ruhan= .GetNextObject
if ruhan is nothing then
exit do
else
set elif=.GetPlineExt(parsel)
if elif.InPoly(ruhan.p1) then
parsel.pname=ruhan.s
if sabangul = 1 then
parsel.tabaka= .foundlayer("0_DEGISEN")
end if
.PutObject i, parsel
end if
end if
set ruhan = nothing 
Loop
.ResetFilter
end if
set parsel=nothing
next
.ResetFilter

msgbox"İşlem Başarıyla Tamamlanmıştır",0,"www.sabangul.com.tr"
end if
end with

END SUB

netcad-alan-adi-icindeki-yaziyi-alan-adi-yap