Excel ile Nokta Tabanlı Tabakalandırma Makrosu ile Verilerinizi Hızla Düzenleyin! 🚀
Organize Your Data Quickly with the Point-Based Layering Macro Using Excel!
Bu makro, Netcad kullanıcıları için geliştirilmiş güçlü bir araçtır. Excel dosyasındaki verilere dayanarak, Netcad projenizdeki nokta objelerini belirli kriterlere göre tabakalara ayırmanızı sağlar. Parsel numaraları veya diğer tanımlayıcı verileri Excel’den okuyarak, her bir nokta objesini ilgili tabakaya otomatik olarak yerleştirir. Tabakaları gruplandırma, boş değerler için özel tabaka tanımlama ve kullanıcı dostu bir arayüz ile veri yönetimini kolaylaştırır. Harita mühendisleri ve CAD kullanıcıları için zaman tasarrufu sağlayan bu makro, büyük veri kümeleriyle çalışırken hata riskini azaltır.
This macro is a powerful tool developed for Netcad users. It allows you to layer point objects in your Netcad project based on criteria defined in an Excel file. By reading parcel numbers or other identifiers from Excel, it automatically assigns each point object to the corresponding layer. Features like layer grouping, custom layers for empty values, and a user-friendly interface streamline data management. Designed for surveyors and CAD users, this macro saves time and minimizes errors when working with large datasets.
Nasıl Çalışır (How Does It Work)
Excel Dosyası Seçimi: Kullanıcı, tabakalandırma için kullanılacak Excel dosyasını seçer. Sütun Tanımlama: Parsel numarası ve tabakalandırma kriterinin bulunduğu sütunlar belirtilir (A-Z). Tabaka Gruplandırma: İsteğe bağlı olarak tabakalar bir grup adı altında toplanır (örn. @sagul). Boş Değerler: Boş kriterler için özel bir tabaka tanımlanabilir. Nokta Seçimi: Netcad projesinde işlem görecek nokta objeleri seçilir. Otomatik Tabakalandırma: Makro, Excel’deki verilere göre her noktayı ilgili tabakaya atar ve işlemi tamamlar.
Makro, Netcad’in Araçlar > Uygulama Geliştirme > Makro Çalıştır menüsünden çalıştırılır.
Excel File Selection: The user selects the Excel file to be used for layering.
Column Definition: Columns containing parcel numbers and layering criteria are specified (A-Z).
Layer Grouping: Optionally, layers can be grouped under a custom name (e.g., @sagul).
Empty Values: A custom layer can be defined for empty criteria.
Point Selection: Point objects to be processed are selected in the Netcad project.
Automatic Layering: The macro assigns each point to the appropriate layer based on Excel data and completes the process.
The macro is executed via Netcad’s Tools > Application Development > Run Macro menu.
Etiket ( Labels )
nokta tabakalandırma, excel tabakalandırma, netcad makro, harita mühendisliği, veri yönetimi, CAD otomasyonu, tabaka gruplandırma, excel entegrasyonu
point layering, excel layering, netcad macro, surveying, data management, CAD automation, layer grouping, excel integration
📝 Netcad NVB Code
' Şaban GÜL, sabangul67@gmail.com, sabangul.com
' 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
'------------------------------------------------------------------------------------------
' Şaban GÜL Tarafından Üretilmiştir. Telif hakkı gereği bu satırı ve alttaki satırları silmeyiniz.
' Bu Makro SagulCAD ile üretilmiştir. Daha fazla bilgi için www.sagul.net adresini ziyaret ediniz.
' İstediğiniz yenilikleri, tespit ettiğiniz hataları bize ileti gönderiniz. E-posta: sagulnet@gmail.com.
' Bu makro sadece Netcad üzerinden çalışır.
' Makroyu çalıştırmak için Netcad Menüsünden Araçlar >> Uygulama Geliştirme >> Makro Çalıştır menüsünden makroyu çalıştırabilirsiniz.
' sagul.net/SagulCAD adresinden daha fazla bilgi edinebilirsiniz.
'------------------------------------------------------------------------------------------
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 [ Ş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 Nokta Excel Dosyasından Başarıyla Okundu. Lütfen İşlem Görecek Noktaları 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 Noktaları Seçiniz...",array(opoint)) then ' Nokta objeleri için opoint kullanıldı
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 Noktanın Tabakası Değiştirildi."
end subnetcad-excelden-tabaka-degistir-nokta
✅ Makroyu kullanmadan önce lütfen aşağıdaki uyarıları dikkatlice okuyunuz:
• Obje sayısı yüksekse işlem uzun sürebilir ve Netcad yazılımı yanıt veremez hale gelebilir.
• Bu nedenle tüm projelerinizi önceden yedeklemeniz önemle tavsiye edilir.
• Makro çalıştıktan sonra işlemi geri almak mümkün olmayabilir.
• Makrolar periyodik olarak güncellenmektedir; sayfamızı takip ederek güncel sürümleri kullanmaya özen gösteriniz.
💾 Makrolar yalnızca Netcad yazılımında çalışır ve .nps formatında sunulur. Bu format düzenlenemez; özelleştirme talepleriniz için bizimle iletişime geçebilirsiniz.
✉️ Görüş, öneri ve hata bildirimleri için: sabangul67@gmail.com
⚙️ Bu makrolar Kadastro, 2B, Orman, Kamulaştırma, Değerleme, CBS, Halihazır Harita, İmar Planı, Etüt-Proje gibi birçok alanda kullanılabilir.
🔐 Makrolar e-posta eki veya sosyal medya üzerinden paylaşılmaz. Talepte bulunmanız durumunda yalnızca e-posta adresinize bilgilendirme yapılır. Makrolar yalnızca internet sitemiz üzerinden paylaşılır.
📥 Makroları indirerek kullanım sorumluluğunu kabul etmiş sayılırsınız. Oluşabilecek tüm sorunlar kullanıcı sorumluluğundadır.
