Exceldeki Değere Göre Netcad’de Alanları Tabakalandırma ( Excelden Tabaka Ekleme ) (Netcad Makro)

Makro Hakkında:

Excel dosyasına yazılmış kriterlere göre tabakalandırma yapılabilir. Muhtelif işlerde kullanabileceğiniz değere göre alan boyama ile exceldeki verilerinize göre tabaka değişimi yapabilirsiniz. Bunun için gereken tek ihtiyaç excelde iki sütun açmak ve birine ada_parsel no birine ise değeri yazdırmak.

Neler Yaparım ? Neler Üretirim ?

Muhtelif işlerde kullanabileceğiniz değere göre alan boyama ile exceldeki verilerinize göre tabaka değişimi yapabilirsiniz. Bunun için gereken tek ihtiyaç excelde iki sütun açmak ve birine ada_parsel no birine ise değeri yazdırmak. DİKKAT: Youtube kanalıma abone olmanızı rica ediyorum. Videolara reklam alabilirsek, buradan gelecek gelir ile özel bir internet sitesi almayı ve buradan daha profesyonel paylaşmayı hedefliyorum. Eşiniz dostunuzu haberdar edip hepinizin kanala abone olup ailemizi büyütmenizi temenni ediyorum. Tüm videolar, makrolar, yazılar ücretsizdir ve ücretsiz kalacaktır. Sizden tek ricam bu emeğimin karşığında bir kaç kişi de olsa hep birlikte kanala abone olmak, videoyu beğenmek ve yorum yazmanızdır.

Nerelerde Kullanırım ?

Coğrafi Bilgi Sisteminde Kullanabilirsiniz.

Örnek: Elimizdeki 10000 tane okulu listesi olduğunu varsayalım. Bu okullara ait üç tane kolon var diyelim. Birinci kolon: İl, İkinci kolon İlçe, Üçüncü Kolon okul adı. Netcad’de okullarım tek tabakada çevrili ve ben okulları ilçelerine göre tabakalandırmak ve renklendirmek istiyorum.Excel dosyamı modülden açarım, Parsel Adı Sütununa Okul Adı ( yani 3.kolon),  Tabakaya da ilçeyi (2.kolon) seçerim. Bunun için parsel sütununa = 3, Kriter değere 2 diyebilirim.Tabaka seçimine : Kriter değere göre tabakala diyerek tamam derim.Ardından tüm okullar ilçelerine göre tabakalandırılmış olur.

Kamulaştırma Projelerinde Kullanabilirsiniz.

Örnek: Tüm projemde B alanlarını tek tabakada çevirdim. Maliğin türüne göre renklendirmem gerekiyor. Bunu nasıl yaparım:Netcad Projenizdeki parselleri Kullanıcı tanımlı raporlar alarak veya Netkamu veya farklı modüller ile excel’e aktardım. Parsel numarasını 1. sütunda netcad otomatik yazdırdı. İkinci sütuna da ben elle veya farklı yöntemler ile malik türlerini yazdırdım diye düşünelim.Dosyamı seçtim, parsel adına 1. sütun, kriter değerim 2.sütun yazdımTabaka seçimine : Kriter değere göre tabakala diyerek tamam derim.Ardından tüm kamulaştırma alanları malik türlerine boya tabakalandırılmış ve boyanmış olur.Bunun ile ilgili örnek aşağıda verilmiştir.

Taşınmaz Mal Değerleme Projelerinde Kullanabilirsiniz.

Örnek: Parselin Net Gelir Haritasında fiyatına göre tabakalandırma ve renklendirmem gerekiyor.Netcad Projenizdeki parselleri Kullanıcı tanımlı raporlar alarak veya Netkamu veya farklı modüller ile excel’e aktardım. Parsel numarasını 1. sütunda netcad otomatik yazdırdım. İkinci sütuna da ben elle veya farklı yöntemler ile değerlerini yani fiyatlarını yazdırdım diye düşünelim. (Not: Parbis ile bunu anında yapabilirsiniz).Dosyamı seçtim, parsel adına 1. sütun, kriter değerim 2.sütun yazdımTabaka seçimine : Kriter değere göre tabakala diyerek tamam derim. Ardından tüm alanlar fiyatına göre  tabakalandırılmış ve boyanmış olur.

Yenileme,İmar Vb. Muhtelif Projelerinde Kullanabilirsiniz.

Örnek olarak vereceklerimizdeki genel mantık şudur:Netcad Projenizdeki parselleri Kullanıcı tanımlı raporlar alarak veya farklı yöntemler ile iki sütun halinde, ilk sütun parsel adı, ikinci sütun kriter değer olacak. Buna istinaden bu veriyi oluşturduktan sonra modülü açıp dosyayı yüklemek. Parbis ile binlerce veriyi tek tuş ile oluşturabilirsiniz. Bazı

• •  Örnekler;
  • Parseladı, pafta sütunu oluştururarak mesela F30-C-21-A paftasındakileri, F30-C-21-B Paftasındakileri, PAFTA-1,PAFTA-2,FOLYE-1 …vb paftalarındaki parselleri, F30-C-21-A, F30-C-21-B, PAFTA-1, PAFTA-2, FOLYE-1 …vb tabakalar oluşturup bu tabakalara alabilirim.
  • Parseladı, hesap alanı verisi alarak , excel’de formül yazarak ( bu formülle ilgili üreticiden yardım alabilirsiniz. ileti gönderiniz: sagulnet@gmail.com) alanı 0 ila 10 bin m2 olanları 0_10bin, 10 bin ila 100 bin arasını 10_100bin tabakasına, …. alabilirsiniz.
  • İmar Projelerinde veya kamulaştırma veya toplulaştırma veya herhangi uygulamada,  excelde 2. sütunda uygulamaya tamamen giren parsellere TAMAMI, kısmen girenlere KISMEN yazdırdım.( bu formülle ilgili üreticiden yardım alabilirsiniz. ileti gönderiniz: sagulnet@gmail.com). Ardından Modülü kullanarak, kısmen girenleri kısmen, tamamamen girenleri tamamen tabakasına alabilirsiniz.
  • Tarım arazileri ile ilgili bir çalışma yapıyorsunuz ve elinizde 500 bin adet parsel var. Ve bu parsellerin tarım arazisi, dere, yol, deniz vb. muhtelif bilgileri içeren bir excel tablonuz var. Bunu modül ile aktararak, tarım arazilerini TARIM, dereleri DERE, yolları YOL vb. aktarabilirsiniz.
  • Tecvizin içinde ve dışında olan parselleri haritada renklendirme usulü ile görmek istediğinizi var sayalım. Netcad Netmap modülününden parsel adı ve tecviz durumunu alabiliyorsunuz. Bu oluşturduğunuz exceli yükleyerek tecviz içindeki parselleri “TECVIZ_ICI”, dışındaki parselleri “TECVIZ_DISI” tabakasına alarak anında renklendirme yapabilirsiniz.

Örnek Görsel Uygulama:

Kamulaştırma Alanlarının Malik Türüne Göre Boyanması Örneğini Görseller ile anlatalım: Elimde aşağıdaki şekilde tek tabakada bir proje olsun. Bu proje tüm B alanları tek tabakada çevrilmiş bir projedir. Yapmak istediğim malik türlerine göre boyamak. Netcad > Parsel Editörü > Kullanıcı Tanımlı Raporlardan Excel Formatında Parselleri Aldım. Veya farklı bir yöntemle de alabilirsiniz. Bunu Parbis ile Excele Aktarımdan Sütunları parsel ve malik türü seçerek otomatik yapabilirsiniz. Karşıma gelen ekrandan dosyamı seçiyor, parsel adı sütununa 1, kriter değere 2 yazıyorum. Tamam Butonuna basıp işimi bitiyorum. Sonuç olarak karşıma gelen;

• Makroda Üzerinde Çalıştığımız Gelişmeler:
  • Tabaka özellikleri ( rengi, kilit durumu, görünürlük gibi )
• Etiketler: Basit 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, tabaka aktarma, otomatik tabakalandırma, otomatik boyama, kamulaştırma, cbs, değerleme,imar, toplulaştırma, malik türü

Uyarılar:

• Exceldeki sütun adları ile kullanıcı formundaki sütun adlarının aynı olmasına dikkat ediniz.
• Bu makro ile en fazla 50bin satır excel satırı okunabilir.
• Netcadin 256 den fazla tabaka üretemeyeceğini gözönünde bulundurunuz
• Excel dosyasındaki parsel no sütunundaki tüm parseller projenizde taranacak. Bu durumda
  • Bir parselden aynı isimli birden fazla olması durumunda tabakalandırma hatası olacağını unutmayınız
  • Tabaka isimlerinde türkçe veya özel karakter kullanmayınız ve tüm isimleri büyük harf ile yazınız.
  • Excel ile netcad projesinde eşleşmeyen alanlarda tabaka değiştirme yapılmayacaktı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 ile indir

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
 with netcad



Dim i
 dim j
 dim o
 dim SEL
 dim xls
 dim xlspath
 dim alan
 dim DEG
 dim CL
 dim bd
 DIM U,V,R,W
 dim ruhangul
 dim elifyaren
 DIM NO(50000,2)
 DEG = ""
 CL=0:U=0:R=0
 set xls = CreateObject("excel.application")







set BD = Netcad.NewBDialog("Excelden Kritere Göre Tabakalandırma [Harita Akademi, Şaban GÜL]")
 BD.GetFileName "item1","Aktarım Yapılacak Excel Dosyası Seçiniz:","","Excel Dosyalari|*.xls|Tum Dosyalar|*.*","xls"
 BD.Getcombo "item2","Parsel Numarası Hangi Sütunda Bulunuyor ? ","A|B|C|D|E|F|G|H|I|J|K|L|M|N|O|P|Q|R|S|T|U|V|W|X|Y|Z" ,0
 BD.Getcombo "item3","Tabakalandırılacak Kriter Hangi Sütunda Bulunuyor ? ","A|B|C|D|E|F|G|H|I|J|K|L|M|N|O|P|Q|R|S|T|U|V|W|X|Y|Z" ,1
 BD.Getcheck "item4","Tabakaları Gruplandır.(@...)" ,1
 BD.GetString "item5", "Grup Adı", "sagul", 5
 BD.GetString "item6", "Boş Değerlerin Alınacağı Tabaka", "BOŞ_DEĞER", 10
 if BD.showmodal then
 xlspath = BD.ValueByName("item1")
 RUHANGUL=BD.ValueByName("item4")
 elifyaren= BD.ValueByName("item5")
 else
 exit sub
 end if

dim saban,ruhan

saban= BD.ValueByName("item2")
 ruhan= BD.ValueByName("item3")

saban=1
 ruhan=2

if BD.ValueByName("item2")="A" then saban=1
 if BD.ValueByName("item2")="B" then saban=2
 if BD.ValueByName("item2")="C" then saban=3
 if BD.ValueByName("item2")="D" then saban=4
 if BD.ValueByName("item2")="E" then saban=5
 if BD.ValueByName("item2")="F" then saban=6
 if BD.ValueByName("item2")="G" then saban=7
 if BD.ValueByName("item2")="H" then saban=8
 if BD.ValueByName("item2")="I" then saban=9
 if BD.ValueByName("item2")="J" then saban=10
 if BD.ValueByName("item2")="K" then saban=11
 if BD.ValueByName("item2")="L" then saban=12
 if BD.ValueByName("item2")="M" then saban=13
 if BD.ValueByName("item2")="N" then saban=14
 if BD.ValueByName("item2")="O" then saban=15
 if BD.ValueByName("item2")="P" then saban=16
 if BD.ValueByName("item2")="Q" then saban=17
 if BD.ValueByName("item2")="R" then saban=18
 if BD.ValueByName("item2")="S" then saban=19
 if BD.ValueByName("item2")="T" then saban=20
 if BD.ValueByName("item2")="U" then saban=21
 if BD.ValueByName("item2")="V" then saban=22
 if BD.ValueByName("item2")="W" then saban=23
 if BD.ValueByName("item2")="X" then saban=24
 if BD.ValueByName("item2")="Y" then saban=25
 if BD.ValueByName("item2")="Z" then saban=26



if BD.ValueByName("item3")="A" then ruhan=1
 if BD.ValueByName("item3")="B" then ruhan=2
 if BD.ValueByName("item3")="C" then ruhan=3
 if BD.ValueByName("item3")="D" then ruhan=4
 if BD.ValueByName("item3")="E" then ruhan=5
 if BD.ValueByName("item3")="F" then ruhan=6
 if BD.ValueByName("item3")="G" then ruhan=7
 if BD.ValueByName("item3")="H" then ruhan=8
 if BD.ValueByName("item3")="I" then ruhan=9
 if BD.ValueByName("item3")="J" then ruhan=10
 if BD.ValueByName("item3")="K" then ruhan=11
 if BD.ValueByName("item3")="L" then ruhan=12
 if BD.ValueByName("item3")="M" then ruhan=13
 if BD.ValueByName("item3")="N" then ruhan=14
 if BD.ValueByName("item3")="O" then ruhan=15
 if BD.ValueByName("item3")="P" then ruhan=16
 if BD.ValueByName("item3")="Q" then ruhan=17
 if BD.ValueByName("item3")="R" then ruhan=18
 if BD.ValueByName("item3")="S" then ruhan=19
 if BD.ValueByName("item3")="T" then ruhan=20
 if BD.ValueByName("item3")="U" then ruhan=21
 if BD.ValueByName("item3")="V" then ruhan=22
 if BD.ValueByName("item3")="W" then ruhan=23
 if BD.ValueByName("item3")="X" then ruhan=24
 if BD.ValueByName("item3")="Y" then ruhan=25
 if BD.ValueByName("item3")="Z" then ruhan=26





set BD = Nothing
 xls.workbooks.open(xlspath)
 xls.range("A1").select

FOR U=1 TO 100000
 CL=CL+1
 NO(U,1)="*" & XLS.CELLS(U,saban)
 NO(U,2)= XLS.CELLS(U,ruhan)
 IF NO(U,2)="" THEN NO(U,2)=0
 IF NO(U,1)="*" THEN U=100000
 NEXT
 xls.quit





MSGBOX CL-1 & " Adet Parsel Excel Dosyasından Başarıyla Okundu. Lütfen İşlem Görecek Parselleri Seçiniz."



FOR V=1 TO CL
 Dim max,min,elif ,sabangul,tabaka
 max=255
 min=1
 Randomize
 elif=Int((max-min+1)*Rnd+min)



if elif=0 or elif=15 then elif=4
 if elif>79 and elif <96 then elif=5

with NCLayerManager



if RUHANGUL=0 then
 .Add NO(V,2), elif
 else
 .Add "@"&elifyaren,5
 .Add elifyaren & "_" & NO(V,2), elif
 end if
 END With

sabangul=0
 for tabaka = 0 to .numlayers - 1
 sabangul=sabangul+1
 next
 if sabangul>254 then
 msgbox ("Tabaka Sayısı Netcad'in Sınırını Aşmak Üzere!!" &chr(13)&chr(10)&" Lütfen projenizi inceleyiniz veya tabakaları azaltınız" ),64,"Harita Akademi, Şaban GÜL"
 msgbox ("Proje ve Veri Güvenliği İçin İşleme Devam Edilmeyecektir." &chr(13)&chr(10)&"Tabakaları azaltıp tekrar deneyiniz." ),64,"Harita Akademi, Şaban GÜL"
 exit sub
 end if

next

with Netcad
 set SEL = .NewSelectionSet
 set o = .NewObject





if SEL.SELECT("Lütfen İşlem Görecek Parselleri Seçiniz...",array(opline)) then

for i = 0 to SEL.NE-1
 j = SEL.GetSelectedObject(i, o)
 alan = o.pname

FOR V=1 TO CL
 W=NO(V,1)
 if W ="*" & alan then
 with NCLayerManager
 if RUHANGUL=0 then
 o.tabaka = .Find(NO(V,2))
 else
 o.tabaka = .Find(elifyaren & "_" & NO(V,2))
 end if

if .Find(NO(V,2))="" then
 o.tabaka=BD.ValueByName("item6")
 end if

end with
 .putobject j, o
 R=R+1
 V=U
 end if
 NEXT
 next
 SEL.RedrawAndRewind

end if



set SEL = nothing
 set o = nothing
 end with
 end with
 MSGBOX R & " adet Parselin Tabakası Değiştirildi."
 end sub