Tapu Alanlarını Hızlı ve Kolayca NetCAD’e Aktarın: Excel’den Veri Transferi için Pratik Makro Çözümü 📊
Effortlessly Transfer Land Registry Areas to NetCAD: A Practical Macro Solution for Excel Data Import 📊
Bu makro, Netcad yazılımında tapu alanlarını Excel dosyasından otomatik olarak aktarmak için geliştirilmiştir. Kullanıcı, Excel’de parsel numaralarının ve tapu alanlarının bulunduğu sütunları seçer. Makro, bu verileri okuyarak Netcad’deki çoklu doğru (polyline) objelerine alanları atar. Eğer tapu alanı sıfır ise, opsiyonel olarak objenin hesaplanan alanını kullanabilir. Kadastro, harita mühendisliği ve arazi yönetimi projelerinde veri aktarımını hızlandırır ve hataları en aza indirir. 🗺️
This macro automates the transfer of parcel areas from an Excel file to Netcad software. Users select the columns containing parcel numbers and area data in Excel. The macro reads this data and assigns areas to polyline objects in Netcad. If the parcel area is zero, it can optionally use the object’s calculated area. It streamlines data transfer for cadastre, mapping engineering, and land management projects, minimizing errors.
Nasıl Çalışır (How Does It Work)
Excel Dosyası Seçimi: Kullanıcı, parsel numaraları ve tapu alanlarının bulunduğu Excel dosyasını seçer. Sütun Belirleme: Parsel numaralarının ve tapu alanlarının hangi sütunlarda olduğunu (A-Z) belirtir. Sıfır Alan Kontrolü: Tapu alanı sıfır ise, Netcad’deki objenin hesaplanan alanını yazdırma seçeneği sunar. Veri Okuma: Excel’deki verileri belleğe alır ve parsel numaralarını Netcad objeleriyle eşleştirir. Alan Atama: Eşleşen objelere tapu alanlarını atar ve Netcad’de günceller. Sonuç Bildirimi: Kaç parselin güncellendiğini kullanıcıya bildirir.
Bu süreç, manuel veri girişini ortadan kaldırarak zaman tasarrufu sağlar ve hata riskini azaltır. ⚙️
Excel File Selection: The user selects the Excel file containing parcel numbers and area data.
Column Specification: Specifies which columns (A-Z) contain parcel numbers and parcel areas.
Zero Area Handling: Offers an option to use the object’s calculated area if the parcel area is zero.
Data Reading: Loads Excel data into memory and matches parcel numbers with Netcad objects.
Area Assignment: Assigns parcel areas to matched objects and updates them in Netcad.
Result Notification: Informs the user how many parcels were updated.
This process eliminates manual data entry, saving time and reducing errors.
Etiket ( Labels )
Tapu Alanı Aktarımı, Excel’den NetCAD’e Veri Transferi, NetCAD Makro, Harita Mühendisliği, Kadastro Verileri, Excel Otomasyonu, Tapu Parsel Güncelleme, NetCAD Otomasyon, Veri Eşleştirme, Alan Hesaplama, Excel Makro Çözümleri, Tapu Kayıtları, NetCAD Veri Aktarımı, Haritacılık Yazılımları, Kadastro Otomasyonu, Excel Ada Parsel, NetCAD Kullanımı, Veri İşleme, Harita Verileri, Tapu Alanı Güncelleme, Otomasyon Araçları, Excel NetCAD Entegrasyonu, Kadastro Yazılımları, Harita Mühendisliği Araçları, Veri Transferi Makrosu
Land Registry Transfer, Excel to NetCAD Data Transfer, NetCAD Macro, Surveying Engineering, Cadastre Data, Excel Automation, Land Parcel Update, NetCAD Automation, Data Matching, Area Calculation, Excel Macro Solutions, Land Registry Records, NetCAD Data Import, Mapping Software, Cadastre Automation, Excel Plot Parcel, NetCAD Usage, Data Processing, Mapping Data, Land Area Update, Automation Tools, Excel NetCAD Integration, Cadastre Software, Surveying Tools, Data Transfer Macro
📝 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
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("Tapu Alanının Excelden Aktarımı [Harita Akademi, Ş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","Tapu Alanı 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","Tapu Alanı Sıfır ise Hesap Alanını Yazdır" ,1
If BD.showmodal Then
xlspath = BD.ValueByName("item1")
RUHANGUL=BD.ValueByName("item4")
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.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
MSGBOX CL-1 & " Adet Parsel Excel Dosyasından Başarıyla Okundu. Lütfen İşlem Görecek Parselleri Seçiniz."
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.pname
' MSGBOX ":" & alan & ":"
On Error Resume Next
For V=1 To CL
W=NO(V,1)
If W ="*" & alan Then
o.tarea = NO(V,2)
If BD.ValueByName("item4")= 1 And o.tarea=0 Then
o.tarea=o.area
End If
.putobject j, o
R=R+1
'MSGBOX alan & " : " & NO(V,1) & " : " & NO(V,2)
V=U
End If
Next
Next
SEL.RedrawAndRewind
End If
Set SEL = Nothing
Set o = Nothing
End With
MSGBOX R & " adet Parselin Tapu Alanı Değiştirildi."
End Subnetcad-excelden-tapu-alan-aktar
✅ 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.
