Tabaka Adını Obje Adına Çeviren Makro (Layer Name to Object Name Macro)

NetCAD ile Alan Objelerinde Tabaka Adını Otomatik Alan Adı Yapın: Hızlı ve Kolay Çözüm! 🛠️

Automate Setting Layer Name as Field Name for Area Objects in NetCAD: Fast and Easy Solution! 🛠️

Bu makro, NetCAD ortamında seçilen alan (poligon) objelerinin alan adını, objelerin bulunduğu tabaka adıyla otomatik olarak eşitlemek için tasarlanmıştır. Özellikle büyük projelerde, alan objelerinin düzenli ve tabaka adlarıyla uyumlu olmasını sağlamak için idealdir. Kullanıcı, çizimde istediği alan objelerini seçer ve makro, her bir objenin alan adını otomatik olarak o objenin tabaka adına göre günceller. Bu, veri düzenini korur, manuel düzenleme süreçlerini ortadan kaldırır ve projelerinizi daha hızlı tamamlamanıza olanak tanır. 🗂️ Hata kontrolleriyle güvenli bir şekilde çalışır ve yalnızca geçerli alan objelerini işler.

This macro is designed to automatically set the field name of selected area (polygon) objects in NetCAD to match their layer name. It’s perfect for large projects where maintaining consistency between area objects and layer names is crucial. The user selects the desired area objects in the drawing, and the macro updates each object’s field name to match its layer name. This ensures data organization, eliminates manual editing, and helps complete projects faster. 🗂️ It includes error checks for safe operation and processes only valid area objects.

Makro, NetCAD’in VBScript otomasyon özelliklerini kullanır. İlk olarak, kullanıcıdan çizimde alan objelerini seçmesi istenir. Seçilen objeler bir döngüyle taranır ve her bir objenin tipi kontrol edilir (yalnızca alan objeleri işlenir). Ardından, objenin bulunduğu tabakanın adı alınır ve bu isim, objenin alan adı (field name) olarak atanır. Eğer seçimde alan objesi yoksa veya başka bir hata oluşursa, kullanıcıya bilgilendirici bir mesaj gösterilir. Makro, NetCAD’in COM tabanlı nesne modelini kullanarak tabaka ve obje bilgilerine erişir, böylece hızlı ve hatasız bir işlem sağlar. ⚙️

The macro leverages NetCAD’s VBScript automation capabilities. It first prompts the user to select area objects in the drawing. The selected objects are iterated through, and their type is checked (only area objects are processed). The name of the layer each object belongs to is retrieved, and this name is set as the object’s field name. If no area objects are selected or an error occurs, an informative message is displayed to the user. The macro uses NetCAD’s COM-based object model to access layer and object information, ensuring fast and error-free operation. ⚙️

alan objesi, tabaka adı, alan adı, NetCAD makro, VBScript otomasyon, çizim düzenleme, poligon yönetimi, otomatik güncelleme, NetCAD VBScript, proje organizasyonu, veri düzeni

area object, layer name, field name, NetCAD macro, VBScript automation, drawing editing, polygon management, automatic update, NetCAD VBScript, project organization, data arrangement

📝 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.
'
' Amaç: Ekrandan seçilen alan (opline) objelerinin adlarını, objelerin bulunduğu
' tabaka adıyla değiştirir. Örneğin, obje adı 101_1 ve tabaka KADASTRO_ALAN ise,
' obje adı KADASTRO_ALAN olur.

Sub Main
Dim sabangul1, sabangul2
Dim i, j
Dim secimkumesi, obje

With Netcad
    ' Dialog penceresi oluştur
    Set sabangul1 = .NewBDialog("Alan Adlarını Tabaka Adına Göre Değiştirme")
    sabangul1.PutPrompt "Seçilen alan obje adı, tabaka adlarıyla değiştirilecektir."
    sabangul1.PutPrompt "Devam etmek için Tamam butonuna basınız."

    ' Dialog penceresini göster
    If sabangul1.ShowModal Then
    Else
        Exit Sub
    End If

    ' Seçim kümesi ve obje oluştur
    Set secimkumesi = .NewSelectionSet
    Set obje = .NewObject

    ' Kullanıcıdan alan objelerini seçmesini iste
    If secimkumesi.Select("Tabaka Adına Göre Değiştirilecek Alan Objelerini Seçiniz...", Array(opline)) Then
        For i = 0 To secimkumesi.NE - 1
            j = secimkumesi.GetSelectedObject(i, obje)
            sabangul2 = .LayerNameOf(obje.tabaka) ' Objeye ait tabaka adını al
            obje.pname = sabangul2 ' Obje adını tabaka adıyla değiştir
            .PutObject j, obje ' Objeyi güncelle
        Next
        secimkumesi.RedrawAndRewind ' Ekranı yenile
 
    Else
        MsgBox "Hiçbir alan objesi seçilmedi!", 48, "Harita Akademi, Şaban GÜL"
    End If

    ' Belleği temizle
    Set secimkumesi = Nothing
    Set obje = Nothing
    Set sabangul1 = Nothing
End With
End Sub