Alan Adını İçindeki Noktanın Adından Alma

Netcad Alan objelerinin ( Çoklu doğruların ) adını içindeki nokta ile değiştirmek için bu yöntem kullanılabilir. Alan içinde olan noktaları alır alan adı ile değiştirir.

Videoda yazı için yapılmıştı fakat aynısı nokta için kullanılabilir.

• İşlem biraz uzun sürmektedir, lütfen mesaj alıncaya kadar bekleyiniz.
• Noktanın alan içerisinde olması şarttır.  Nokta taşıyorsa veya çok büyük boyutta yazılmışsa makro işlev görmeyebilir.
• Nokta tabakaları ve alan tabakaları ayrı veya aynı tabakalarda olabilir fakat tek tabakada olması gerekir.
• İşlemi geri almak çok uzun sürebilir. Hatta büyük boyutlu projelerde işlemi geri dahi alamayabilirsiniz.

SUB Main
Dim SAGUL_DLG,i,alanlar,yazilar,parsel,YaziYazdir,ruhan,elif,sabangul
with netcad
set SAGUL_DLG = .NewBDialog(\”Alan İçindeki Yazıları Alan Adı Yapma [Şaban GÜL, Harita Mühendisi]\”)
SAGUL_DLG.GetCombo\”sagul1\”,\”Alanlar Hangi Tabakada ?\”, \”\”,1
for i = 0 to .numlayers – 1
SAGUL_DLG.AddCombo .LayerNameOf(i)
next
SAGUL_DLG.GetCombo\”sagul2\”,\”Noktalar Hangi Tabakada ?\”, \”\”, 1
for i = 0 to .numlayers – 1
SAGUL_DLG.AddCombo .LayerNameOf(i)
next
SAGUL_DLG.Getcheck \”sagul3\”,\”Alan Adı Değişenleri 0_DEGISEN tabakasına al\”, 0
if SAGUL_DLG.showmodal then
alanlar=SAGUL_DLG.ValueByName(\”sagul1\”)
yazilar=SAGUL_DLG.ValueByName(\”sagul2\”)

if SAGUL_DLG.ValueByName(\”sagul3\”) = 1 then
with nclayermanager
.add \”0_DEGISEN\”,4
end with
end if
sabangul= SAGUL_DLG.ValueByName(\”sagul3\”)
if alanlar=\”\” then
Msgbox \”Alan Tabakası Bulunamadı\”,0,\”Dikkat!\”
Exit Sub
End if
if yazilar=\”\” then
Msgbox \”Nokta Tabakası Bulunamadı\” ,0,\”Dikkat!\”
Exit Sub
End if
\’ www.sabangul.com.tr Web Sayfasından İndirilmiştir
\’ Şaban GÜL , Harita Mühendisi
\’ Her Türlü Hata, İstek ve Öneriler İçin
\’ haritaakademi@gmail.com veya sagulnet@gmail.com
\’ adresine durumu anlatan bir e-posta gönderiniz.

set SAGUL_DLG = Nothing
.SetFilter nothing, array(alanlar), array(opline)
for i = 0 to .numobject-1
.BackMessage
set parsel = .getobject(i) \’ i. objeyi al
if parsel.tabaka=alanlar and parsel.tag = opline then \’parsel.tag = opline and
YaziYazdir= parsel.pname
.SetMessage YaziYazdir
.SetFilter .ObjectExtends(Parsel), array(yazilar), array(opoint)
Do
set ruhan= .GetNextObject
if ruhan is nothing then
exit do
else
set elif=.GetPlineExt(parsel)
if elif.InPoly(ruhan.p1) then
parsel.pname=ruhan.pname
if sabangul = 1 then
parsel.tabaka= .foundlayer(\”0_DEGISEN\”)
end if
.PutObject i, parsel
end if
end if
set ruhan = nothing 
Loop
.ResetFilter
end if
set parsel=nothing
next
.ResetFilter

msgbox\”İşlem Başarıyla Tamamlanmıştır\”,0,\”www.sabangul.com.tr\”
end if
end with

END SUB

• Makroyu kullanmadan önce açıklama ve uyarıları mutlaka okuyunuz.
• Makrolar belirli aralıklarla güncellenir. Bu Sayfayı takip etmenizi ve güncel makroları kullanmanızı tavsiye ediyoruz. Güncel makroların gelişmiş, hatalardan arındırılmış ve yeni versiyonlara uygun olacağını unutmayınız.
• Netcad Makroları Sadece Netcad Yazılımında Çalışır.
• Bu Netcad Makrosunu kullanırken lütfen Netcad projenizi yedekleyiniz.
• Bu Netcad Makroları VB Programlama dili ile yazılmıştır.
• Netcad Makrolarını kullanımından tamamen kullanıcı sorumludur. Ortaya çıkabilecek tüm hataları kabul etmiş sayılırsınız.
• Bu Netcad makrosu Kadastro, Orman, 2B,Halihazır, Kamulaştırma, Değerleme, Coğrafi Bilgi Sistemi, İmar Planı, Etüt Proje İşleri gibi bir çok alanda rahatlıkla kullanabilirsiniz.
• Makrolar ile ilgili tüm soru, görüş ve önerileriniz, ekletmek veya değiştirmek istediğiniz tüm noktalar için, yeni makrolar için bize haritaakademi@gmail.com adresine ileti göndererek ulaşınız.
• Netcad Makroları size ücretsiz sunulur ve kesinlikle eposta ekinde veya diğer sosyal medya araçları ( whastup,facebook,twitter vb. ) ile gönderilmez. Netcad makroları ile birşeyler talep ettiyseniz sizlere sadece eposta adresinize durum ile ilgili ileti gönderilir, indirme linki ve makrolar ilgili internet sayfamızda paylaşılır.
• Netcad Makrolarını .nvb formatında indirerek indirdiğiniz ortaya çıkabilecek her türlü olumsuzluğu ve cihazınıza gelebilecek tüm sorumluluğu aldığınızı belirtmek isteriz.