NetCAD’de Noktaların GIS Adını Excel ile Kolayca Güncelleyin: Verimli ve Hızlı!
Easily Update GIS Names for Points in NetCAD with Excel: Efficient and Fast!
Bu makro, NetCAD’de nokta (opoint) objelerinin GIS adlarını (cls) Excel dosyasından otomatik olarak günceller. Kullanıcı, Excel dosyasını ve parsel numaraları ile GIS adlarının bulunduğu sütunları seçer. Makro, nokta objelerinin adlarını Excel’deki parsel numaralarıyla eşleştirir ve GIS adını atar. Harita ve kadastro projelerinde veri yönetimini kolaylaştırır. 📍
This macro updates the GIS names (cls) of point (opoint) objects in NetCAD using an Excel file. The user selects the Excel file and columns for parcel numbers and GIS names. The macro matches point object names with parcel numbers and assigns the GIS name. It simplifies data management in survey and cadastre projects.
Nasıl Çalışır (How Does It Work)
Makro başlatıldığında, kullanıcıdan bir Excel dosyası seçmesi için bir diyalog kutusu açılır. 📊 Parsel numaralarının ve GIS adlarının bulunduğu sütunlar (A’dan Z’ye) seçilir. Excel dosyası okunur ve veriler bir diziye yüklenir. NetCAD’de yalnızca nokta objeleri seçilir. Her nokta objesinin adı, Excel’deki parsel numarasıyla eşleştirilir ve GIS adı güncellenir. 🔄 Sonuç olarak, güncellenen nokta sayısı bir mesaj kutusuyla gösterilir.
The macro opens a dialog box to select an Excel file. 2. Columns for parcel numbers and GIS names (A to Z) are chosen. 3. The Excel file is read, and data is loaded into an array. 4. Only point objects are selected in NetCAD. 5. Each point object’s name is matched with parcel numbers, and the GIS name is updated. 6. The number of updated points is displayed in a message box.
Etiket ( Labels )
nokta 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,
point update, GIS name, NetCAD macro, Excel data transfer, survey engineering, automation, parcel number, data management, cadastre, geographic information system
📝 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("Nokta Objelerini Seçiniz...",array(opoint)) 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 Noktanın GIS Sınıfı Değiştirildi."
end subnetcad-excel-gis-adi-aktar-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.
