;;; Belirnen bir Block'tan seçilen objeler içinde veya Tüm Çizim içinde,
;;; Değiştirilmiş Dinamik Blokları da sayarak, kaç tane olduğunu bulur
;;; Hazırlayan M. Şahin Güvercin 08.04.2010 - Ankara
(defun c:bsay ()
  (vl-load-com)
  (setq bln (getstring "\nSayılacak Block adı: <Blok Seçmek için ENTER giriniz> ") sayi 0)
  (if (= bln "")
    (progn
      (setq e (car (entsel "\nSaymak istediginiz bloku seciniz...")) bm (entget e))
      (while (/= (cdr (assoc 0 bm)) "INSERT")
(setq e (car (entsel "\nSecilen obje bir blok degil! Yeniden seciniz...")) bm (entget e)))
      (setq obj (vlax-ename->vla-object e))
      (if (= -1 (vlax-get obj 'IsDynamicBlock))
(setq bln (vlax-get obj 'EffectiveName)) (setq bln (cdr (assoc 2 (entget e)))))))
  (while (= (tblsearch "BLOCK" bln) nil)
    (princ (strcat "\nBu cizimde -" bln "- isimli bir Block Tanımı bulunamadi."))
    (setq bln (getstring "\nBlock adini yeniden giriniz : ")))
  (setq bln (cdr (assoc 2 (tblsearch "BLOCK" bln))))
  (princ (strcat "\nÇizimin tümünde -" bln "- aramak icin Enter giriniz..."))
  (if (= (ssget) nil)
    (setq bls (ssget "x" (list (cons 0 "INSERT"))) sss "\nBu çizim içinde ")
    (setq bls (ssget "p" (list (cons 0 "INSERT"))) sss "\nSeçilen objeler içinde " ))
  (setq n 0 l (sslength bls))
  (while (< n l)
    (setq e (ssname bls n) obj (vlax-ename->vla-object e))
    (if (= -1 (vlax-get obj 'IsDynamicBlock))
      (if (= (vlax-get obj 'EffectiveName) bln) (setq sayi (1+ sayi)))
      (if (= (cdr (assoc 2 (entget e))) bln) (setq sayi (1+ sayi))))
    (setq n (1+ n)))
  (if (< sayi 1)
    (princ (strcat sss "-" bln "- bulunamadi..."))
    (princ (strcat sss (itoa sayi) " adet -" bln "- bulundu...")))
  (prin1)
)

;;; Çizim içindeki bütün Kullanıcı Bloklarını sayılır.
;;; Edit edilmiş dinamik bloklar da sayıma dahil edilir.
;;; istenirse sayım sonuçları liste halinde dosyaya yazılır.
;;; Hazırlayan M. Şahin Güvercin 09.04.2010 - Ankara
(defun c:bsay ()
  (vl-load-com) (initget 1 "E H")
  (setq btot 0 dfn (getvar "dwgname") dfn (substr dfn 1 (- (strlen dfn) 4)))
  (setq dy (getkword "\nSonuçlar Dosyaya Yazılsın mı? (Evet/Hayır): "))
  (if (eq dy "E")
    (setq f (open (getfiled "Block Liste Dosyası" (strcat (getvar "dwgprefix") dfn) "txt" 1) "w")))
  (princ "\n BLock Adı...... Sayısı") (princ "\n =============== ======")
  (if (eq dy "E")
    (progn (write-line " BLock Adı...... Sayısı" f) (write-line " =============== ======" f)))
  (setq bln (tblnext "BLOCK" T) bls (ssget "x" (list (cons 0 "INSERT"))) l (sslength bls))
  (while bln
    (setq bln (cdr (assoc 2 bln)))
    (if (not (eq (substr bln 1 1) "*"))
      (progn
        (setq n 0 sayi 0)
        (while (< n l)
          (setq e (ssname bls n) obj (vlax-ename->vla-object e))
          (if (= -1 (vlax-get obj 'IsDynamicBlock))
            (if (= (vlax-get obj 'EffectiveName) bln) (setq sayi (1+ sayi)))
            (if (= (cdr (assoc 2 (entget e))) bln) (setq sayi (1+ sayi))))
          (setq n (1+ n)))
        (if (> sayi 0)
          (progn
            (while (< (strlen bln) 15) (setq bln (strcat bln ".")))
            (princ (strcat "\n " bln ": " (itoa sayi)))
            (if (eq dy "E") (write-line (strcat " " bln ": " (itoa sayi)) f))
            (setq btot (+ btot sayi))))))
    (setq bln (tblnext "BLOCK")))
  (princ "\n =============== ======") (princ (strcat "\n TopLam.........: " (itoa btot)))
  (if (eq dy "E")
    (progn (write-line " =============== ======" f)
      (write-line (strcat " TopLam.........: " (itoa btot)) f) (close f)))
  (prin1)
)

(defun c:ABLbuL ()
  (setq abLname (strcat (chr 96) (getstring "\Anonymus Block Adını yazınız: "))
           SelectionSet (ssget "x" (list (cons 0 "INSERT") (cons 2 abLname)))
           Lngth (sslength SelectinSet))
  (princ (strcat "\n" Lngth " tane " abLname " Blocku bulundu..."))
)