(defun C:SBLO (/ gruppo index nomeblocco gru blo1 blo2 blo3 blo4 blocco)
 (setq nomeblocco (strcase (getstring "\nNome blocco: "))
       gru	  (ssget '((0 . "INSERT")))
       gruppo	  (ssadd)
 )
 (if gru
  (progn

   (setq index 0)
   (repeat (sslength gru)
    (setq blo (entget (ssname gru index)))

    (cond
     ((equal
       (substr (cdr (assoc 2 (entget (ssname gru index)))) 1 1)
       "*"
      )
      (setq blo1   (entget (cdr (assoc 360 (entget (ssname gru index)))))
	    blo2   (entget (cdr (assoc 360 blo1)))
	    blo3   (entget (cdr (assoc 360 blo2)))
	    blo4   (entget (cdr (assoc 340 blo3)))
	    blocco (strcase (cdr (assoc 2 blo4)))
      )
      (if (wcmatch blocco nomeblocco)
       (setq gruppo (ssadd (ssname gru index) gruppo))
      )
     )

     ((not
       (equal
	(substr (cdr (assoc 2 (entget (ssname gru index)))) 1 1)
	"*"
       )
      )
      (setq blocco
	    (strcase (cdr (assoc 2 (entget (ssname gru index))))
	    )
      )
      (if (wcmatch blocco nomeblocco)
       (setq gruppo (ssadd (ssname gru index) gruppo))
      )
     )
    )

    (setq index (1+ index))
   )

   (princ "\Trovate ")
   (princ (sslength gruppo))
   (princ " entita'.")
   (princ)
   (setq cont 0)
   (repeat (sslength gruppo)
    (redraw (ssname gruppo cont) -3)
    (setq cont (1+ cont))
   )
   (command "_SELECT" gruppo "")
   (sssetfirst nil gruppo)
  )
  (progn (princ "\No blocks.") (princ))
 )
 (princ)
)

;;; Selezione blocchi
;;; Emissione - 8/6/2001

(defun C:SELBLO	(/ obj nomeblocco ssets gruppo fcode fvalue newsset index)
 (vl-load-com)
 (vla-GetEntity (vla-get-utility (vla-get-activedocument (vlax-get-acad-object))) 'obj nil "\nSelezionare blocco: ")
 (setq nomeblocco (vla-get-EffectiveName obj)
       ssets  (vla-get-selectionsets (vla-get-activedocument (vlax-get-acad-object)))
       gruppo (ssadd)
 )
 (if (vl-catch-all-error-p
      (vl-catch-all-apply 'vla-item (list ssets "Selezione1"))
     )
  (setq newsset (vla-add ssets "Selezione1"))
  (progn
   (vla-delete (vla-item ssets "Selezione1"))
   (setq newsset (vla-add ssets "Selezione1"))
  )
 )
 (setq fcode (vlax-make-safearray vlax-vbinteger '(0 . 0))
       fvalue (vlax-make-safearray vlax-vbvariant '(0 . 0))
 )
 (vlax-safearray-fill fcode '(0))
 (vlax-safearray-fill fvalue '("INSERT"))
 (vla-select newsset acSelectionSetAll nil nil fcode fvalue)
 (setq index -1)
 (repeat (vla-get-Count newsset)
  (if (equal (vla-get-EffectiveName (vla-item newsset (setq index (1+ index)))) nomeblocco)
   (progn
    (vla-highlight (vla-item newsset index) :vlax-true)
    (ssadd (vlax-vla-object->ename (vla-item newsset index)) gruppo)
   )
  )
 )
 (command "_SELECT" gruppo "")
 (sssetfirst nil gruppo)
 (princ)
)

(princ "\nSELBLO (vers.1) - by Terminator")
(princ "\nDigitare SELBLO per far partire il lisp")