;;     Binder Blocks
;;     Copyright (C) 2004-2013 Roberto Rossi e Stefano Ferrario.
;; 
;;     Questo  programma è  software  libero; è  lecito redistribuirlo  o
;;     modificarlo secondo i termini  della Licenza Pubblica Generica GNU
;;     come è pubblicata dalla Free  Software Foundation; o la versione 2
;;     della licenza o (a propria scelta) una versione successiva.
;; 
;;     Questo programma  è distribuito nella  speranza che sia  utile, ma
;;     SENZA  ALCUNA GARANZIA;  senza  neppure la  garanzia implicita  di
;;     NEGOZIABILITÀ  o di  APPLICABILITÀ PER  UN PARTICOLARE  SCOPO.  Si
;;     veda la Licenza Pubblica Generica GNU per avere maggiori dettagli.
;; 
;;     Questo  programma deve  essere  distribuito assieme  ad una  copia
;;     della Licenza Pubblica Generica GNU;  in caso contrario, se ne può
;;     ottenere  una scrivendo  alla Free  Software Foundation,  Inc., 59
;;     Temple Place, Suite 330, Boston, MA 02111-1307 USA
;;
;;     Per contattare gli autori
;;                      Roberto Rossi
;;                          Web    : http://www.redchar.net
;;                      Stefano Ferrario  
;;



;Gestisce la rotazione dinamica dell'entità indicata.
;Come punto per la rotazione si assume puntoIns
(defun bbs_dynaRotate ( entita AngFromBlock / 
                        rotazione ang opz nextFlag quadrante 
                        initAng puntoIns
                        GetQ GetAngFromBlk GetAngBlk piD2 angTmp)
  (setq piD2 (strcat (rtos (/ pi 2)) "r"))
  (defun GetAngBlk (entita / el ang)
    (setq ang nil)
    (setq el (entget entita))
    (if (= (cdr (assoc 0 el)) "INSERT")
      (setq ang (cdr (assoc 50 el)))
    )
  ang
  )
  
  (defun GetAngFromBlk ( / entita el ang)
    (while (not el)
      (setq entita (entsel "\nSelezionare blocco origine : "))
      (if entita
        (progn
          (setq entita (car entita))
          (setq ang (GetAngBlk entita))
          (if ang
            (setq el t)
          )
        );endp
      );endif
    );endw
  ang
  );enddef
  
  (defun GetQ ( angolo / )
    (if (> angolo 3.14)
      2
      1
    );endif
  );Enddef
  
(setq nextFlag t)

(setq initAng (GetAngBlk entita))
(setq puntoIns (cdr(assoc 10 (entget entita))))
(setq quadrante (GetQ initAng))
(redraw entita 3)
(setq ang initAng)
(if AngFromBlock
  (progn
    (if (setq ang (GetAngFromBlk))
      (progn
        ;(bbs_chprop entita 50 ang)
        (command "_.rotate" entita "" puntoIns "_r" 
          (strcat (rtos initAng) "r") (strcat (rtos ang) "r"))
          ;(setq initAng ang)
      );endp
    );endif
  );endp
);endif

(while nextFlag
  (initget 0 "Orario Antiorario oPposto oRiginale Libero Blocco Invio")
  (setq opz (getkword "\nRotazione [Orario/Antiorario/oPposto/Libero/oRiginale/da Blocco/Invio per terminare] :"))
  (if (and opz (/= opz "Invio"))
    (progn
      (cond
        ((= opz "oRiginale")
          (command "_.rotate" entita "" puntoIns "_r" 
            (strcat (rtos ang) "r") (strcat (rtos initAng) "r"))
          (setq ang initAng)
        )
        ((= opz "Orario")
            (command "_.rotate" entita "" puntoIns "-90d")
            (setq ang (GetAngBlk entita))
        )
        ((= opz "Antiorario")
            (command "_.rotate" entita "" puntoIns "+90d")
            (setq ang (GetAngBlk entita))
        )
        ((= opz "oPposto")
          (command "_.rotate" entita "" puntoIns "180d")
          (setq ang (GetAngBlk entita))
        )
        ((= opz "Libero")
          (command "_.rotate" entita "" puntoIns "_r" "" pause)
          (setq ang (GetAngBlk entita))
        )
        ((= opz "Blocco")
          (if (setq angTmp (GetAngFromBlk))
            (progn
              (command "_.rotate" entita "" puntoIns "_r" 
                (strcat (rtos ang) "r") (strcat (rtos angTmp) "r"))
              (setq ang angTmp)
            );endp
          );endif
        )
      );endc
    );Endp
    (setq nextFlag nil)
  );Endif
  (redraw entita 3)
);endw
(redraw entita 4)
);enddef

;inserisce un blocco
(defun bbs_insertBlk ( nome ;nome blocco (se viene specificato il percorso deve usare /)
                    rotazione
                    scala 
                    layer
                    colore
                    tipolinea
                    esploso
                    DynamicRotate 
                    redefine
                    /
                    el elemento id nchar flagOk gruppo ultimo
                    oldattreq onlyname pos)

  (setq flagOk nil
        el     nil
        ultimo nil
  )
  (setq nome (strcase nome))
  (if (tblsearch "BLOCK" nome)
    (setq flagOk t)
  );Endif
  
  (if (not flagOk)
    (progn
      (setq nchar (strlen nome))      
      (if (/= (substr nome (- nchar 3)) ".DWG")
        (setq nome (strcat nome ".DWG"))
      );endif
      (if (findfile nome)
        (setq flagOk t)
      );Endp
    );Endp
  );Endif

  (if flagOk
    (progn
      (if (= (substr nome (- (strlen nome) 3)) ".DWG")
        (progn
          (setq pos (bbs_str_posr nome "/"))
          (setq onlyname (substr nome (1+ pos)))
          (setq onlyname (substr onlyname 1 (- (strlen onlyname) 4)))
        )
        (setq onlyname name)
      );endif
      (if (not scala) (setq scala 1))
      (if (not rotazione) (setq rotazione 0))
      
      (setq ultimo (bbs_LastEntity))
      
      (setq oldattreq (getvar "ATTREQ"))
      (setvar "ATTREQ" 0)
      (command "_.undo" "_m")
      (princ "\nSpecificare punto di inserimento :")
      (if (and redefine (/= name onlyname))
        (progn
          (command "_.insert" (strcat onlyname "=" nome) "_y" "_s" scala "_r" rotazione pause)
        );Endp
        (command "_.insert" nome "_s" scala "_r" rotazione pause)
      );Endif
      (cond 
        ((= DynamicRotate 1)
          (bbs_dynaRotate (entlast) t)
        )
        ((= DynamicRotate 2)
          (bbs_dynaRotate (entlast) nil)
        )
      );Endif
      (setvar "ATTREQ" oldattreq)
      (if esploso
        (progn
          (command "_.explode" (entlast))
          (setq el ultimo)
          (setq gruppo (ssadd))
         	(if el
            (progn
          		(setq el (entnext el))
          		(while el
            		(setq gruppo (ssadd el gruppo))
            		(setq el (entnext el))
          		);Endw
            );Endp
          );endif
        );endp
        (setq gruppo (entlast))
      );endif
      (if layer (bbs_chprop gruppo 8 layer));endif
      (if colore (bbs_chprop gruppo 62 colore));endif
      (if tipolinea (bbs_chprop gruppo 6 tipolinea));endif
    );endp
    (princ (strcat "\nImpossibile inserire il blocco " nome " ! Blocco non trovato."))
  );Endif
gruppo
);Enddef

;modifica il codice di gruppo prop inserendo il valore specificato
;e aggiorna l'entità (ent)
(defun bbs_chprop (ent prop value / tipo en idx)
  (if ent
    (progn
      (setq tipo (type ent))
      (cond 
        ((= tipo 'ENAME)
          (bbs_chp ent prop value)
        )
        ((= tipo 'PICKSET)
          (setq idx (1- (sslength ent)))
          (while (> idx -1)
            (setq en (ssname ent idx))
            (bbs_chp ent prop value)
            (setq idx (1- idx))
          );endw
        )
      );endc
    );endp
  );Endif
);enddef

;cambia una proprietà specificata con il codice dxf ad un oggetto
(defun bbs_chp ( ent prop value / elemento old new)
(if ent
  (progn
    (setq elemento (entget ent))
    (setq old (assoc prop elemento))
    (setq new (cons prop value))
    (if old
      (setq elemento (subst new old elemento))
      (setq elemento (cons new elemento))
    );Endif
    (entmod elemento)
    (entupd ent)
  );Endp
);endif
);enddef

;ritorna l'ultima entità presente nel disegno
(defun bbs_LastEntity( / ent result)
 (setq ent (entlast))
 (setq result ent)
 (if ent
   (progn
		 (while (setq ent (entnext ent))
		   (setq result ent)   
		 );endw
   );endp
 );endif
result
);enddef

;cerca, in una stringa principale, una sottostringa.
(defun bbs_str_posr ( stringa chRicerca / ch pos len flagNext)
(if stringa
  (progn
    (setq len (strlen stringa))
    (setq ch len)
    (setq flagNext t)
    (setq stringa (strcase stringa))
    (setq chRicerca (strcase chRicerca))
    (while (and (> ch 0) flagNext)
      ;(if (= chRicerca (substr stringa ch 1))
      (if (= chRicerca (substr stringa ch (strlen chRicerca)))
        (progn
          (setq pos ch)
          (setq flagNext nil)
        );Endp
      )
      (setq ch (1- ch))
    );endw
  );Endp
);Endif
pos
);enddef
