AdDuzelt Prosedürü:
Eski: Split ile parçalara ayrılan pname’de son parça hariç hepsi birleştiriliyordu (örn. 101/1/500 → 101/1).
Yeni:
parcalar = Split(o.pname, ayrac): pname’i ayraçla böler (örn. 101/1/500 → [“101”, “1”, “500”]).
If UBound(parcalar) > 0: En az bir ayraç varsa.
o.pname = parcalar(UBound(parcalar)): Sadece son parça alınır (örn. 500).
Ayraç yoksa (UBound(parcalar) = 0), pname değişmez.
Mantık:
101/1/500, ayrac = “/” → [“101”, “1”, “500”] → 500.
PARSEL/ABC, ayrac = “/” → [“PARSEL”, “ABC”] → ABC.
NOAYRAC, ayrac = “/” → Değişmez.
Main Prosedürü:
Tamamen aynı:
InputBox ile ayraç alınır, varsayılan C:\sabangul\NCMAKRO\AYAR\ayrac.txt’den.
Ayraç dosyaya kaydedilir.
Array(opline) ile opline objeleri seçilir.
Mesaj: “Alan objelerini seçiniz”.
SEL.NE, GetSelectedObject, PutObject, RedrawAndRewind, SetCurrentWindow değişmedi.
InputBox mesajı güncellendi: “Hangi karakterden öncesi silinsin?”.
Ayar Dosyası:
C:\sabangul\NCMAKRO\AYAR\ayrac.txt’ye ayraç kaydedilir/okunur.
Dosya/dizin yoksa oluşturulur.
Yeni ayraç girilirse dosya güncellenir.
Örnek Senaryolar:
pname = “101/1/500”, ayrac = “/” → pname = “500”
pname = “PARSEL/ABC/123”, ayrac = “/” → pname = “123”
pname = “123-456-789”, ayrac = “-” → pname = “789”
pname = “101/1”, ayrac = “/” → pname = “1”
pname = “NOAYRAC”, ayrac = “/” → Değişmez.
Dosya: İlk çalıştırmada / kaydedilir, sonra InputBox varsayılan / gösterir.
Kullanım
Makro, pname’den en sağdaki ayraçtan önceki kısmı siler (örn. 101/1/500 → 500) ve ekranı günceller.
Netcad’de makroyu yükle (*.vbs veya *.ncm olarak).
Main prosedürünü çalıştır.
InputBox açılır:
İlk çalıştırmada varsayılan /, sonraki çalıştırmalarda C:\sabangul\NCMAKRO\AYAR\ayrac.txt’den okunan değer.
Yeni ayraç girersen (örn. -), dosya güncellenir.
İptal edersen makro kapanır.
Seçim ekranında opline objelerini (alanlar, poligonlar) seç.
Detaylar ola
📝 Netcad NVB Code
' Opline Alan Adından Karakter Sonrasını Silme Makrosu
' Açıklama: Kullanıcıdan seçilen opline (alan) objelerinin pname özelliğinden, kullanıcı tarafından belirtilen bir karakterden (örn. /) sonraki kısmı siler. Örneğin, pname = "101/1" ise, / karakterinden sonraki 1 silinir ve pname = "101" olur. Ayraç karakteri C:\sabangul\NCMAKRO\AYAR\ayrac.txt dosyasına kaydedilir ve sonraki çalıştırmalarda buradan okunur.
' Yazar: Şaban Gül
' Tarih: 18 Mayıs 2025
Option Explicit
Sub Main
Dim i, j, o, SEL, u, ayrac, fso, dosya, dosyaYolu
Const AYAR_DIZINI = "C:\sabangul\NCMAKRO\AYAR"
Const AYAR_DOSYASI = "ayrac.txt"
dosyaYolu = AYAR_DIZINI & "\" & AYAR_DOSYASI
With Netcad
' Dosya sistemi nesnesi oluştur
Set fso = CreateObject("Scripting.FileSystemObject")
' Ayar dosyasını oku
ayrac = "/"
If fso.FileExists(dosyaYolu) Then
Set dosya = fso.OpenTextFile(dosyaYolu, 1) ' 1 = okuma
If Not dosya.AtEndOfStream Then
ayrac = dosya.ReadLine
End If
dosya.Close
End If
' Kullanıcıdan ayracı al (varsayılan: dosya veya /)
ayrac = InputBox("Hangi karakterden sonrası silinsin? (örn. /)", "Karakter Seçimi", ayrac)
If ayrac = "" Then Exit Sub ' Boş veya iptal edilirse çık
' Ayar dosyasını güncelle
If Not fso.FolderExists(AYAR_DIZINI) Then
fso.CreateFolder AYAR_DIZINI
End If
Set dosya = fso.CreateTextFile(dosyaYolu, True) ' True = üzerine yaz
dosya.WriteLine ayrac
dosya.Close
Set SEL = .NewSelectionSet
Set o = .NewObject
If SEL.Select("Alan objelerini seçiniz", Array(opline)) Then
For i = 0 To SEL.NE - 1
j = SEL.GetSelectedObject(i, o)
AdDuzelt o, ayrac
.PutObject j, o
Next
SEL.RedrawAndRewind
Set u = .GetCurrentWindow
.SetCurrentWindow u, 1
End If
Set u = Nothing
Set SEL = Nothing
Set o = Nothing
Set fso = Nothing
Set dosya = Nothing
End With
End Sub
Sub AdDuzelt(o, ayrac)
If o.Tag = opline Then ' Sadece opline objeleri için çalış
Dim pozisyon
pozisyon = InStr(o.pname, ayrac)
If pozisyon > 0 Then
o.pname = Left(o.pname, pozisyon - 1)
End If
End If
End Sub✅ Makroyu kullanmadan önce lütfen aşağıdaki uyarıları dikkatlice okuyunuz:
• Obje sayısı yüksekse işlem uzun sürebilir ve Netcad yazılımı yanıt veremez hale gelebilir.
• Bu nedenle tüm projelerinizi önceden yedeklemeniz önemle tavsiye edilir.
• Makro çalıştıktan sonra işlemi geri almak mümkün olmayabilir.
• Makrolar periyodik olarak güncellenmektedir; sayfamızı takip ederek güncel sürümleri kullanmaya özen gösteriniz.
💾 Makrolar yalnızca Netcad yazılımında çalışır ve .nps formatında sunulur. Bu format düzenlenemez; özelleştirme talepleriniz için bizimle iletişime geçebilirsiniz.
✉️ Görüş, öneri ve hata bildirimleri için: sabangul67@gmail.com
⚙️ Bu makrolar Kadastro, 2B, Orman, Kamulaştırma, Değerleme, CBS, Halihazır Harita, İmar Planı, Etüt-Proje gibi birçok alanda kullanılabilir.
🔐 Makrolar e-posta eki veya sosyal medya üzerinden paylaşılmaz. Talepte bulunmanız durumunda yalnızca e-posta adresinize bilgilendirme yapılır. Makrolar yalnızca internet sitemiz üzerinden paylaşılır.
📥 Makroları indirerek kullanım sorumluluğunu kabul etmiş sayılırsınız. Oluşabilecek tüm sorunlar kullanıcı sorumluluğundadır.
