Home / Netcad Makro / Alan Köşelerini En Yakın Noktaya Taşıma Makrosu (Move Area Corners to Nearest Point Macro)

Alan Köşelerini En Yakın Noktaya Taşıma Makrosu (Move Area Corners to Nearest Point Macro)

🚀 Alan Köşelerini En Yakın Noktaya Hizalayan Güçlü Makro!


Bu makro, Netcad üzerinde çizgi veya çoklu doğru (polyline) türü objelerin köşelerini, belirtilen bir nokta tabakasına göre otomatik olarak hizalar. Kullanıcı, bir nokta tabakası ve köşesi değişecek tabakayı seçer. Makro, seçilen tabakadaki objelerin köşelerini, belirtilen yakınlık sınırı (örneğin 0.001 birim) içinde en yakın noktaya taşır. Bu işlem, özellikle parsel sınırlarının veya diğer alanların köşelerinin hassas bir şekilde hizalanması için idealdir. Kullanıcı, doğruları ve çoklu doğruları kullanma seçeneklerini belirtebilir, böylece farklı obje türleriyle esnek bir şekilde çalışabilir.

Örnek Kullanım Alanları:

  • Kadastro projelerinde parsel köşelerinin ölçüm noktalarına hizalanması.
  • Harita düzenlemelerinde objelerin hassas konumlandırılması.
  • Ölçüm verilerinin otomatik olarak çizimlere entegre edilmesi.

Nasıl Çalışır (How Does It Work)

Kullanıcı Arayüzü: Makro, bir diyalog kutusu açar ve kullanıcıdan şu bilgileri alır:

  • Nokta Tabakası: Köşelerin hizalanacağı noktaların bulunduğu tabaka (örneğin, “NOKTA”).
  • Köşesi Değişecek Tabaka: Köşeleri taşınacak objelerin bulunduğu tabaka (örneğin, “PARSEL”).
  • Yakınlık Sınırı: Köşenin taşınacağı maksimum mesafe (varsayılan: 0.001).
  • Doğruları Kullan: Çizgi objelerinin işlenip işlenmeyeceğini belirler.
  • Çoklu Doğruları Kullan: Polyline objelerinin işlenip işlenmeyeceğini belirler.

Filtreleme: Makro, belirtilen tabakalardaki noktaları ve objeleri (çizgi veya çoklu doğru) filtreler. Hizalaması:

  • Her nokta için, yakınlık sınırı içinde bulunan objeler taranır.
  • Çizgi (Line): Eğer çizginin baş veya son noktası yakınlık sınırındaysa, bu nokta ilgili ölçüm noktasına taşınır.
  • Çoklu Doğru (Polyline): Polyline’ın her köşesi kontrol edilir ve yakınlık sınırındaki köşeler ölçüm noktasına taşınır.

Sonuç: İşlem tamamlandığında, ekran yenilenir (REGEN komutu) ve değişiklikler görselleştirilir.


Etiket ( Labels )

Netcad Makro, Alan Köşesi Hizalama, Nokta Tabanlı Hizalaması, Parsel Hizalama, Çizgi Düzenleme, Polyline Düzenleme, Kadastro Otomasyonu, Harita Düzenleme, Ölçüm Noktası Hizalama, Otomatik Hizalaması, Netcad VBScript, Coğrafi Bilgi Sistemleri, CBS Otomasyonu, Parsel Köşe Düzenleme, Hassas Haritalama, Netcad Programlama, CAD Otomasyonu, Ölçüm Verisi Entegrasyonu, Harita Hizalaması, Netcad Makro Örnekleri


📝 Netcad NVB Code

VB
sub Main
  dim dialog, kayacakTabaka, noktaTabaka
  dim i, j, tab, nes, world, objNokta, objPoly, tab1, nes1
  dim dogruKullan, cokDogruKullan, yakObjUzaklik
  dim objPl, pline2, curObj, curObjPol
  dim x, y, z, c

  with Netcad
    .SetMessage "Noktalara göre objeler konumlandırılıyor" ' İşlem mesajı
    set dialog = .NewBDialog("Netcad")
    dialog.GetString "noktaTabaka", "Nokta Tabakası:", "NOKTA", 100
    dialog.GetString "kayacakTabaka", "Köşesi Değişecek Tabaka:", "PARSEL", 100
    dialog.GetFloat "uzaklik", "Yakınlık Sınırı", 0.001, 7
    dialog.GetCheck "cokluDogru", "Çoklu Doğruları Kullan", 1
    dialog.GetCheck "dogru", "Doğruları Kullan", 1

    if dialog.ShowModal then
      kayacakTabaka = dialog.ValueByName("kayacakTabaka")
      noktaTabaka = dialog.ValueByName("noktaTabaka")
      yakObjUzaklik = dialog.ValueByName("uzaklik")
      dogruKullan = dialog.ValueByName("dogru")
      cokDogruKullan = dialog.ValueByName("cokluDogru")
    else
      .BackMessage
      exit sub
    end if

    ' Nokta filtresi oluşturuluyor
    dim objTipArr(0)
    objTipArr(0) = oPoint
    set nes = .MakeFilter(objTipArr)
    dim tabArr(0)
    tabArr(0) = .FoundLayer(noktaTabaka)
    set tab = .MakeFilter(tabArr)

    ' Çizgi/çoklu doğru filtresi oluşturuluyor
    dim objTipArr1()
    redim objTipArr1(1)
    dim no
    no = 0
    if dogruKullan = 1 then
      objTipArr1(no) = oLine
      no = no + 1
    end if
    if cokDogruKullan = 1 then
      objTipArr1(no) = oPLine
    end if
    set nes1 = .MakeFilter(objTipArr1)
    dim tabArr1(0)
    tabArr1(0) = .FoundLayer(kayacakTabaka)
    set tab1 = .MakeFilter(tabArr1)

    ' Noktalar taranıyor
    set world = .NewWorld(0, 0, 0, 0)
    .SetFilter world, tab, nes
    set objNokta = .NewObject()
    while .GetNextObject2(objNokta)
      ' Nokta bulundu
      curObj = .CurObjPos()
      set world = .NewWorld(objNokta.p1.y - (yakObjUzaklik + 1), objNokta.p1.x - (yakObjUzaklik + 1), objNokta.p1.y + (yakObjUzaklik + 1), objNokta.p1.x + (yakObjUzaklik + 1))

      ' Noktaya yakın objeler taranıyor
      .SetFilter world, tab1, nes1
      set objPl = .NewObject()
      while .GetNextObject2(objPl)
        curObjPol = .CurObjPos()
        if objPl.Tag = oPLine then
          ' Çoklu doğru bulundu
          set objPoly = objPl.GetObjectAsPline()
          set pline2 = .NewPoly()
          ' Köşeler kontrol ediliyor
          for j = 0 to objPoly.Num - 1
            if NCMath.Distance(objNokta.p1, objPoly.Cor(j), false) < yakObjUzaklik then
              x = objNokta.p1.x
              y = objNokta.p1.y
            else
              x = objPoly.Cor(j).x
              y = objPoly.Cor(j).y
            end if
            z = objPoly.Cor(j).z
            set c = .NewC(y, x, z)
            pline2.AddCoor c
          next
          .PutPlineExt objPl, pline2
          .PutObject curObjPol, objPl
        elseif objPl.Tag = oLine then
          ' Çizgi bulundu
          if NCMath.Distance(objNokta.p1, objPl.p1, false) < yakObjUzaklik then
            objPl.p1.y = objNokta.p1.y
            objPl.p1.x = objNokta.p1.x
          elseif NCMath.Distance(objNokta.p1, objPl.p2, false) < yakObjUzaklik then
            objPl.p2.y = objNokta.p1.y
            objPl.p2.x = objNokta.p1.x
          end if
          .PutObject curObjPol, objPl
        end if
      wend
      .ResetFilter
    wend
    .ResetFilter
    .BackMessage
    .NetcadCommand "REGEN" ' Ekran yenileniyor
  end with
end sub
VB

netcad-objeleri-noktaya-cek

⚠️ Dikkat! Netcad Makrosu Kullanımı Hakkında Bilgilendirme

Makroyu kullanmadan önce lütfen aşağıdaki uyarıları dikkatlice okuyunuz:

• Obje sayısı yüksekse işlem uzun sürebilir ve Netcad yazılımı yanıt veremez hale gelebilir.
• Bu nedenle tüm projelerinizi önceden yedeklemeniz önemle tavsiye edilir.
• Makro çalıştıktan sonra işlemi geri almak mümkün olmayabilir.
Makrolar periyodik olarak güncellenmektedir; sayfamızı takip ederek güncel sürümleri kullanmaya özen gösteriniz.

💾 Makrolar yalnızca Netcad yazılımında çalışır ve .nps formatında sunulur. Bu format düzenlenemez; özelleştirme talepleriniz için bizimle iletişime geçebilirsiniz.

✉️ Görüş, öneri ve hata bildirimleri için: sabangul67@gmail.com

⚙️ Bu makrolar Kadastro, 2B, Orman, Kamulaştırma, Değerleme, CBS, Halihazır Harita, İmar Planı, Etüt-Proje gibi birçok alanda kullanılabilir.

🔐 Makrolar e-posta eki veya sosyal medya üzerinden paylaşılmaz. Talepte bulunmanız durumunda yalnızca e-posta adresinize bilgilendirme yapılır. Makrolar yalnızca internet sitemiz üzerinden paylaşılır.

📥 Makroları indirerek kullanım sorumluluğunu kabul etmiş sayılırsınız. Oluşabilecek tüm sorunlar kullanıcı sorumluluğundadır.
Etiketlendi: