AdDuzelt Prosedürü:
Eski: InStr(o.pname, ayrac) ile ilk ayraç bulunuyordu, Left(o.pname, pozisyon – 1) ile ayraçtan öncesi alınıyordu.
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 (yani birden fazla parça).
Döngüyle son parça hariç hepsi birleştirilir:
yeniAd’e her parça eklenir, parçalar arası ayrac konur.
Örnek: [\”101\”, \”1\”, \”500\”] → yeniAd = \”101/1\”.
o.pname = yeniAd: Yeni ad atanır.
Ayraç yoksa (UBound(parcalar) = 0), pname değişmez.
Mantık:
101/1/500, ayrac = \”/\” → [\”101\”, \”1\”, \”500\”] → 101/1.
PARSEL/ABC, ayrac = \”/\” → [\”PARSEL\”, \”ABC\”] → PARSEL.
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.
Ayar Dosyası:
C:\\sabangul\\NCMAKRO\\AYAR\\ayrac.txt’ye ayraç kaydedilir/okunur.
Dosya/dizin yoksa oluşturulur.
Kullanıcı yeni ayraç girerse dosya güncellenir.
Örnek Senaryolar:
pname = \”101/1/500\”, ayrac = \”/\” → pname = \”101/1\”
pname = \”PARSEL/ABC/123\”, ayrac = \”/\” → pname = \”PARSEL/ABC\”
pname = \”123-456-789\”, ayrac = \”-\” → pname = \”123-456\”
pname = \”101/1\”, ayrac = \”/\” → pname = \”101\”
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 sonraki kısmı siler (örn. 101/1/500 → 101/1) 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 En Sağdaki Karakter Öncesini Silme Makrosu
' Açıklama: Kullanıcıdan seçilen opline (alan) objelerinin pname özelliğinden, kullanıcı tarafından belirtilen bir karakterin (örn. /) en sağdaki örneğinden önceki kısmı siler. Örneğin, pname = "101/1/500" ise, en sağdaki / karakterinden önceki "101/1" silinir ve pname = "500" 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 öncesi 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 parcalar
parcalar = Split(o.pname, ayrac)
If UBound(parcalar) > 0 Then ' En az bir ayraç varsa
o.pname = parcalar(UBound(parcalar))
End If
End If
End Sub