Home / Netcad Makro / Proje Objeleri için Raporlama Makrosu (Project Object Reporting Macro)

Proje Objeleri için Raporlama Makrosu (Project Object Reporting Macro)

Proje Objeleri için Envanter Raporlama Makrosu ile Verimliliği Artırın!


Bu makro, Netcad projelerindeki objeler hakkında detaylı bir envanter raporu oluşturur. Nokta, hat, daire, yay, yazı, sembol, çoklu doğru, alan, spiral, eğri, kutu, pafta, üçgen, blok ve mark gibi obje türlerini analiz ederek toplam adet, uzunluk, alan ve tapu alanı gibi bilgileri sunar. 📊 Kullanıcı dostu bir rapor ekranında, seçilen objelerin türüne göre özet bilgiler sunar ve lisans kontrolü ile demo veya sınırsız kullanım seçenekleri sağlar. Proje yönetiminde zaman kazandırır ve veri analizini kolaylaştırır. Özellikle harita mühendisleri, şehir plancıları ve CAD kullanıcıları için ideal bir araçtır.


Nasıl Çalışır (How Does It Work)

Makro, Netcad ortamında çalışır ve aşağıdaki adımları izler:

  1. Obje Seçimi: Kullanıcı, projeden analiz etmek istediği objeleri seçer.
  2. Analiz ve Raporlama: Seçilen objeler, türlerine göre sınıflandırılır. Her obje türü için adet, uzunluk (metre cinsinden) ve alan (metrekare cinsinden) gibi bilgiler hesaplanır.
  3. Rapor Görüntüleme: Sonuçlar, Netcad’in rapor ekranında detaylı bir şekilde gösterilir. Örneğin, hat objeleri için toplam uzunluk, alan objeleri için hesaplanan ve tapu alanı gibi veriler listelenir.
  4. Hafıza Temizliği: İşlem tamamlandıktan sonra bellek temizlenir, böylece sistem performansı korunur.

Makro, özellikle büyük projelerde obje envanterini hızlıca çıkarmak ve raporlamak için tasarlanmıştır. Kullanımı kolaydır ve teknik kullanıcılar için özelleştirilebilir bir yapı sunar.


Etiket ( Labels )

Obje Raporlama, Netcad Makro, Envanter Yönetimi, CAD Rapor, Harita Mühendisliği, Proje Analizi, Obje Envanteri, Raporlama Aracı, Netcad Otomasyon, Veri Analizi, Harita Raporlama, CAD Envanter, Alan Hesaplama, Uzunluk Ölçümü, Nokta Analizi, Hat Analizi, Daire Analizi, Yay Analizi, Çoklu Doğru, Spiral Analizi, Kutu Analizi, Pafta Yönetimi, Üçgen Analizi, Blok Analizi, Mark Analizi


📝 Netcad NVB Code

VB
' Dil      : Visual Basic
' Amaç     : Projedeki Objeler Hakkında Rapor Görüntüler.
' Yazan    : Oğuzhan SARIOĞLU 11.01.2017
' Versiyon : 1.01

Dim R,ss,sos,obje,objeindex,i,tag,icon,kalankullanim,netcaddir
Dim padet                 'Nokta
Dim hadet,htuz            'Hat
Dim dadet,dalan,dtuz      'Daire
Dim yayadet,yaytuz        'Yay
Dim yaziadet              'Yazı
Dim semboladet            'Sembol
Dim cdadet,cdtuz         'Çokludoğru
Dim alanadet,alanhesap,alantapu,alantuz 'Alan
Dim spiraladet,spiraltuz  'Spiral
Dim egriadet              'Eğri
Dim kutuadet,kutualan     'Kutu
Dim paftaadet             'Pafta
Dim ucgenadet             'Ucgen
Dim blokadet              'Blok
Dim markadet              'Mark

Dim fso,liscevap,kalanadet,lisfile,lis,liskull,liskod,gun,ay,yil,g,a,y,uz,drv,serial,drvtype
set fso = createobject("scripting.filesystemobject")
set drv = fso.GetDrive(fso.GetDriveName("C:\"))

drvtype = drv.Drivetype  ' Harddisk tipi 0:Bilinmeyen Drive 1:Removable Drive 2:Fixed Disk 3:Remote Disk 4:CDROM 5:Ram Disk
serial = drv.SerialNumber  ' Harddisk Serial No
'serial = drv.volumename    ' Harddisk Adı.
'serial = drv.driveletter   ' Harddisk Sürücü Adı (C / D vs.)
'serial = drv.filesystem    ' File sistem


gun=day(now)
ay=month(now)
yil=mid(year(now),3,2)

'msgbox gun& Chr(10) &ay& Chr(10) &yil
'msgbox serial&"  "&drvtype

Sub main
  with Netcad

  '........ Lisanskontrol ..........
  netcaddir = .getparam(PNC_NETCADDIR) 'Netcad'in kurulu olduğu klasörü verir.
  liscevap = fso.fileexists(netcaddir&"/NCORMAC.mcs") 'Lisans Dosyası var mı?
  'msgbox liscevap 'Cevabı görüntüle.
if liscevap="Yanlış" then
   'msgbox "Lisans dosyası bulunamadı."
   set lisfile = fso.createtextfile(netcaddir&"/NCORMAC.mcs",true)
   lisfile.writeline("553")
   lisfile.close
   kalanadet=14
else
   'msgbox liscevap
    set lisfile = fso.opentextfile(netcaddir&"/NCORMAC.mcs",1)
    lis = lisfile.readline
    lisfile.close
       if lis<>1000 then
    kalanadet=(lis/7)-65-1
              if kalanadet+1<>0 then
    set lisfile = fso.getfile (netcaddir&"/NCORMAC.mcs")
    lisfile.delete
    set lisfile = fso.createtextfile(netcaddir&"/NCORMAC.mcs",true)
    lisfile.writeline((kalanadet+65)*7)
    lisfile.close
              else
              msgbox "Lütfen Lisans Kodunu Alın."& Chr(10) & " " & Chr(10) &"Oğuzhan SARIOĞLU"& Chr(10) &"oguzhan.20@hotmail.com",64," Uyarı! Demo Süresi Bitmiştir. "
              'liskull = inputbox("Lütfen Kullanıcı Adı Belirleyin.","Macro Lisanslama İşlemi.")
              liskod = inputbox("Lütfen Lisans Kodunu Giriniz.","Macro Lisanslama İşlemi.")
                 if liskod = "" then msgbox "Hatalı Lisans Kodu.",16,"Macro Lisanlama İşlemi" : exit 
                 
                 
                 sub
              'msgbox liskod
                   if liskod = "zeynepazranimetasya" then
                      msgbox "Lisansınız sınırsız süre için aktif olmuştur.",64,"Macro Lisanslama İşlemi."
                          set lisfile = fso.getfile (netcaddir&"/NCORMAC.mcs")
                          lisfile.delete
                          set lisfile = fso.createtextfile(netcaddir&"/NCORMAC.mcs",true)
                          lisfile.writeline("1000")
                          kalanadet=1000
                          lisfile.close
                      else
                          uz=len(liskod)            ' Şifre = (Gün+Gün)/(Ay+Gün)/(Yıl+Gün) olmacak şekilde bitişik olarak yazılmalı.
                          g=mid(liskod,1,2)-gun
                          a=mid(liskod,3,2)-gun
                          y=mid(liskod,5,2)-gun
                       'msgbox g & " " & a & " " & y & " " & uz & "  Gün:" & gun & "  AY:" & ay '**********************************************
                       if g=gun and a=ay then
                          msgbox "Lisansınız sınırsız süre için aktif olmuştur.",64,"Macro Lisanslama İşlemi."
                          set lisfile = fso.getfile (netcaddir&"/NCORMAC.mcs")
                          lisfile.delete
                          set lisfile = fso.createtextfile(netcaddir&"/NCORMAC.mcs",true)
                          lisfile.writeline("1000")
                          kalanadet=1000
                          lisfile.close
                        else
                             msgbox "Hatalı Lisans Kodu.",16,"Macro Lisanlama İşlemi" ': exit sub
                        end if
                   end if

              end if
         else 'Eğer 1000 ise
            kalanadet=1000

       end if
end if
   '................................

if kalanadet<>500000000000 then

icon=0

   set ss = .NewSelectionSet   ' Anlik Secim objesi yarat
   set obje = .newobject

  if ss.Select ("Lütfen Obje Seçin ...",array()) then=  then' obje sec
    sos = ss.ne 'Seçilen Obje Sayısı
  for i = 0 to ss.ne-1
    objeindex = ss.getselectedobject (i,obje) 'i no'lu objenin gerçek index no bul. Obje değişkenine ata.
         tag=obje.tag
         'msgbox obje.flags
           Select Case tag
            Case 0 'Silinmiş Obje

            Case 1 'Nokta
              padet=padet+1

            Case 2 'Hat
              hadet=hadet+1
              htuz=htuz+obje.length(0)

            Case 3 'Daire
              dadet=dadet+1
              dtuz=dtuz+obje.length(0)
              dalan=dalan+obje.area
            Case 4 'Yay
              yayadet=yayadet+1
              yaytuz=yaytuz+obje.length(0)

            Case 5 'Yazı
              yaziadet=yaziadet+1

            Case 6 'Sembol
              semboladet=semboladet+1

            Case 7 'Çokludoğru ve Alan
              if obje.flags=0 or obje.flags=16 or obje.flags=4 or obje.flags=64 then
              cdadet=cdadet+1
              cdtuz=cdtuz+obje.length(0)
              end if

              if obje.flags=1 or obje.flags=17 or obje.flags=3 or obje.flags=19 then
              alanadet=alanadet+1
              alantuz=alantuz+obje.length(0)
              alanhesap=alanhesap+obje.area
              alantapu=alantapu+obje.tarea
              end if


            Case 8 'Spiral
              spiraladet=spiraladet+1
              spiraltuz=spiraltuz+obje.length(0)

            Case 9 'Eğri
              egriadet=egriadet+1

            Case 10 'Kutu
              kutuadet=kutuadet+1
              kutualan=kutualan+obje.area
            Case 11 'Pafta
              paftaadet=paftaadet+1

            Case 12 'Üçgen
              ucgenadet=ucgenadet+1

            Case 13 'Blok
              blokadet=blokadet+1

            Case 14 'Mark
              markadet=markadet+1

            Case Else
                msgbox "Obje Yok!"
        End Select
  next
   if sos=0 then
     msgbox "Obje Seçilmedi !"
    else

   set R=ncstatusreport
   R.clear
   R.setformcaption "Netcad Obje Raporu V:1.02 Oğuzhan SARIOĞLU oguzhan.20@hotmail.com"
     if kalanadet=1000 then
        r.setheaderinfo "Lisanslandırılmış Macro : Kalan Kullanım Hakkınız = Sınırsız"
     else
        r.setheaderinfo "Demo Mod : Kalan Kullanım Hakkınız = " & kalanadet
     end if
   'r.add 2,.getparam(PNC_NETCADDIR)
   r.add 3,.getparam(PNC_CURRENTFILE)
   r.add 3,"Seçilen Obje Sayısı = " & ss.ne
   r.add 3,"Tarih : " & Date
   r.add 3,"Saat  : " & time
   R.addsub " "
'########### NOKTA ################################
           if padet>0 then
              R.add icon,"NOKTA"
              R.addsub "Toplam Adet = " & padet
              R.addsub " "
           end if
'##################################################
'########### HAT ##################################
           if hadet>0 then
              R.add icon,"HAT"
              R.addsub "Toplam Adet = " & hadet
              R.addsub "Toplam Uzunluk = " & formatnumber(htuz,3,-1,0,0) & " m"
              R.addsub " "
           end if
'##################################################
'########### DAİRE ##################################
           if dadet>0 then
              R.add icon,"DAİRE"
              R.addsub "Toplam Adet = " & dadet
              R.addsub "Toplam Alan = " & formatnumber(dalan,3,-1,0,0) & ""
              R.addsub "Toplam Uzunluk = " & formatnumber(dtuz,3,-1,0,0) & " m"
              R.addsub " "
           end if
'##################################################
'########### YAY ##################################
           if yayadet>0 then
              R.add icon,"YAY"
              R.addsub "Toplam Adet = " & yayadet
              R.addsub "Toplam Uzunluk = " & formatnumber(yaytuz,3,-1,0,0) & " m"
              R.addsub " "
           end if
'##################################################
'########### YAZI ##################################
           if yaziadet>0 then
              R.add icon,"YAZI"
              R.addsub "Toplam Adet = " & yaziadet
              R.addsub " "
           end if
'##################################################
'########### SEMBOL ###############################
           if semboladet>0 then
              R.add icon,"SEMBOL"
              R.addsub "Toplam Adet = " & semboladet
              R.addsub " "
           end if
'##################################################
'########### ÇOKLUDOĞRU ###########################
           if cdadet>0 then
              R.add icon,"ÇOKLU DOĞRU"
              R.addsub "Toplam Adet = " & cdadet
              R.addsub "Toplam Uzunluk = " & formatnumber(cdtuz,3,-1,0,0) & " m"
              R.addsub " "
           end if
'##################################################
'########### ALAN #################################
           if alanadet>0 then
              R.add icon,"ALAN"
              R.addsub "Toplam Adet = " & alanadet
              R.addsub "Toplam Hesaplanan Alan = " & formatnumber(alanhesap,3,-1,0,0) & ""
              R.addsub "Toplam Tapu Alanı      = " & formatnumber(alantapu,3,-1,0,0) & ""
              R.addsub "Toplam Çevre Uzunluğu  = " & formatnumber(alantuz,3,-1,0,0) & " m"
              R.addsub " "
           end if
'##################################################
'########### SPİRAL ###############################
           if spiraladet>0 then
              R.add icon,"SPİRAL"
              R.addsub "Toplam Adet = " & spiraladet
              R.addsub "Toplam Uzunluk = " & formatnumber(spiraltuz,3,-1,0,0) & ""
              R.addsub " "
           end if
'##################################################
'########### EĞRİ #################################
           if egriadet>0 then
              R.add icon,"EĞRİ"
              R.addsub "Toplam Adet = " & egriadet
              R.addsub " "
           end if
'##################################################
'########### KUTU #################################
           if kutuadet>0 then
              R.add icon,"KUTU"
              R.addsub "Toplam Adet = " & kutuadet
              R.addsub "Toplam Alan = " & kutualan
              R.addsub " "
           end if
'##################################################
'########### PAFTA ################################
           if paftaadet>0 then
              R.add icon,"PAFTA"
              R.addsub "Toplam Adet = " & paftaadet
              R.addsub " "
           end if
'##################################################
'########### ÜÇGEN ################################
           if ucgenadet>0 then
              R.add icon,"ÜÇGEN"
              R.addsub "Toplam Adet = " & ucgenadet
              R.addsub " "
           end if
'##################################################
'########### BLOK ################################
           if blokadet>0 then
              R.add icon,"BLOK"
              R.addsub "Toplam Adet = " & blokadet
              R.addsub " "
           end if
'##################################################
'########### MARK ################################
           if markadet>0 then
              R.add icon,"MARK"
              R.addsub "Toplam Adet = " & markadet
              R.addsub " "
           end if
'##################################################


R.showmodal
   end if

 end if
end if



  end with
'****** Hafıza Temizle ******
  set R = nothing
  set ss = nothing
  set sos = nothing
  set obje = nothing
  set objeindex = nothing
  set i = nothing
  set tag = nothing
  set fso = nothing
'****************************
End Sub


'*** Global Object Tag Constants
'const  odeleted   =  0
'const  opoint     =  1
'const  oline      =  2
'const  ocircle    =  3
'const  oarc       =  4
'const  otext      =  5
'const  oshape     =  6
'const  opline     =  7
'const  ospiral    =  8
'const  oizohdr    =  9
'const  orectangle = 10
'const  ostpafta   = 11
'const  otriang    = 12
'const  oblock     = 13
'const  omark      = 14
VB

netcad-obje-envanter-raporlama

⚠️ Dikkat! Netcad Makrosu Kullanımı Hakkında Bilgilendirme

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.
Etiketlendi: