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