Makro Hakkında:

  • Netcad projenize toplu tabaka eklemeye yarar.
  • @tanım ile bir grup ismi verip 10’a kadar tabakayı bu gruba bağlı ekleyebilirsiniz.
  • Tanımlı Tabaka Grubu ile sistemde tanımlı şablonları otomatik yükleyebilirsiniz.
  • Not defterine yazdığınız altalta yazıları tabaka olarak yükler
  • Netcad Tabaka yöneticisinden kaydedilen LYR dosyasını yükler
  • Üst Düzey Makro Sınıfındadır.
  • Makroda Üzerinde Çalıştığımız Gelişmeler:
    • Excelden okuma özelliği eklenecek
    • Şablon özelliği eklenecek
  • Etiketler: Orta düzey makro, Netcad, Makro, Pratik Netcad, Netcad Araçları, Netcad tabaka, netcad seçim, Pratik Netcad, Netcadde nasıl yapılır,netcad menü, netcad araç, nvb, ücretsiz makro, harita makro,toplu tabaka, tabaka ekle, tabaka adı

14.02.2024 Tarihli Duyurumuz: Bu sayfadaki makrolarımız 10 yıl önce hazırlanmış olup artık desteklenmemekte ve daha geliştirilmiş versiyonu SAGULCAD modülü ile yine ücretsiz sunulmaktadır. Aşağıda verilen Bağlantılar hala çalışmaktadır fakat en geç 31.12.2025 tarihinde kaldırılması planlanmaktadır. Aynı makroyu SAGULCAD modülü içerisinde bulabileceğinizi unutmayınız. Lütfen aşağıdaki makroları kullanmayınız.

Uyarılar:

  • Yüklenen tabakaların ismi en fazla 20 karakter olabilir ( Netcad kaynaklı )
  • Netcad ile en fazla 256 tabaka üretilir.
  • LYR ve TXT yüklemeleri için yüklenecek dosyanın açık olmamasına dikkat ediniz.
  • Tanımlı tabaka seçiminde @TANIM otomatik oluşturulup girilen tüm tabaka isimleri @TANIM_….formatında olacaktır.
  • Netcad makrolarında hiçbir metni veya karakteri değiştirmeyiniz. Aksi halde makro işlevsiz hale gelebilir veya hatalı işlev ile karşılaşabilirsiniz.

İndirme Linkleri:

İndirme Linki-1: Google Drive ( Harita Akademi )

Makro Açık Kaynak Kodu:

'' 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.

Sub Main
 Dim i
 Dim Bd ,bd0,bd1,bd2
 dim sagul ,ruhan
 Dim Satir ,c1 ,o ,SGL
 Const ForReading = 1, ForWriting = 2, ForAppending = 8
 dim fso,f,listx ,fi
 Dim Line
 With Netcad

with NCLayerManager



set BD = Netcad.NewBDialog("Toplu Tabaka Adı Girişi")
 BD.Getradio "item1","Bir Yöntem Seçiniz","@TANIM Girip Bağlı 10'a Kadar Tabaka Girişi|Tanımlı Tabaka Grubu Girişi|Not Defterinden Alım|LYR Dosyasından Alım" ,0



if BD.SHOWMODAL then
 sagul=BD.ValueByName("item1")
 else
 exit sub
 end if



if sagul=0 then
 set BD0 = Netcad.NewBDialog("Toplu Tabaka Adı Girişi [Harita Akademi, Şaban GÜL]")
 BD0.GetString "item","Grup Adı Giriniz: (Enfazla 9 karakter)","SAGUL",9
 BD0.PutPrompt "Yukarıda Girdiniğiniz Grup @ ile grup yapılacak ve aşağıdakiler yazılacak."
 BD0.PutPrompt "Örneğin KAD yazdığınızda @KAD açılıp @KAD_TAB1, @KAD_TAB2 .. açılır"
 BD0.PutPrompt "______________________________________________________________"
 BD0.GetString "item1","1. Tabaka Adı","",10
 BD0.GetString "item2","2. Tabaka Adı","",10
 BD0.GetString "item3","3. Tabaka Adı","",10
 BD0.GetString "item4","4. Tabaka Adı","",10
 BD0.GetString "item5","5. Tabaka Adı","",10
 BD0.GetString "item6","6. Tabaka Adı","",10
 BD0.GetString "item7","7. Tabaka Adı","",10
 BD0.GetString "item8","8. Tabaka Adı","",10
 BD0.GetString "item9","9. Tabaka Adı","",10
 BD0.GetString "item10","10. Tabaka Adı","",10

if BD0.SHOWMODAL then
 .Add "@" & BD0.ValueByName("item"),3
 if BD0.ValueByName("item1")<>"" then .Add BD0.ValueByName("item1"),1
 if BD0.ValueByName("item2")<>"" then .Add BD0.ValueByName("item2"),2
 if BD0.ValueByName("item3")<>"" then .Add BD0.ValueByName("item3"),3
 if BD0.ValueByName("item4")<>"" then .Add BD0.ValueByName("item4"),4
 if BD0.ValueByName("item5")<>"" then .Add BD0.ValueByName("item5"),5
 if BD0.ValueByName("item6")<>"" then .Add BD0.ValueByName("item6"),6
 if BD0.ValueByName("item7")<>"" then .Add BD0.ValueByName("item7"),7
 if BD0.ValueByName("item8")<>"" then .Add BD0.ValueByName("item8"),8
 if BD0.ValueByName("item9")<>"" then .Add BD0.ValueByName("item9"),9
 if BD0.ValueByName("item10")<>"" then .Add BD0.ValueByName("item10"),10
 else
 exit sub
 end if
 end if

if sagul=1 then
 set BD1 = Netcad.NewBDialog("Toplu Tabaka Adı Girişi [Harita Akademi, Şaban GÜL] ")
 BD1.PutPrompt "Yukarıda Girdiniğiniz Grup @ ile grup yapılacak ve aşağıdakiler yazılacak."
 BD1.Getradio "item1","Bir Yöntem Seçiniz","@KAD,KAD_ADA,KAD_PARSEL,KAD_PAFTA|@PLAN,@PLAN_KUZEY...|@KAMU,KAMU_A,KAMU_B,KAMU_C|@TRM,TRM_SAHIS,TRM_MALIYE,TRM_ORMAN|@2B,2B_NOKTA,2B_CIZGI" ,0
 if BD1.SHOWMODAL then
 if BD1.ValueByName("item1")=0 THEN
 .Add "@KAD",1
 .Add "KAD_ALAN",2
 .Add "KAD_CIZGI",3
 .Add "KAD_YAZI",4
 .Add "KAD_ADA",5
 .Add "KAD_PARSEL",6
 .Add "KAD_NO_ADA",7
 .Add "KAD_NO_PARSEL",8
 .Add "KAD_DETAY",9
 .Add "KAD_NADI",10
 .Add "KAD_MEVKII",11
 .Add "KAD_MALIK",12
 .Add "KAD_GS",12
 .Add "KAD_GS_NOKTA",12
 END if



if BD1.ValueByName("item1")=1 THEN
 .Add "@PLAN",1
 .Add "PLAN_KUZEY",2
 .Add "PLAN_CIZGI", 3
 .Add "PLAN_LEJANT", 4
 .Add "PLAN_ANTET", 5
 .Add "PLAN_ILILCE", 6
 .Add "PLAN_ACIKLAMA", 7
 .Add "PLAN_TABLO", 8
 .Add "PLAN_YAZI", 9
 END if

if BD1.ValueByName("item1")=2 THEN
 .Add "@KAMU",1
 .Add "KAMU_ALAN",2
 .Add "KAMU_KOMSU", 3
 .Add "KAMU_SINIR", 4
 .Add "KAMU_A", 5
 .Add "KAMU_B", 6
 .Add "KAMU_C", 7
 .Add "KAMU_ESKI", 8
 .Add "KAMU_IRT", 9

END if

if BD1.ValueByName("item1")=3 THEN
 .Add "@TRM",1
 .Add "TRM_SAHIS",2
 .Add "TRM_MALIYE", 3
 .Add "TRM_ORMAN", 4
 .Add "TRM_MERA", 5
 .Add "TRM_YOL", 6
 .Add "TRM_DERE", 7
 .Add "TRM_ESKI", 8
 .Add "TRM_TUZEL", 9
 .Add "TRM_DAVALI", 10
 END if



if BD1.ValueByName("item1")=4 THEN
 .Add "@2B",1
 .Add "2B_CIZGI",2
 .Add "2B_NOKTA", 3
 .Add "2B_ALAN", 4
 .Add "2B_ELGPS", 5
 .Add "2B_ARAZI", 6
 .Add "2B_MALIK", 7
 .Add "2B_NOT", 8
 END if
 END if
 end if

if sagul=2 then
 Msgbox "Bu menü sadece Uzman Kullanıcı Grupları tarafından açılabilir."



end if

if sagul=3 then
 ' Msgbox "Bu menü sadece Uzman Kullanıcı Grupları tarafından açılabilir."
 set SGL = Netcad.NewBDialog("Tapu Alanı Doldur...")
 SGL.GetFileName "item7","Text Dosyasını Seçiniz...","","Text Dosyalari|*.txt|Tum Dosyalar|*.*","txt"
 if SGL.showmodal then
 SAGUL = SGL.ValueByName("item7")
 else
 exit sub
 end if



Set fso = CreateObject("Scripting.FileSystemObject")
 Set f = fso.OpenTextFile(SAGUL, ForReading, True)
 Set listx = CreateObject("System.Collections.ArrayList")

Do While Not f.AtEndOfStream
 Line = f.readline
 listx.add line
 Loop
 f.Close
 for fi=0 to listx.count- 1
 with NCLayerManager
 .Add listx(fi),fi+1
 end with
 next
 end if

if sagul=4 then
 ' Msgbox "Bu menü sadece Uzman Kullanıcı Grupları tarafından açılabilir."
 set SGL = Netcad.NewBDialog("Tapu Alanı Doldur...")
 SGL.GetFileName "item7","LYR Dosyasını Seçiniz...","","LYR Dosyalari|*.LYR|Tum Dosyalar|*.*","LYR"
 if SGL.showmodal then
 SAGUL = SGL.ValueByName("item7")
 else
 exit sub
 end if



Set fso = CreateObject("Scripting.FileSystemObject")
 Set f = fso.OpenTextFile(SAGUL, ForReading, True)
 Set listx = CreateObject("System.Collections.ArrayList")

Do While Not f.AtEndOfStream
 Line = f.readline
 line=replace(line," ","")
 line=replace(line," ","")
 line=replace(line," ","")
 line=replace(line," ","")
 line=replace(line," ","")

if mid(line,1,11)="<LayerName>" then

line=replace(line,"<LayerName>","")
 line=replace(line,"</LayerName>","")
 listx.add line
 end if
 Loop
 f.Close
 for fi=0 to listx.count- 1
 with NCLayerManager
 .Add listx(fi),fi+1
 end with
 next



end if



end with
 end with



End Sub

 
Category
Tags

No responses yet

Bir yanıt yazın

E-posta adresiniz yayınlanmayacak. Gerekli alanlar * ile işaretlenmişlerdir