NetCAD’de Yazıların GIS Adını Excel ile Hızlıca Güncelleyin: Pratik ve Güvenilir! ✍️
Quickly Update GIS Names for Texts in NetCAD with Excel: Practical and Reliable!
Bu makro, NetCAD’de yazı (otext) objelerinin GIS adlarını (cls) Excel dosyasından otomatik olarak günceller. Kullanıcı, Excel dosyasını seçer ve parsel numaraları ile GIS adlarının bulunduğu sütunları belirtir. Makro, yazı objelerinin adlarını Excel’deki parsel numaralarıyla eşleştirir ve GIS adını atar. Kadastro ve harita projelerinde veri doğruluğunu artırır. 📜
This macro updates the GIS names (cls) of text (otext) objects in NetCAD using an Excel file. The user selects the Excel file and specifies columns for parcel numbers and GIS names. The macro matches text object names with parcel numbers and assigns the GIS name. It enhances data accuracy in cadastre and survey projects.
Nasıl Çalışır (How Does It Work)
Makro çalıştığında, bir diyalog kutusu kullanıcıyı Excel dosyası seçmeye yönlendirir. 📈 Parsel numaraları ve GIS adları için sütunlar (A’dan Z’ye) seçilir. Excel verileri bir diziye aktarılır. NetCAD’de yalnızca yazı objeleri seçilir. Her yazı objesinin adı, Excel’deki parsel numarasıyla karşılaştırılır ve GIS adı güncellenir. 🔍 Güncellenen yazı sayısı bir mesaj kutusuyla bildirilir.
1. The macro prompts the user to select an Excel file via a dialog box. 2. Columns for parcel numbers and GIS names (A to Z) are selected. 3. Excel data is loaded into an array. 4. Only text objects are selected in NetCAD. 5. Each text object’s name is compared with parcel numbers, and the GIS name is updated. 6. The number of updated texts is shown in a message box.
Etiket ( Labels )
yazı 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,
text 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("Yazı Objelerini Seçiniz...",array(otext)) 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 Yazının GIS Sınıfı Değiştirildi."
end subnetcad-excel-gis-adi-aktar-yazi
✅ 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.
