;|

  LBLK.LSP versione 1.2
  Copyright © 2003 by
  Michele Ingenuo (www.3eye.biz)
  Claudio Piccini (www.cg-cad.com)

  Inserisce una legenda con disegno, nome e 
  numero dei blocchi selezionati
  (Non funziona con blocchi con attributi!)

|;

(defun myerror (s)                  
  (if (/= s "Function cancelled")
    (princ (strcat "\nError: " s))
  )
 (ripVar)
 (princ)
)

(defun salVar ()
 (setq orto (getvar "orthomode"))                          
 (setq snapp (getvar "osmode"))
 (setq snm (getvar "snapmode"))
 (setq piano (getvar "clayer"))  
)

(defun ripVar ()
 (command "_redraw")
 (setvar "cmdecho" 1)
 (setvar "osmode" snapp)
 (setvar "snapmode" snm)
 (setvar "orthomode" orto)
 (setvar "clayer" piano)
 (setvar "cecolor" "BYLAYER")
 (setq *error* olderr)
 (princ)
)

(defun c:lblk (/   scelta LAY LAYD NLAY SS EL A 
                   lb nlb N INDEX Index2 nBlk nome 
                   cBlk stringa lstr 
                   P1 P2 P3
                   hTxt dTxt aTxt
                   olderr snapp snm orto piano
  )
  
  (setq olderr  *error*  *error* myerror)
  (setvar "cmdecho" 0)
  (salVar)
  
  (graphscr)
  
  ; filtro selezione dei blocchi
  (setq scelta (strcase (getstring "\nLayer o tutti? \nL o invio\n")))
  (if (= scelta "L")
     (progn
        (setq LAY (car (entsel "\nSeleziona un'entita' per il layer")))
        (setq LAYD (entget LAY)); estrae le informazioni della selezione
        (setq NLAY (cdr (assoc 8 LAYD)))
        (setq SS (ssget (list (cons 0 "insert")(cons 8 NLAY)))) ; blocchi sul layer selezionato 
     )
     (setq SS (ssget (list (cons 0 "insert"))))
  )
  
  (if (/= SS nil)
     
     (progn 
        
        (setq lb (list nil)) ; lb lista dei nomi dei blocchi
        
        (setq INDEX 0)
         
        (repeat (sslength SS)
           (setq EL (entget (SSNAME SS INDEX)))
           (setq A (cdr (assoc 2 EL)))
           (if (/= (substr A 1 1) "*") ; ignora i blocchi anonimi: *X
              (progn
                 ; E = test di controllo
                 (setq E 0)
                 (setq Index2 0)
                 (setq nlb (length lb))    ; nlb = dimensione di lb
                 (repeat nlb
                    (setq nome (nth Index2 lb))
                    (if (= nome A) (setq E 1))
                    (setq Index2 (1+ Index2))
                 )
                 (if (= E 0) 
                    (setq lb (append lb (list A)))
                 )
              )
           )
           (setq INDEX (1+ INDEX))
        )
        
        (setq lb (cdr lb)) ; elimino nil dalla lista blocchi
        
        ;| 
        
          scorro la lista SS e con l'aiuto di lb 
          conto i blocchi con lo stesso nome
         
        |;
        
        (setq nlb (length lb)) ; nlb = dimensione definitiva di lb
        (setq lstr (list nil)) ; inizializzo la lista delle stringhe
        (setq Index2 0)
        (setq nBlk 0)
        (repeat nlb
           (setq nome (nth Index2 lb))
           (setq INDEX 0)
           (setq nBlk 0)
           (repeat (sslength SS) 
              (setq EL (entget (SSNAME SS INDEX)))
              (setq A (cdr (assoc 2 EL)))
              (if (= nome A) 
                 (setq nBlk (1+ nBlk))
              )       
              (setq INDEX (1+ INDEX))
           )
           
           ;|
             
              converto il numero in stringa e creo
              la stringa di testo per la legenda
              
           |;
            
           (setq cBlk (rtos nBlk 2 0))
           (setq stringa (strcat cBlk  " "  nome ))
           (setq lstr (append lstr (list stringa))) ; aggiungo la stringa alla lista lstr
           (setq Index2 (1+ Index2))
        )
        (setq lstr (cdr lstr)) ; elimino nil dalla lista lstr
        
        ;|
         
          inserisco la legenda nel disegno
        
        |;
        
        (command "osnap" "_non")
        (setq P1 (getpoint "\nPunto di inserzione"))
        (setq hTxt (getvar "TEXTSIZE")) ; TEXTSIZE = altezza del testo nel disegno corrente
        (setq dTxt (getdist "\nDistanza del testo dal blocco: "))
        (setq aTxt (getdist "\nAltezza interlinea testo: "))
        (setq INDEX 0)
        (repeat nlb
           (setq stringa (nth INDEX lstr))            ; estraggo la stringa
           (setq nome (nth INDEX lb))                 ; estraggo il blocco
           (command "_insert" nome P1 1 "" "") 
           (setq P2 (polar P1 (* pi 1.5) (/ hTxt 2))) ; punto d'inserimento della stringa
           (setq P3 (polar P2 0 dTxt))
           (command "_text" P3 hTxt 0 stringa)
           (setq P1 (polar P1 (* pi 1.5) aTxt))
           (setq INDEX (1+ INDEX))
        )
     )
     
     (princ "\nNessun blocco selezionato")
     
  )
  
  (ripVar)

)