Detaylar olacak – Türkçe
Detaylar ola
📝 Netcad NVB Code
VB
' Netcad Obje İsimlerinde Karakter Değiştirme Makrosu
' Açıklama: Tüm objelerin isimlerinde (pname) "/" karakterini siler.
' Tarih: 18 Mayıs 2025, 11:41
' Yazar: Grok 3 (xAI)
Option Explicit
' Genel hata loglama fonksiyonu
Sub LogHata(mesaj)
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists("C:\\NetcadLog") Then
fso.CreateFolder "C:\\NetcadLog"
End If
Set f = fso.OpenTextFile("C:\\NetcadLog\\makro_hata.log", 8, True)
f.WriteLine FormatDateTime(Now, vbGeneralDate) & ": " & mesaj
f.Close
Set f = Nothing
Set fso = Nothing
End Sub
' Genel mesaj gösterme fonksiyonu
Sub GosterMesaj(baslik , mesaj )
MsgBox mesaj, tip, baslik
End Sub
' Obje isimlerinde "/" karakterini silme makrosu
Sub ObjeIsimKarakterSil()
On Error Resume Next
Dim bd, i, o, degisenObjeler, hataSayisi
degisenObjeler = 0
hataSayisi = 0
With Netcad
' Diyalog penceresi oluştur
Set bd = .NewBDialog("Obje İsimlerinde Karakter Silme")
bd.PutPrompt "Tüm objelerin isimlerindeki '/' karakteri silinecek. Devam etmek istiyor musunuz?"
bd.GetCheck "onay", "İşlemi Onayla", 1
If Not bd.ShowModal Then
GosterMesaj "Bilgi", "İşlem iptal edildi.", 64
Exit Sub
End If
' Onay kontrolü
If bd.ValueByName("onay") = 0 Then
GosterMesaj "Bilgi", "İşlem kullanıcı tarafından iptal edildi.", 64
Exit Sub
End If
' Objeleri tarama ve "/" karakterini silme
.SetParam BeginBlock, True
For i = 0 To .NumObject - 1
Set o = .GetObject(i)
If InStr(o.pname, "/") > 0 Then
Dim eskiAd
eskiAd = o.pname
if o.tag=opline or o.tag=o.opoint then eskiAd = o.pname
if o.tag=otext then eskiAd = o.s
if o.tag=opline or o.tag=o.opoint then o.pname = Replace(o.pname, "/", "")
if o.tag=otext then o.s= Replace(o.s, "/", ""
.PutObject i, o
degisenObjeler = degisenObjeler + 1
End If
If Err.Number <> 0 Then
hataSayisi = hataSayisi + 1
Call LogHata("Obje " & i & " işlenirken hata: " & Err.Description)
End If
Next
.SetParam EndBlock, True
.Redraw
' Sonuç mesajı
Dim mesaj
mesaj = degisenObjeler & " objenin ismi güncellendi."
If hataSayisi > 0 Then
mesaj = mesaj & vbCrLf & hataSayisi & " hata oluştu. Detaylar için log dosyasını kontrol edin."
GosterMesaj "Bilgi", mesaj, 48
Else
GosterMesaj "Bilgi", mesaj, 64
End If
End With
' Belleği temizle
Set bd = Nothing
Set o = Nothing
End Sub
' Ana çalıştırma prosedürü
Sub Main()
On Error Resume Next
Call ObjeIsimKarakterSil
If Err.Number <> 0 Then
Call LogHata("Ana prosedürde hata: " & Err.Description)
GosterMesaj "Hata", "Bir hata oluştu. Detaylar için log dosyasını kontrol edin.", 16
End If
End SubVB