NetCAD’de Yazıların GIS Sınıfını Excel ile Hızlıca Güncelleyin: Pratik ve Güvenilir! ✍️
Quickly Update GIS Classes for Texts in NetCAD with Excel: Practical and Reliable!
Bu makro, NetCAD’de yazı (otext) objelerinin GIS sınıflarını Excel dosyasından otomatik olarak günceller. Kullanıcı, Excel dosyasını seçer ve parsel numaraları ile GIS sınıflarının bulunduğu sütunları belirtir. Makro, yazı objelerinin adlarını Excel’deki parsel numaralarıyla eşleştirir ve GIS sınıfını atar. Kadastro ve harita projelerinde veri doğruluğunu artırır. 📜
This macro updates the GIS classes of text (otext) objects in NetCAD using an Excel file. The user selects the Excel file and specifies columns for parcel numbers and GIS classes. The macro matches text object names with parcel numbers and assigns the GIS class. 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 sınıfları 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 sınıfı güncellenir. 🔍 Güncellenen yazı sayısı bir mesaj kutusuyla bildirilir.
- The macro prompts the user to select an Excel file via a dialog box.
- Columns for parcel numbers and GIS classes (A to Z) are selected.
- Excel data is loaded into an array.
- Only text objects are selected in NetCAD.
- Each text object’s name is compared with parcel numbers, and the GIS class is updated.
- The number of updated texts is shown in a message box.
Etiket ( Labels )
yazı güncelleme, GIS sınıfı, NetCAD makro, Excel veri aktarımı, harita mühendisliği, otomasyon, parsel numarası, veri yönetimi, kadastro, coğrafi bilgi sistemi,
text update, GIS class, 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 Adı 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.cls=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 Adı Değiştirildi."
end subnetcad-excel-gis-sinifi-aktar-yazi
