Tüm Objelerde / karakterini kaldırma

' 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 Sub