PlusCAD Netcad Makro ( Nokta İşlemleri )

PlusCAD ile Kullanıcımız nokta adında bazı değişiklikler yapmak istedi. Nokta adlarındaki – karakterini /’a çevirme, P. ile başlayanları Poligon, N. ile başlayanları Nirengi tabakasına geri kalanları KADASTRO tabakasına almak istedi.

Makroyu Pluscad ile kurallar çerçevesinde oluşturduk ve artık tüm projelerde tek tuş ile bu işlemleri yaptırabiliyoruz.

Kullanıcımızın yapmak istediği şuydu:

  1. Nokta adlarındaki – karakterini / a çevirmek
  2. P. ile başlayan noktaları NOKTA_POLIGON tabakasına almak
  3. N. ile başlayan noktaları NOKTA_NIRENGI tabakasına almak
  4. ST. ile başlayan noktaları NOKTA_ST tabakasına almak
  5. OS. ile başlayan noktaları NOKTA_OS tabakasına almak
  6. Diğer tüm noktaları NOKTA_NOKTA tabakasına almak
  7. Z Koordinatı Sıfır Olmayanların Rengini 4 ( Kırmızı ) Yapmak

Tüm kadastro projelerinde bu işlemleri otomatik yapmak istiyor ve bir makroya ihtiyacı var.

PlusCAD ile otomatik oluşturulan kurallar ile bu işlemi sınırsız kullanabiliyor. Bunun için ücret talep edilmemiştir, ücretsiz destek verilmiştir. Tek Gelirimiz danışmanlık yaptığımız firmalar veya reklamlardır. Sitemizin tek geliri reklamlar olup, hiçbir şey için ücret talep edilmez.



PlusCAD Kurallar (Pbs Dosyası) İçeriği:

[OBJETURU]=NOKTA [OZELLIK]=Obje Adı [ESITLIK]=İçinde Var [DEGER]=- [ISESUNUYAP]=Adında Bul Değiştir Yap [SONUC]=-,/
[OBJETURU]=NOKTA [OZELLIK]=Obje Adı [ESITLIK]=Eşit Değildir [DEGER]=Karışık Harfler Yaz [ISESUNUYAP]=Tabakasını Değiştir [SONUC]=NOKTA_NOKTA
[OBJETURU]=NOKTA [OZELLIK]=Obje Adı [ESITLIK]=İle Başlar [DEGER]=P. [ISESUNUYAP]=Tabakasını Değiştir [SONUC]=NOKTA_POLIGON
[OBJETURU]=NOKTA [OZELLIK]=Obje Adı [ESITLIK]=İle Başlar [DEGER]=N. [ISESUNUYAP]=Tabakasını Değiştir [SONUC]=NOKTA_NIRENGI
[OBJETURU]=NOKTA [OZELLIK]=Obje Adı [ESITLIK]=İle Başlar [DEGER]=ST. [ISESUNUYAP]=Tabakasını Değiştir [SONUC]=NOKTA_ST
[OBJETURU]=NOKTA [OZELLIK]=Obje Adı [ESITLIK]=İle Başlar [DEGER]=OS. [ISESUNUYAP]=Tabakasını Değiştir [SONUC]=NOKTA_OS
[OBJETURU]=NOKTA [OZELLIK]=Z Koordinatı [ESITLIK]=Eşit Değildir [DEGER]=0 [ISESUNUYAP]=Rengini Değiştir [SONUC]=4

PlusCAD Tarafından Otomatik Oluşturulan Netcad Makrosu:

Sub Main()
Dim obje
Dim secim
Dim sagulnet1
Dim sagulnet2
Dim sgl_1,sgl_2,sgl_3,sgl_4,sgl_5,sgl_6
Dim a,b,c,d,e,f,g,h
Dim icindeki
Dim tbsagul,tbex
Dim SEL,o,i,j
Dim tabaka, tabaka1, tabaka2, tbksay, toptbk
Dim tabakasayi, aciksayi, kapalisayi, kilitlisayi, kilitsizsayi, yazicigonder, yazicigonderme
Dim list, list1, list2, list3, list4
Dim max,min,elif ,sabangul
dim xls, xlspath,alan,DEG,CL, bd, U,V,R,W,ruhangul, elifyaren
dim saban,ruhan
‘Şaban GÜL Tarafından Üretilmiştir. Telif hakkı gereği bu satırı ve alttaki satırları silmeyiniz.
‘Bu Makro PlusCAD ile üretilmiştir. Daha fazla bilgi için www.sabangul.com.tr adresini ziyaret ediniz
‘Makro istiyorsanız bize ileti gönderiniz. E-posta: sagulnet@gmail.com




with Netcad
.SetFilter nothing, array(), array(opoint)
do
set obje=.getnextobject
if obje is nothing then exit do
sagulnet1=”Karışık Harfler Yaz”
sagulnet2=”NOKTA_NOKTA”
toptbk = .numlayers – 1
With nclayermanager
.Add sagulnet2 ,5
For tbksay = 0 To toptbk
Next
End With
if Obje.pname<> sagulnet1 then Obje.tabaka= .foundlayer (sagulnet2)
.PUTOBJECT .CUROBJPOS, OBJE
loop
end with
with Netcad
.SetFilter nothing, array(), array(opoint)
do
set obje=.getnextobject
if obje is nothing then exit do
sagulnet1=”P.”
sagulnet2=”NOKTA_POLIGON”
toptbk = .numlayers – 1
With nclayermanager
.Add sagulnet2 ,5
For tbksay = 0 To toptbk
Next
End With
if Mid(Obje.pname,1,2) = “P.” then Obje.tabaka= sagulnet2
.PUTOBJECT .CUROBJPOS, OBJE
loop
end with
with Netcad
.SetFilter nothing, array(), array(opoint)
do
set obje=.getnextobject
if obje is nothing then exit do
sagulnet1=”N.”
sagulnet2=”NOKTA_NIRENGI”
toptbk = .numlayers – 1
With nclayermanager
.Add sagulnet2 ,5
For tbksay = 0 To toptbk
Next
End With
if Mid(Obje.pname,1,2) = “N.” then Obje.tabaka= sagulnet2
.PUTOBJECT .CUROBJPOS, OBJE
loop
end with
with Netcad
.SetFilter nothing, array(), array(opoint)
do
set obje=.getnextobject
if obje is nothing then exit do
sagulnet1=”ST.”
sagulnet2=”NOKTA_ST”
toptbk = .numlayers – 1
With nclayermanager
.Add sagulnet2 ,5
For tbksay = 0 To toptbk
Next
End With
if Mid(Obje.pname,1,3) = “ST.” then Obje.tabaka= sagulnet2
.PUTOBJECT .CUROBJPOS, OBJE
loop
end with
with Netcad
.SetFilter nothing, array(), array(opoint)
do
set obje=.getnextobject
if obje is nothing then exit do
sagulnet1=”OS.”
sagulnet2=”NOKTA_OS”
toptbk = .numlayers – 1
With nclayermanager
.Add sagulnet2 ,5
For tbksay = 0 To toptbk
Next
End With
if Mid(Obje.pname,1,3) = “OS.” then Obje.tabaka= sagulnet2
.PUTOBJECT .CUROBJPOS, OBJE
loop
end with
with Netcad
.SetFilter nothing, array(), array(opoint)
do
set obje=.getnextobject
if obje is nothing then exit do
sagulnet1=0
sagulnet2=4
toptbk = .numlayers – 1
With nclayermanager
For tbksay = 0 To toptbk
Next
End With
if Obje.p1.z<> sagulnet1 then Obje.renk= sagulnet2
.PUTOBJECT .CUROBJPOS, OBJE
loop
end with
MsgBox “İşlem Başarıyla Tamamlandı”, 0, “Şaban GÜL, Harita Mühendisi”
end SUB

 


Diğer Otomatik Oluşturulan Örnekler: http://sabangul.com.tr/pluscad-ile-otomatik-hazirlanan-makro-ornekleri

PlusCAD Hakkında Daha Fazlası İçin: http://sabangul.com.tr/pluscad

Yazar: Şaban GÜL

Amacımız herkese yardımcı olabilmek. Haritacılık ile sınırlı kalmayıp birçok sektöre girmeye RAMAK kaldı :)

Bir cevap yazın

E-posta hesabınız yayımlanmayacak. Gerekli alanlar * ile işaretlenmişlerdir

This site uses Akismet to reduce spam. Learn how your comment data is processed.