Netcad Alan Objesi ( Çoklu Doğru ) İçindeki Yazıyı Alan Adı Yapma

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

• İşlem biraz uzun sürmektedir, lütfen mesaj alıncaya kadar bekleyiniz.
• Yazının alan içerisinde olması şarttır.  Yazı taşıyorsa veya çok büyük boyutta yazılmışsa makro işlev görmeyebilir.
• Yazı 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″,”Yazılar 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 “Yazı 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(otext)
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.s
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.