netcad-makro

Alan Adını Parçala ve Ortasını Al

Netcadde alan adını parçalar ve ortasındaki metni alır. Mesela 101/66/A formatında birden fazla / olduğundan işlem görür ve / ile parçalanınca ortasındaki 66 kalır..

sabangul67@gmail.com
Mayıs 18, 20254 dk okuma2 görüntülenme

Güncelleme Detayları

  1. AdDuzelt Prosedürü:
    • Eski: En sağdaki ayraçtan öncesi siliniyordu (o.pname = parcalar(UBound(parcalar))).
    • Yeni:
      • parcalar = Split(o.pname, ayrac): pname’i ayraçla böler (örn. 101/1/A → [\”101\”, \”1\”, \”A\”]).
      • If UBound(parcalar) >= 2: İki veya daha fazla ayraç varsa (3 veya daha fazla parça).
      • Döngüyle 1’den sondan bir önceki parçaya kadar olanlar birleştirilir:
        • i = 1’den UBound(parcalar) – 1’e kadar.
        • Parçalar arası ayrac eklenir.
        • Örnek: [\”101\”, \”1\”, \”A\”] → yeniAd = \”1\”.
        • Örnek: [\”101\”, \”1\”, \”2\”, \”500\”] → yeniAd = \”1/2\”.
      • o.pname = yeniAd: Yeni ad atanır.
      • Ayraç yoksa (UBound(parcalar) = 0) veya tek ayraç varsa (UBound(parcalar) = 1), işlem yapılmaz.
    • Mantık:
      • 101/1/A, ayrac = \”/\” → [\”101\”, \”1\”, \”A\”] → 1.
      • 101/1/2/500, ayrac = \”/\” → [\”101\”, \”1\”, \”2\”, \”500\”] → 1/2.
      • 101/1, ayrac = \”/\” → [\”101\”, \”1\”] → İşlem yok.
      • 101, ayrac = \”/\” → [\”101\”] → İşlem yok.
  2. 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 karakterle ayırıp ortasını alalım?”.
  3. Ayar Dosyası:
    • C:\\sabangul\\NCMAKRO\\AYAR\\ayrac.txt’ye ayraç kaydedilir/okunur.
    • Dosya/dizin yoksa oluşturulur.
    • Yeni ayraç girilirse dosya güncellenir.
  4. Örnek Senaryolar:
    • pname = \”101/1/A\”, ayrac = \”/\” → pname = \”1\”
    • pname = \”PARSEL/ABC/123/XYZ\”, ayrac = \”/\” → pname = \”ABC/123\”
    • pname = \”123-456-789-000\”, ayrac = \”-\” → pname = \”456-789\”
    • pname = \”101/1\”, ayrac = \”/\” → İşlem yok (pname = \”101/1\”).
    • pname = \”101\”, ayrac = \”/\” → İşlem yok (pname = \”101\”).
    • Dosya: İlk çalıştırmada / kaydedilir, sonra InputBox varsayılan / gösterir.

Kullanım

Makro, pname’de iki veya daha fazla ayraç varsa ilk ve son ayraç arasındaki kısmı alır (örn. 101/1/A → 1), 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

VB
' Opline Alan Adından İlk ve Son Ayraç Arasını Alma Makrosu
' Açıklama: Kullanıcıdan seçilen opline (alan) objelerinin pname özelliğinde, kullanıcı tarafından belirtilen bir karakter (örn. /) iki veya daha fazla kez geçiyorsa, ilk ayraç ve öncesini, son ayraç ve sonrasını siler, sadece ortadaki kısmı bırakır. Örneğin, pname = "101/1/A" ise, ilk / ve öncesi (101), son / ve sonrası (A) silinir, pname = "1" olur. Tek ayraç veya ayraç yoksa işlem yapılmaz. 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 karakterle ayırıp ortasını alalım? (ö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, yeniAd, i
        parcalar = Split(o.pname, ayrac)
        If UBound(parcalar) >= 2 Then ' İki veya daha fazla ayraç varsa
            yeniAd = ""
            For i = 1 To UBound(parcalar) - 1
                If i > 1 Then yeniAd = yeniAd & ayrac
                yeniAd = yeniAd & parcalar(i)
            Next
            o.pname = yeniAd
        End If
    End If
End Sub
VB

Yazar

sabangul67@gmail.com

Bu yazarın yayınladığı diğer içerikleri inceleyebilirsiniz.

Tüm yazıları
Devamını Keşfet

Benzer Yazılar