Main Prosedürü:
Karakter Alma:
InputBox ile kullanıcıdan ayraç karakteri alınır (varsayılan: /).
Eğer kullanıcı boş girer veya iptal ederse (ayrac = \”\”), makro kapanır.
Seçim:
Array(opline) ile sadece opline objeleri seçilir.
Mesaj: “Alan objelerini seçiniz” (sade ve basit).
Döngü:
SEL.NE ile seçilen objeler taranır.
Her obje için AdDuzelt çağırılır.
PutObject ile obje güncellenir.
Ekran Güncelleme:
RedrawAndRewind ve SetCurrentWindow ile ekran yenilenir.
Temizlik:
u, SEL, o nesneleri serbest bırakılır.
AdDuzelt Prosedürü:
Kontrol: If o.Tag = opline ile sadece opline objeleri işlenir.
Ayrac Bulma:
InStr(o.pname, ayrac) ile pname’de ayraç karakterinin pozisyonu bulunur.
Eğer ayraç varsa (pozisyon > 0), Mid(o.pname, pozisyon + Len(ayrac)) ile karakterden sonrası alınır.
Örnek: pname = \”101/1\”, ayrac = \”/\” → pozisyon = 4, Mid(\”101/1\”, 4 + 1) = \”1\”.
Güncelleme: o.pname yeni değere set edilir.
Eğer ayraç yoksa, pname değişmez.
Örnek Senaryolar:
pname = \”101/1\”, ayrac = \”/\” → pname = \”1\”
pname = \”PARSEL/ABC\”, ayrac = \”/\” → pname = \”ABC\”
pname = \”123-456\”, ayrac = \”-\” → pname = \”456\”
pname = \”NOAYRAC\”, ayrac = \”/\” → Değişmez (pname = \”NOAYRAC\”).
Kullanım
Makro, seçilen objelerin pname’inden ayraçtan önceki kısmı siler ve ekranı günceller.
Netcad’de makroyu yükle (*.vbs veya *.ncm olarak).
Main prosedürünü çalıştır.
Açılan InputBox’ta ayraç karakterini gir (örn. /).
Seçim ekranında opline objelerini (alanlar, poligonlar) seç.
📝 Netcad NVB Code
' Opline Alan Adından Karakter Öncesini Silme Makrosu (Ayar Kaydetme)
' Açıklama: Kullanıcıdan seçilen opline (alan) objelerinin pname özelliğinden, kullanıcı tarafından belirtilen bir karakterden (örn. /) önceki kısmı siler. Örneğin, pname = "101/1" ise, / karakterinden önceki 101 silinir ve pname = "1" 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 pozisyon
pozisyon = InStr(o.pname, ayrac)
If pozisyon > 0 Then
o.pname = Mid(o.pname, pozisyon + Len(ayrac))
End If
End If
End Sub