Alan Köşelerine Nokta Taşıma Makrosu (Point to Area Corner Relocation Macro)

Alan Köşelerine Nokta Taşıma Makrosu ile Haritalarınızı Mükemmelleştirin! 🌟

Perfect Your Maps with the Point to Area Corner Relocation Macro!

Bu makro, Netcad ortamında alan (poligon) objelerinin köşelerine yakın olan noktaları otomatik olarak tam köşe noktalarına taşıyan etkili bir araçtır. Harita düzenleme, veri temizleme ve hassas yerleştirme işlemlerinde büyük kolaylık sağlar. Kullanıcı dostu arayüzü ile noktaların bulunduğu tabakayı, alan objelerinin bulunduğu tabakayı ve tampon mesafesini seçebilirsiniz. Taşınan noktalar renk değiştirerek görsel olarak öne çıkar. Haritalarınızı daha düzenli ve profesyonel hale getirmek için ideal bir çözüm! 🛠️

This macro is an efficient tool that automatically relocates points near the corners of area (polygon) objects in Netcad to the exact corner points. It simplifies map editing, data cleaning, and precise placement tasks. With its intuitive interface, you can select the point layer, area object layer, and buffer distance. Relocated points are highlighted with a color change for easy identification. It’s the perfect solution for creating organized and professional maps!

Makro, aşağıdaki adımları izleyerek çalışır:

• Kullanıcı Arayüzü: Makro başlatıldığında, bir diyalog kutusu açılır. Bu kutuda noktaların bulunduğu tabaka, alan objelerinin bulunduğu tabaka ve tampon mesafesi (metre cinsinden) belirlenir.
• Nokta Taraması: Seçilen tabakadaki noktalar taranır ve her bir nokta için işlem yapılır.
• Köşe Hesaplama: Her nokta, belirtilen alan objesinin köşelerine olan mesafesi hesaplanarak en yakın köşeye taşınır. Bu işlem, tampon mesafesi sınırları içinde gerçekleştirilir.
• Taşıma ve Görselleştirme: Nokta, tampon mesafesi içindeyse, en yakın alan köşesine taşınır ve rengi değiştirilir (örneğin, kırmızıya).
• Sonuç: İşlem tamamlandığında, noktalar alan objelerinin köşelerine hizalanmış olur, haritanız daha temiz ve düzenli görünür.

The macro operates through the following steps:

• User Interface: When the macro is launched, a dialog box appears, allowing users to select the point layer, area object layer, and buffer distance (in meters).
• Point Scanning: Points in the specified layer are scanned, and each point is processed.
• Corner Calculation: The distance from each point to the corners of the specified area object is calculated, and the point is moved to the closest corner within the buffer distance.
• Relocation and Visualization: If the point is within the buffer distance, it is relocated to the nearest area corner, and its color is changed (e.g., to red).
• Result: Upon completion, points are aligned with the area object corners, resulting in a cleaner and more organized map.

Etiketler

Türkçe Etiketler
AlanKöşelerineNoktaTaşıma, NetcadMakro, HaritaDüzenleme, VeriTemizleme, Otomasyon, NoktaHizalama, PoligonKöşeleri, NetcadOtomasyon, HaritaTemizleme, VeriHassasiyeti, CoğrafiVeriDüzenleme, HaritaOptimizasyonu, NoktaYerleştirme, CBS, CoğrafiBilgiSistemi, HaritaVeriYönetimi, MakroKodu, NetcadVBScript, Veriİşleme, HaritaMühendisliği

PointToAreaCorner, NetcadMacro, MapEditing, DataCleaning, Automation, PointAlignment, PolygonCorners, NetcadAutomation, MapCleaning, DataPrecision, GeographicDataEditing, MapOptimization, PointPlacement, GIS, GeographicInformationSystem, MapDataManagement, MacroCode, NetcadVBScript, DataProcessing, MapEngineering

📝 Netcad NVB Code

sub Main
  dim Form
  dim i, noktaSayisi
  dim objNokta
  with Netcad
    set Form= .NewBDialog("Noktaları en yakın çizgiye taşıma") 'Kullanıcı arayüzü başlığı
    Form.GetCombo "NOKTA_TABAKA", "Noktaların bulunduğu tabaka: ", "0", 0
    for i = 1 to .Numlayers - 1
      Form.AddCombo .LayerNameOf(i)
    next
    Form.GetCombo "CIZGI_TABAKA", "Çizgilerin bulunduğu tabaka: ", "0", 0
    for i = 1 to .Numlayers - 1
      Form.AddCombo .LayerNameOf(i)
    next
    Form.GetFloat "TAMPON", "Tampon Mesafesi (Metre): ", 1, 2
.BackMessage
    if Form.ShowModal then
      set objNokta= .NewObject()
      .SetFilter nothing, array(Form.ValueByName("NOKTA_TABAKA")), array(oPoint) 'Nokta tabakası filtresi
      noktaSayisi = 0
      while .GetNextObject2(objNokta)
        noktaSayisi = noktaSayisi + 1
        NoktaCek objNokta, Form.ValueByName("CIZGI_TABAKA"), Form.ValueByName("TAMPON"), .CurObjPos
      wend
      .ResetFilter
    end if
'.BackMessage
  end with
end sub

function NoktaCek(objNokta, tabakaCizgi, Tampon, objPos)
  dim i, j, cizgiSayisi, Limit
  dim t, dx, dy, mesafe, enYakinMesafe
  dim objPLine, objCizgi
  dim pt, p1, p2, nokta, enYakinNokta
 
  with Netcad
    set pt = objNokta.p1
    set enYakinNokta = .NewC(0,0,0)
    set nokta = .NewC(0,0,0)
    set Limit = .NewWorld(pt.y-(Tampon+1), pt.x-(Tampon+1), pt.y+(Tampon+1), pt.x+(Tampon+1)) 'Tampon alanı tanımlama
    set objCizgi = .NewObject()
    .SetFilter Limit, array(tabakaCizgi), array(oPLine, oLine) 'Çizgi tabakası filtresi
    cizgiSayisi = 0
    enYakinMesafe = 100*Tampon
    while .GetNextObject2(objCizgi)
      cizgiSayisi = cizgiSayisi + 1
      '.SetMessage cizgiSayisi
      'Set objPLine = .GetPlineExt(objCizgi)
      set objPLine = objCizgi.GetObjectAsPline()
      for j = 0 to objPLine.Num - 2
        set p1 = objPLine.Cor(j)
        set p2 = objPLine.Cor(j+1)
        dx = p2.x - p1.x
        dy = p2.y - p1.y
        if (dx = 0) and (dy = 0) then
          nokta.x = p1.x
          nokta.y = p1.y
          mesafe = NCMath.Distance(pt, p1, false)
        else
          t = ((pt.x - p1.x) * dx + (pt.y - p1.y) * dy) / (dx * dx + dy * dy)
          if (t < 0) then
            nokta.x = p1.x
            nokta.y = p1.y
            mesafe = NCMath.Distance(pt, p1, false)
          else
            if (t > 1) then
              nokta.x = p2.x
              nokta.y = p2.y
              mesafe = NCMath.Distance(pt, p2, false)
            else
              nokta.x = p1.x + t * dx
              nokta.y = p1.y + t * dy
              mesafe = NCMath.Distance(pt, nokta, false)
            end if
          end if
        end if
        if (mesafe < enYakinMesafe) then
          enYakinMesafe = mesafe
          enYakinNokta.x = nokta.x
          enYakinNokta.y = nokta.y
          '.SetMessage "Girdi 1"
        end if
      next
    wend
    .ResetFilter
    '.SetMessage enYakinMesafe
    if (enYakinMesafe <= Tampon) then
      '.SetMessage enYakinNokta.x
      '.SetMessage "Girdi 1"
      objNokta.p1.x = enYakinNokta.x
      objNokta.p1.y = enYakinNokta.y
      objNokta.Renk = 2 'Taşınan noktaların rengini değiştirme
      .PutObject objPos, objNokta
    end if
  end with
end function

netcad-noktalari-objeye-cek