Excel ile Çoklu Doğru Tabakalandırma: Otomatik ve Hızlı Çözüm 🚀
Automated and Fast Parcel Layering Solution with Excel
Bu makro, Netcad kullanıcıları için Excel dosyalarındaki verilere göre parselleri otomatik olarak tabakalara ayırmak için tasarlanmıştır. Harita mühendisleri ve CAD kullanıcıları için büyük bir zaman tasarrufu sağlar. Excel dosyasındaki parsel numaraları ve kriter sütunlarını okuyarak, parselleri belirtilen kriterlere göre tabakalara atar. Örneğin, bir Excel tablosunda parsel numaraları ve her parsele atanacak tabaka isimleri yer alıyorsa, bu makro parselleri otomatik olarak ilgili tabakalara taşır. Ayrıca, tabakaları gruplandırma seçeneği sunar ve boş değerler için varsayılan bir tabaka tanımlama imkanı sağlar. Lisans kontrolü ile korunan bu makro, yalnızca lisanslı kullanıcılar tarafından çalıştırılabilir.
This macro is designed for Netcad users to automatically layer parcels based on data from an Excel file. It saves significant time for surveyors and CAD users. By reading parcel numbers and criteria columns from an Excel file, it assigns parcels to layers based on the specified criteria. For instance, if an Excel sheet contains parcel numbers and corresponding layer names, the macro automatically moves the parcels to those layers. It also offers the option to group layers and define a default layer for empty values. Protected by a license check, this macro can only be run by licensed users.
Nasıl Çalışır (How Does It Work)
Excel Dosyası Seçimi: Kullanıcı, parsel numaraları ve tabakalandırma kriterlerinin bulunduğu Excel dosyasını seçer. Sütun Tanımlama: Parsel numaralarının ve kriterlerin hangi sütunlarda (A, B, C vb.) olduğunu belirtir. Tabaka Gruplandırma: İsteğe bağlı olarak tabakaları bir grup adı altında organize eder (ör. @sagul). Boş Değerler: Kriter bulunmayan parseller için varsayılan bir tabaka atanır. Lisans Kontrolü: Makro, sistemin seri numarasını kontrol ederek yalnızca lisanslı kullanıcıların çalıştırmasını sağlar. Sonuç: Seçilen parseller, Excel’deki kriterlere göre tabakalara atanır ve işlem tamamlandığında kullanıcıya bilgi verilir.
Excel File Selection: The user selects an Excel file containing parcel numbers and layering criteria. Column Definition: The user specifies which columns (A, B, C, etc.) contain parcel numbers and criteria. Layer Grouping: Optionally, layers can be organized under a group name (e.g., @sagul). Empty Values: A default layer is assigned to parcels with no criteria. License Check: The macro verifies the system’s serial number, allowing only licensed users to run it. Result: Selected parcels are assigned to layers based on the Excel criteria, and the user is notified upon completion.
Etiket ( Labels )
Parsel Tabakalandırma, Excel Makro, Netcad Otomasyon, Harita Mühendisliği, CAD Otomasyonu, Excel ile Tabakalandırma, Otomatik Tabaka Atama, Netcad Makro, Harita Verileri, Lisanslı Makro, Tabaka Yönetimi, Excel Entegrasyonu, Harita Otomasyonu, Parsel Yönetimi, Veri İşleme, Makro Kodlama, Netcad Kullanıcıları, Otomasyon Çözümleri
Parcel Layering, Excel Macro, Netcad Automation, Surveying, CAD Automation, Layering with Excel, Automatic Layer Assignment, Netcad Macro, Mapping Data, Licensed Macro, Layer Management, Excel Integration, Mapping Automation, Parcel Management, Data Processing, Macro Coding, Netcad Users, Automation Solutions
📝 Netcad NVB Code
' 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 - 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.ValueName("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 subnetcad-excelden-tabaka-degistir-alan
✅ 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.
