Excelden GIS Sınıfın Aktarılması(Netcad Makro)

Makro Hakkında:

Excel’de xls formatlı dosyanızda 1. sütuna parsel numarası,2.sütuna GIS SINIFI yazınız. Parsel numaralarının netcad projeniz ile aynı olmasına dikkat ediniz. Böylece excele yazdığınız GIS SINIFLARI netcad projenizdeki alanlara yazdırılır.

• Makroda Üzerinde Çalıştığımız Gelişmeler:
  • Şu anlık üzerinde çalıştığımız bir gelişme bulunmamaktadır. Kullanıcılardan gelen istekler ve editörlerimizin çalışmaları ile olası gelişmeler yayımlanacaktır. Bizi takip ediniz.
• Etiketler: Basit düzey makro, Netcad, Makro, Pratik Netcad, Netcad Araçları, Netcad tabaka, netcad seçim, Pratik Netcad, Netcadde nasıl yapılır,netcad menü, netcad araç, nvb, ücretsiz makro, harita makro,

Uyarılar:

• Exceldeki sütun adları ile kullanıcı formundaki sütun adlarının aynı olmasına dikkat ediniz.
• Bu makro ile en fazla 50bin satır excel satırı okunabilir.
• Exceldeki parsel no ile projedeki parsel no eşleşmesi durumunda Önceki GIS SINIFI silinir ve bu işlem geri alınmaz
• Excel dosyasındaki parsel no sütunundaki tüm parseller projenizde taranacak. Bu durumda
  • Bir parselden aynı isimli birden fazla olması durumunda GIS SINIFI hatası olacağını unutmayınız
  • GIS SINIFI sütununda sayı olmayan karakter kullanmayınız. Yazdığınız GIS sınıfının netcad bağlantı yöneticisinde olması gerektiğini unutmayınız
  • Excel ile netcad projesinde eşleşmeyen alanlarda GIS SINIFI değiştirme yapılmayacaktır. Eski GIS SINIFI aynı kalacaktır.
• Netcad makrolarında hiçbir metni veya karakteri değiştirmeyiniz. Aksi halde makro işlevsiz hale gelebilir veya hatalı işlev ile karşılaşabilirsiniz.

İndirme Linkleri:

İndirme Linki-1: Google Drive ( Harita Akademi )

Makro Açık Kaynak Kodu:

'' 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("GIS Sınıfının Excelden Alınması [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","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

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





set SEL = .NewSelectionSet
 set o = .NewObject





if SEL.SELECT("CokluDogru,Alan,Nokta ve Yazı Objelerini Seçiniz...",array(opline,oline,opoint,otext)) then

for i = 0 to SEL.NE-1
 j = SEL.GetSelectedObject(i, o)
 alan = o.cls
 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
 '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 GIS Sınıfı Değiştirildi."

end sub