Alanlara Otomatik Sembol Ekle (Add Symbols To Areas)

' www.sabangul.com Web Sayfasından İndirilmiştir
' Şaban GÜL, Harita Mühendisi
' Her Türlü Hata, İstek ve Öneriler İçin
' sabangul67@gmail.com adresine durumu anlatan bir e-posta gönderiniz.
'
' Amaç: Ekrandan seçilen alan (opline) objelerinin ağırlık merkezine veya her köşesine,
' kullanıcı tarafından belirtilen tabakaya ve sembol tipiyle otomatik olarak sembol
' (opoint) objeleri ekler. Kullanıcı, sembol tipini, boyutunu, ekleme konumunu ve
' alan adını miras alma seçeneğini dialog penceresinden belirler. Kadastro, imar veya
' harita görselleştirme projelerinde işaretleme için kullanılır.

Sub Main
Dim sabangul1, sabangul2, sabangul3, sabangul4, sabangul5, sabangul6
Dim i, j, k, tabakaNo
Dim secimkumesi, obje, sembolObje, koordinatlar
Dim tabakaAdi, konum, sembolTipi, sembolBoyutu, adMiras

With Netcad
    ' Dialog penceresi oluştur
    Set sabangul1 = .NewBDialog("Alanlara Otomatik Sembol Ekleme [Şaban GÜL, sabangul.com]")
    sabangul1.PutPrompt "Seçilen alanlara sembol (nokta) objeleri eklenecektir."
    sabangul1.GetString "tabaka", "Sembollerin Yazılacağı Tabaka Adı:", "SEMBOL_NOKTALARI", 20
    sabangul1.GetRadio "konum", "Sembol Ekleme Konumu:", "Ağırlık Merkezi", 0
    sabangul1.AddRadio "Ağırlık Merkezi"
    sabangul1.AddRadio "Her Köşe"
    sabangul1.GetRadio "sembolTipi", "Sembol Tipi Seçiniz:", "Daire", 0
    sabangul1.AddRadio "Daire"
    sabangul1.AddRadio "Kare"
    sabangul1.AddRadio "Yıldız"
    sabangul1.GetFloat "boyut", "Sembol Boyutu (metre):", 0.1
    sabangul1.GetCheck "adMiras", "Alan Adını Sembollere Ata", 0
    sabangul1.PutPrompt "Boyut pozitif olmalıdır. Tabaka yoksa oluşturulur."

    ' Dialog penceresini göster
    If sabangul1.ShowModal Then
        sabangul2 = sabangul1.ValueByName("tabaka") ' Tabaka adı
        sabangul3 = sabangul1.ValueByName("konum") ' Ekleme konumu
        sabangul4 = sabangul1.ValueByName("sembolTipi") ' Sembol tipi
        sabangul5 = sabangul1.ValueByName("boyut") ' Sembol boyutu
        sabangul6 = sabangul1.ValueByName("adMiras") ' Ad miras alma
        ' Boyut kontrolü
        If sabangul5 <= 0 Then
            MsgBox "Sembol boyutu pozitif bir değer olmalıdır!", 48, "Şaban GÜL, sabangul.com"
            Exit Sub
        End If
    Else
        Exit Sub
    End If

    ' Tabaka adı boşsa varsayılan değer
    If sabangul2 = "" Then sabangul2 = "SEMBOL_NOKTALARI"
    tabakaAdi = sabangul2

    ' Tabakayı bul veya oluştur
    tabakaNo = .FoundLayer(tabakaAdi)
    If tabakaNo = -1 Then
        tabakaNo = .AddLayer(tabakaAdi) ' Yeni tabaka oluştur
        If tabakaNo = -1 Then
            MsgBox "Tabaka oluşturulamadı! İşlem iptal edildi.", 48, "Şaban GÜL, sabangul.com"
            Exit Sub
        End If
    End If

    ' Seçim kümesi ve objeler oluştur
    Set secimkumesi = .NewSelectionSet
    Set obje = .NewObject
    Set sembolObje = .NewObject

    ' Kullanıcıdan alan objelerini seçmesini iste
    If secimkumesi.Select("Sembol Eklenecek Alan Objelerini Seçiniz...", Array(opline)) Then
        sabangul6_count = 0 ' Eklenen sembol sayacı
        For i = 0 To secimkumesi.NE - 1
            j = secimkumesi.GetSelectedObject(i, obje)
            ' Sembol objesi temel ayarları
            sembolObje.type = opoint ' Nokta objesi tipi
            sembolObje.tabaka = tabakaNo ' Belirtilen tabaka
            If sabangul6 = 1 Then
                sembolObje.pname = obje.pname ' Alan adını miras al
            Else
                sembolObje.pname = "" ' Ad boş
            End If
            ' Sembol tipini ayarla
            Select Case sabangul4
                Case "Daire"
                    sembolObje.symbol = 1 ' Daire sembolü
                Case "Kare"
                    sembolObje.symbol = 2 ' Kare sembolü
                Case "Yıldız"
                    sembolObje.symbol = 3 ' Yıldız sembolü
            End Select
            sembolObje.size = sabangul5 ' Sembol boyutu

            If sabangul3 = "Ağırlık Merkezi" Then
                ' Ağırlık merkezine sembol ekle
                Set merkez = obje.Centroid
                sembolObje.x = merkez.x
                sembolObje.y = merkez.y
                .AddObject sembolObje ' Sembolü ekle
                sabangul6_count = sabangul6_count + 1
            Else
                ' Her köşeye sembol ekle
                Set koordinatlar = obje.points ' Alanın köşe koordinatları
                For k = 0 To koordinatlar.Count - 1
                    sembolObje.x = koordinatlar.Item(k).x
                    sembolObje.y = koordinatlar.Item(k).y
                    .AddObject sembolObje ' Sembolü ekle
                    sabangul6_count = sabangul6_count + 1
                Next
            End If
        Next
        secimkumesi.RedrawAndRewind ' Ekranı yenile
        MsgBox sabangul6_count & " adet sembol başarıyla eklendi." & vbCrLf & _
               "Konum: " & sabangul3 & vbCrLf & _
               "Sembol Tipi: " & sabangul4 & vbCrLf & _
               "Boyut: " & sabangul5 & " m" & vbCrLf & _
               "Tabaka: " & tabakaAdi & vbCrLf & _
               "Ad Miras: " & IIf(sabangul6 = 1, "Evet", "Hayır"), 64, "Şaban GÜL, sabangul.com"
    Else
        MsgBox "Hiçbir alan objesi seçilmedi!", 48, "Şaban GÜL, sabangul.com"
    End If

    ' Belleği temizle
    Set secimkumesi = Nothing
    Set obje = Nothing
    Set sembolObje = Nothing
    Set merkez = Nothing
    Set koordinatlar = Nothing
    Set sabangul1 = Nothing
End With
End Sub