PlusCAD Netcad Makro Örneği ( Kamulaştırma Tabakalandırma )

PlusCAD ile Kamulaştırma projeleri için /A,B,C,E içeren adı içeren alan objelerini otomatik tabakalandırıyoruz. Makroyu Pluscad ile kurallar çerçevesinde oluşturduk ve artık tüm projelerde tek tuş ile bu işlemleri yaptırabiliyoruz.

Kullancımızın yapmak istediği şuydu:

  1. /A İçeren alanları KAMU_A tabakasına almak
  2. /B İçeren alanları KAMU_B tabakasına almak
  3. /C İçeren alanları KAMU_C tabakasına almak
  4. /E1 İçeren alanları KAMU_E_1996 tabakasına almak
  5. /E2 İçeren alanları KAMU_E_2005 tabakasına almak
  6. /B İçeren Kamulaştırma Alanlarında alanı 200 m2 altında olanların rengini kırmızı yapmak

Tüm kamulaştırma 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:

indirmek için sağ tıklayınız

[OBJETURU]=ALAN [OZELLIK]=Obje Adı [ESITLIK]=İçinde Var [DEGER]=/A [ISESUNUYAP]=Tabakasını Değiştir [SONUC]=KAMU_A
[OBJETURU]=ALAN [OZELLIK]=Obje Adı [ESITLIK]=İçinde Var [DEGER]=/B [ISESUNUYAP]=Tabakasını Değiştir [SONUC]=KAMU_B
[OBJETURU]=ALAN [OZELLIK]=Obje Adı [ESITLIK]=İçinde Var [DEGER]=/C [ISESUNUYAP]=Tabakasını Değiştir [SONUC]=KAMU_C
[OBJETURU]=ALAN [OZELLIK]=Obje Adı [ESITLIK]=İçinde Var [DEGER]=/E1 [ISESUNUYAP]=Tabakasını Değiştir [SONUC]=KAMU_E_1996
[OBJETURU]=ALAN [OZELLIK]=Obje Adı [ESITLIK]=İçinde Var [DEGER]=/E2 [ISESUNUYAP]=Tabakasını Değiştir [SONUC]=KAMU_E_2005
[OBJETURU]=ALAN [OZELLIK]=Obje Adı [ESITLIK]=İçinde Var [DEGER]=/B [ISESUNUYAP]=Rengini Değiştir [SONUC]=4

PlusCAD Tarafından Otomatik Oluşturulan Netcad Makrosu:

indirmek için sağ tıklayınız

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(opline)
do
set obje=.getnextobject
if obje is nothing then exit do
sagulnet1=”/A”
sagulnet2=”KAMU_A”
toptbk = .numlayers – 1
With nclayermanager
.Add sagulnet2 ,5
For tbksay = 0 To toptbk
Next
End With
a = Obje.pname
icindeki =”KAMU_A”
c = Replace(a, icindeki,””)
If Len(a) <> Len(c) Then Obje.tabaka=KAMU_A
.PUTOBJECT .CUROBJPOS, OBJE
loop
end with
with Netcad
.SetFilter nothing, array(), array(opline)
do
set obje=.getnextobject
if obje is nothing then exit do
sagulnet1=”/B”
sagulnet2=”KAMU_B”
toptbk = .numlayers – 1
With nclayermanager
.Add sagulnet2 ,5
For tbksay = 0 To toptbk
Next
End With
a = Obje.pname
icindeki =”KAMU_B”
c = Replace(a, icindeki,””)
If Len(a) <> Len(c) Then Obje.tabaka=KAMU_B
.PUTOBJECT .CUROBJPOS, OBJE
loop
end with
with Netcad
.SetFilter nothing, array(), array(opline)
do
set obje=.getnextobject
if obje is nothing then exit do
sagulnet1=”/C”
sagulnet2=”KAMU_C”
toptbk = .numlayers – 1
With nclayermanager
.Add sagulnet2 ,5
For tbksay = 0 To toptbk
Next
End With
a = Obje.pname
icindeki =”KAMU_C”
c = Replace(a, icindeki,””)
If Len(a) <> Len(c) Then Obje.tabaka=KAMU_C
.PUTOBJECT .CUROBJPOS, OBJE
loop
end with
with Netcad
.SetFilter nothing, array(), array(opline)
do
set obje=.getnextobject
if obje is nothing then exit do
sagulnet1=”/E1″
sagulnet2=”KAMU_E_1996″
toptbk = .numlayers – 1
With nclayermanager
.Add sagulnet2 ,5
For tbksay = 0 To toptbk
Next
End With
a = Obje.pname
icindeki =”KAMU_E_1996″
c = Replace(a, icindeki,””)
If Len(a) <> Len(c) Then Obje.tabaka=KAMU_E_1996
.PUTOBJECT .CUROBJPOS, OBJE
loop
end with
with Netcad
.SetFilter nothing, array(), array(opline)
do
set obje=.getnextobject
if obje is nothing then exit do
sagulnet1=”/E2″
sagulnet2=”KAMU_E_2005″
toptbk = .numlayers – 1
With nclayermanager
.Add sagulnet2 ,5
For tbksay = 0 To toptbk
Next
End With
a = Obje.pname
icindeki =”KAMU_E_2005″
c = Replace(a, icindeki,””)
If Len(a) <> Len(c) Then Obje.tabaka=KAMU_E_2005
.PUTOBJECT .CUROBJPOS, OBJE
loop
end with
with Netcad
.SetFilter nothing, array(), array(opline)
do
set obje=.getnextobject
if obje is nothing then exit do
sagulnet1=”/B”
sagulnet2=4
toptbk = .numlayers – 1
With nclayermanager
For tbksay = 0 To toptbk
Next
End With
a = Obje.pname
icindeki =”4″
c = Replace(a, icindeki,””)
If Len(a) <> Len(c) Then Obje.renk=4
.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.