Alan Çevresine Çit Çiz (Draw Fence Around Area)

' 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 çevresine, kullanıcı tarafından
' belirtilen mesafede ve tabakaya, seçilen çizgi tipiyle otomatik olarak çit benzeri
' bir çizgi (oline) çizer. Mesafe, tabaka ve çizgi tipi dialog penceresinden alınır.
' Kadastro, imar veya görsel düzenlemelerde parsel sınırlarını vurgulamak için kullanılır.

Sub Main
Dim sabangul1, sabangul2, sabangul3, sabangul4
Dim i, j, tabakaNo
Dim secimkumesi, obje, citObje
Dim tabakaAdi, mesafe, cizgiTipi

With Netcad
    ' Dialog penceresi oluştur
    Set sabangul1 = .NewBDialog("Alan Çevresine Çit Çizimi [Şaban GÜL, sabangul.com]")
    sabangul1.PutPrompt "Seçilen alanların çevresine belirtilen mesafede çit çizilecektir."
    sabangul1.GetFloat "mesafe", "Çit Mesafesi (metre):", 0.5
    sabangul1.GetString "tabaka", "Çitlerin Yazılacağı Tabaka Adı:", "CIT_CIZGILERI", 20
    sabangul1.GetRadio "cizgiTipi", "Çizgi Tipi Seçiniz:", "Düz Çizgi", 0
    sabangul1.AddRadio "Düz Çizgi"
    sabangul1.AddRadio "Kesikli Çizgi"
    sabangul1.PutPrompt "Mesafe pozitif olmalıdır. Tabaka yoksa oluşturulur."

    ' Dialog penceresini göster
    If sabangul1.ShowModal Then
        sabangul2 = sabangul1.ValueByName("mesafe") ' Çit mesafesi
        sabangul3 = sabangul1.ValueByName("tabaka") ' Tabaka adı
        sabangul4 = sabangul1.ValueByName("cizgiTipi") ' Çizgi tipi
        ' Mesafe kontrolü
        If sabangul2 <= 0 Then
            MsgBox "Mesafe 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 sabangul3 = "" Then sabangul3 = "CIT_CIZGILERI"
    tabakaAdi = sabangul3

    ' 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 citObje = .NewObject

    ' Kullanıcıdan alan objelerini seçmesini iste
    If secimkumesi.Select("Çit Çizilecek Alan Objelerini Seçiniz...", Array(opline)) Then
        sabangul4_count = 0 ' İşlenen obje sayacı
        For i = 0 To secimkumesi.NE - 1
            j = secimkumesi.GetSelectedObject(i, obje)
            ' Alanı belirtilen mesafede büyüt (buffer)
            Set citObje = obje.Buffer(sabangul2, 0.01) ' 0.01: hassasiyet
            citObje.type = oline ' Çizgi objesi tipi
            citObje.tabaka = tabakaNo ' Belirtilen tabaka
            ' Çizgi tipini ayarla
            If sabangul4 = "Düz Çizgi" Then
                citObje.linetype = 0 ' Düz çizgi
            Else
                citObje.linetype = 1 ' Kesikli çizgi
            End If
            .AddObject citObje ' Çiti ekle
            sabangul4_count = sabangul4_count + 1
        Next
        secimkumesi.RedrawAndRewind ' Ekranı yenile
        MsgBox "Seçilen " & sabangul4_count & " adet alanın çevresine çit çizgileri başarıyla eklendi." & vbCrLf & _
               "Mesafe: " & sabangul2 & " m" & vbCrLf & _
               "Çizgi Tipi: " & sabangul4 & vbCrLf & _
               "Tabaka: " & tabakaAdi, 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 citObje = Nothing
    Set sabangul1 = Nothing
End With
End Sub