Excel’den NetCAD’e Alanların GIS Adını Otomatik Güncelleyin: Hızlı ve Pratik Çözüm! 🌟
Automatically Update GIS Names for Areas from Excel to NetCAD: Fast and Practical Solution!
Bu makro, NetCAD ortamında alan (CokluDogru) objelerinin GIS adlarını (cls) Excel dosyasından otomatik olarak günceller. Kullanıcı, bir Excel dosyası seçer ve parsel numaralarının ve GIS adlarının bulunduğu sütunları belirtir. Makro, alan objelerinin adlarını Excel’deki parsel numaralarıyla eşleştirir ve ilgili GIS adını atar. Harita mühendisleri için veri aktarımını hızlandıran bu araç, büyük projelerde zaman tasarrufu sağlar. 🗺️
This macro automatically updates the GIS names (cls) of area (CokluDogru) objects in NetCAD using an Excel file. The user selects an Excel file and specifies the columns containing parcel numbers and GIS names. The macro matches area object names with parcel numbers in Excel and assigns the corresponding GIS name. This tool saves time for survey engineers in large projects.
Nasıl Çalışır (How Does It Work)
Makro çalıştırıldığında, bir diyalog penceresi açılır ve kullanıcıdan bir Excel dosyası seçmesi istenir. 📂 Kullanıcı, parsel numaralarının (örneğin, A, B, C sütunları) ve GIS adlarının bulunduğu sütunları seçer. Makro, Excel dosyasını okur ve parsel numaralarını bir diziye kaydeder. NetCAD’de yalnızca alan (CokluDogru) objeleri seçilir. Her alan objesinin adı, Excel’deki parsel numarasıyla karşılaştırılır. Eşleşme bulunursa, GIS adı güncellenir. ✅ İşlem sonunda, kaç alanın güncellendiği bir mesaj kutusuyla bildirilir.
1. When the macro runs, a dialog box prompts the user to select an Excel file. 2. The user specifies the columns for parcel numbers (e.g., A, B, C) and GIS names. 3. The macro reads the Excel file and stores parcel numbers in an array. 4. Only area (CokluDogru) objects are selected in NetCAD. 5. Each area object’s name is compared with parcel numbers in Excel. If a match is found, the GIS name is updated. 6. A message box reports the number of updated areas.
Etiket ( Labels )
alan güncelleme, GIS adı, NetCAD makro, Excel veri aktarımı, harita mühendisliği, otomasyon, parsel numarası, veri yönetimi, kadastro, coğrafi bilgi sistemi,
area update, GIS name, NetCAD macro, Excel data transfer, survey engineering, automation, parcel number, data management, cad
📝 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
Dim i,j,o,SEL,xls,xlspath,alan,DEG,CL,bd,U,V,R,W
Dim ruhangul,elifyaren,saban,ruhan
Dim NO(50000,2)
DEG="":CL=0:U=0:R=0
set xls=CreateObject("excel.application")
set BD=Netcad.NewBDialog("GIS Adının Excelden Alınması [Ş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","GIS Sınıfı 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
if BD.showmodal then
xlspath=BD.ValueByName("item1")
else
exit sub
end if
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
set SEL=.NewSelectionSet
set o=.NewObject
if SEL.SELECT("CokluDogru Objelerini Seçiniz...",array(opline)) then
for i=0 to SEL.NE-1
j=SEL.GetSelectedObject(i,o)
alan=o.objname
on error resume next
FOR V=1 TO CL
W=NO(V,1)
if W="*" & alan then
o.objname=NO(V,2)
.putobject j,o
R=R+1
V=U
end if
NEXT
next
SEL.RedrawAndRewind
end if
set SEL=nothing
set o=nothing
end with
MSGBOX R & " adet Alanın GIS Sınıfı Değiştirildi."
end subnetcad-excel-gis-adi-aktar-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.
