;;; 
;;; http://cadxp.com/topic/40143-rotation-dattribut-dun-bloc/page__pid__224216#entry224216
;;; Cette version traite AUSSI (en principe) les Blocs DYNAMIQUES ... 
;;; 


;;;=================================================================
;;;
;;; SYN.LSP V1.41
;;;
;;; Synchroniser en conservant ou pas la valeur, la position et l'angle des attributs.
;;;
;;; Copyright (C) Patrick_35  (mods CADforum.cz, 2019)
;;;
;;;=================================================================

(defun patrick:synchro_att(cmd / ang att blo boite_dialogue choix def doc ent lst lstbl msg nombl
				 oui-non pos question rep s sel str sty hgt val *errret*)

  (defun *errret* (msg)
    (or (member (strcase msg) '("FUNCTION CANCELLED" "QUIT / EXIT ABORT" "FONCTION ANNULEE" "QUITTER / SORTIR ABANDON"))
      (princ (strcat "\nError : " msg))
    )
    (vla-endundomark doc)
    (setq *error* s)
    (princ)
  )

  (defun nombl(bl)
    (if (vlax-property-available-p bl 'effectivename)
      (vla-get-effectivename bl)
      (vla-get-name bl)
    )
  )

  (defun msg(js)
    (if js
      (princ (strcat "\nCurrent selection : " js))
      (princ "\nCurrent selection : All")
    )
  )

  (defun choix(chx cmd / bl js lst nom sel)
    (princ "\nSelect block(s) : ")
    (and (ssget (list (cons 0 "insert") (cons 66 1)))
      (progn
	(vlax-for bl (setq sel (vla-get-activeselectionset doc))
	  (or (member (setq nom (nombl bl)) lst)
	    (setq lst (cons nom lst))
	  )
	  (redraw (vlax-vla-object->ename bl) 4)
	)
	(foreach nom lst
	  (and (eq (vla-get-isxref (vla-item (vla-get-blocks doc) nom)) :vlax-false)
	    (if js
	      (setq js (strcat js "," nom))
	      (setq js nom)
	    )
	  )
	)
	(vla-delete sel)
      )
    )
    (or js (setq js chx))
    (and cmd (msg js))
    js
  )

  (defun boite_dialogue(titre / blo choix_aucun choix_lst choix_tout chx dcl fil js liste_bl
				loc rech rep res sel str tmp vao)

    (defun choix_lst(val / pos lst)
      (while (setq pos (read val))
	(if lst
	  (setq lst (strcat lst "," (nth pos liste_bl)))
	  (setq lst (nth pos liste_bl))
	)
	(setq val (substr val (+ 2 (strlen (itoa pos)))))
      )
      (setq js lst
	    chx "Nom"
      )
    )

    (defun choix_tout(/ pos val str)
      (setq pos 0)
      (while (setq val (nth pos liste_bl))
	(if str
	  (setq str (strcat str " " (itoa pos)))
	  (setq str (itoa pos))
	)
	(setq pos (1+ pos))
      )
      (setq js nil
	    chx "Tout"
	    sel str
      )
      (set_tile "lst" sel)
    )

    (defun choix_aucun()
      (setq js nil
	    chx nil
	    sel ""
      )
      (set_tile "lst" sel)
    )

    (defun rech()
      (and (member (substr str 1 loc) liste_bl)
	   (setq vao (itoa (- (length liste_bl) (length (member (substr str 1 loc) liste_bl)))))
	(if sel
	  (setq sel (strcat sel " " vao))
	  (setq sel vao)
	)
      )
    )

    (setq tmp (vl-filename-mktemp "ret" nil ".dcl")
	  fil (open tmp "w")
    )
    (foreach txt '(	"ret : dialog {"
			"  key = titre;"
			"  is_cancel = true;"
			"  fixed_width = true;"
			"  alignment = centered;"
			"  : list_box {label = \"Blocks\"; key = \"lst\"; multiple_select = true; width = 40; height = 20;}"
			"  : boxed_column {"
			"    label = \"Keep into Attributes\";"
			"    : row {"
			"      : column {"
			"	: toggle {label = \"Values\";   key = \"val\";}"
			"	: toggle {label = \"Styles/heights\";    key = \"sty\";}"
			"      }"
			"      : column {"
			"	: toggle {label = \"Positions\"; key = \"pos\";}"
			"	: toggle {label = \"Angles\";    key = \"ang\";}"
			"      }"
;			"      : column {"
;			"	: toggle {label = \"Heights\"; key = \"hgt\";}"
;			;"	: toggle {label = \"Angles\";    key = \"ang\";}"
;			"      }"
			"    }"
			"    spacer;"
			"  }"
			"  spacer;"
			"  : row {"
			"    : button {label = \"All\";  key = \"tout\";}"
			"    : button {label = \"None\"; key = \"aucun\";}"
			"    : button {label = \">>\";    key = \"sel\";}"
			"    ok_cancel;"
			"  }"
			"}"
		 )
      (write-line txt fil)
    )
    (close fil)
    (vlax-for blo (vla-get-blocks doc)
      (or (wcmatch (vla-get-name blo) "`**,*|*")
	  (eq (vla-get-isxref blo) :vlax-true)
	(vlax-for ent blo
	  (and	(eq (vla-get-objectname ent) "AcDbAttributeDefinition")
		(not (member (vla-get-name blo) liste_bl))
	    (setq liste_bl (cons (vla-get-name blo) liste_bl))
	  )
	)
      )
    )
    (setq liste_bl (acad_strlsort liste_bl)
	  dcl (load_dialog tmp)
	  sel ""
    )
    (while (not (member res '(0 1)))
      (new_dialog "ret" dcl "")
      (start_list "lst")
        (mapcar 'add_list liste_bl)
      (end_list)
      (set_tile "titre" titre)
      (set_tile "lst" sel)
      (set_tile "val" val)
      (set_tile "pos" pos)
      (set_tile "ang" ang)
      (set_tile "sty" sty)
;      (set_tile "hgt" hgt)
      (action_tile "lst"    "(choix_lst $value)")
      (action_tile "tout"   "(choix_tout)")
      (action_tile "aucun"  "(choix_aucun)")
      (action_tile "val"    "(setq val $value)")
      (action_tile "pos"    "(setq pos $value)")
      (action_tile "ang"    "(setq ang $value)")
      (action_tile "sty"    "(setq sty $value)")
;      (action_tile "hgt"    "(setq hgt $value)")
      (action_tile "sel"    "(done_dialog 2)")
      (action_tile "accept" "(done_dialog 1)")
      (action_tile "cancel" "(done_dialog 0)")
      (setq res (start_dialog))
      (cond
	((eq res 1)
	  (setq rep (list chx js val pos ang sty hgt))
	)
	((eq res 2)
	  (and (setq js (choix js nil))
	    (progn
	      (setq str js
		    sel nil
		    chx "Nom"
	      )
	      (while (setq loc (vl-string-search "," str))
		(rech)
		(setq str (substr str (+ 2 loc)))
	      )
	      (rech)
	      (or sel (setq sel ""))
	    )
	  )
	)
	(T
	  (setq rep (list nil nil val pos ang sty hgt))
	)
      )
    )
    (unload_dialog dcl)
    (vl-file-delete tmp)
    rep
  )

  (defun question(/ choixbl lst rep sel)

    (defun choixbl(chx / js nom pos sel)
      (defun nom(txt / str)
	(setq txt (vl-string-left-trim  " " txt)
	      txt (vl-string-right-trim " " txt)
	)
	(if (tblsearch "block" txt)
	  (setq str txt)
	  (princ (strcat "\nThe block \"" txt "\" does not exist "))
	)
	(and str
	  (if (and js (wcmatch (strcase js) (strcase (strcat str "," str "`,*" ",*`," str "`,*,*`," str))))
	    (princ (strcat "\nThe block \"" str "\" is already selected "))
	    (if js
	      (setq js (strcat js "," str))
	      (setq js str)
	    )
	  )
	)
      )

      (setq js chx)
      (while (/= (setq sel (getstring t "\nGive the name(s) of block(s) : ")) "")
	(while (setq pos (vl-string-search "," sel))
	  (nom (substr sel 1 pos))
	  (setq sel (substr sel (+ 2 pos)))
	)
	(nom sel)
	(msg js)
      )
      (and (eq js chx) (msg js))
      js
    )

    (setq sel "Tout" rep sel)
    (while (/= sel "Fin")
      (initget "Tout Selection Nom Fin")
      (or (setq sel (getkword (strcat "\nChoice of the blocks [Tout (all)/ Selection / Nom (name) / Fin (end)] <" sel "> : ")))
	(progn
	  (setq sel rep)
	  (and (eq rep "Tout")
	    (setq sel "Fin")
	  )
	)
      )
      (cond
	((eq sel "Tout")
	  (setq rep sel)
	)
	((eq sel "Selection")
	  (setq rep sel
		lst (choix lst T) 
	  )
	)
	((eq sel "Nom")
	  (setq rep sel
		lst (choixbl lst) 
	  )
	)
      )
    )
    (list rep lst)
  )

  (defun oui-non(que o-n / rep)
    (initget "Yes No")
    (setq rep (getkword (strcat "\n" que " [Yes/No] <" (if (eq o-n "0") "No" "Yes") "> : ")))
    (cond
      ((eq rep "Yes")
	(setq rep "1")
      )
      ((eq rep "No")
	(setq rep "0")
      )
      (T
	(setq rep o-n)
      )
    )
  )

  (vl-load-com)
  (setq doc (vla-get-activedocument (vlax-get-acad-object))
	s *error*
	*error* *errret*
  )
  (vla-startundomark doc)
  (or (setq val (getenv "Patrick_35_syn_val"))
    (setq val "1")
  )
  (or (setq pos (getenv "Patrick_35_syn_pos"))
    (setq pos "0")
  )
  (or (setq ang (getenv "Patrick_35_syn_ang"))
    (setq ang "0")
  )
  (or (setq sty (getenv "Patrick_35_syn_sty"))
    (setq sty "0")
  )
;  (or (setq hgt (getenv "Patrick_35_syn_hgt"))
;    (setq hgt "0")
;  )
  (if (and (or
	     (and (eq cmd 0)
		  (setq rep (boite_dialogue "SYN V1.41c")
			val (nth 2 rep)
			pos (nth 3 rep)
			ang (nth 4 rep)
			sty (nth 5 rep)
			hgt (nth 6 rep)
			rep (list (nth 0 rep) (nth 1 rep))
		  )
	     )
	     (and (eq cmd 1)
		  (setq rep (question))
		  (setq val (oui-non "Keep values of attributes"   val))
		  (setq pos (oui-non "Keep position of attributes" pos))
		  (setq ang (oui-non "Keep angle of attributes" ang))
		  (setq sty (oui-non "Keep style of attributes" sty))
;		  (setq hgt (oui-non "Keep height of attributes" hgt))
	     )
	   )
	   (car rep)
      )
    (progn
      (or (eq (car rep) "Tout")
	  (cadr rep)
	(setq rep (list "Tout" nil))
      )
      (and 
	(if (cadr rep)
	  (ssget "_x" (list (cons 0 "insert") (cons 2 (strcat "`**," (cadr rep))) (cons 66 1)))
	  (ssget "_x" (list (cons 0 "insert") (cons 66 1)))
	)
	(progn
	  (vlax-for blo (setq sel (vla-get-activeselectionset doc))
	    (setq str (nombl blo)
		  att nil
	    )
	    (and (or (eq (car rep) "Tout")
		     (and
		       (cadr rep)
		       (wcmatch (strcase (cadr rep)) (strcase (strcat str "," str "`,*" ",*`," str "`,*,*`," str)))
		     )
		 )
	      (progn
		(foreach ent (vlax-invoke blo 'getattributes)
		  (setq att (cons (list ent
					(vlax-get ent 'textstring)
					(vlax-get ent 'insertionpoint)
					(vlax-get ent 'textalignmentpoint)
					(vlax-get ent 'alignment)
					(vlax-get ent 'rotation)
					(vlax-get ent 'stylename)
					(vlax-get ent 'height)
					(vlax-get ent 'scalefactor)
				  )
				  att
			    )
		  )
		)
		(setq lst (cons (cons blo att) lst))
		(or (member (nombl blo) lstbl)
		  (setq lstbl (cons (nombl blo) lstbl))
		)
	      )
	    )
	  )
	  (vla-delete sel)
	  (and lst
	    (progn
	      (setq def (getvar "cmdecho"))
	      (setvar "cmdecho" 0)
	      (vlax-for blo (vla-get-blocks doc)
		(and (eq (vla-get-islayout blo) :vlax-false)
		     (setq str (vla-get-name blo))
		     (member str lstbl)
		  (progn
		    (vl-cmdf "_.attsync" "_name" str)
		    (princ (strcat (chr 8) " for the block " str "."))
		  )
	        )
	      )
	      (setvar "cmdecho" def)
	      (and (or (eq val "1") (eq pos "1") (eq ang "1") (eq sty "1") (eq hgt "1"))
		(foreach blo lst
		  (mapcar '(lambda(a)
			    (and (eq val "1")
			      (vl-catch-all-apply 'vlax-put (list (nth 0 a) 'textstring (nth 1 a)))
			    )
			    (and (eq sty "1")
			      (progn
				(vl-catch-all-apply 'vlax-put (list (nth 0 a) 'stylename   (nth 6 a)))
				(vl-catch-all-apply 'vlax-put (list (nth 0 a) 'height      (nth 7 a)))
				(vl-catch-all-apply 'vlax-put (list (nth 0 a) 'scalefactor (nth 8 a)))
			      )
			    )
			    (and (eq pos "1")
			      (vl-catch-all-apply 'vla-move (list (nth 0 a) (vla-get-insertionpoint (nth 0 a)) (vlax-3d-point (nth 2 a))))
			    )
			    (and (eq ang "1")
			      (vl-catch-all-apply 'vlax-put (list (nth 0 a) 'rotation (nth 5 a)))
			    )
			  )
			  (reverse (cdr blo))
		  )
		)
	      )
	      (setenv "Patrick_35_syn_val" val)
	      (setenv "Patrick_35_syn_pos" pos)
	      (setenv "Patrick_35_syn_ang" ang)
	      (setenv "Patrick_35_syn_sty" sty)
	    )
	  )
	)
      )
    )
  )
  (vla-endundomark doc)
  (setq *error* s)
  (princ)
)

(defun c:syn()
  (if (zerop (getvar "cmddia"))
    (patrick:synchro_att 1)
    (patrick:synchro_att 0)
  )
)

(defun c:-syn()
  (patrick:synchro_att 1)
)

(setq nom_lisp "SYN")
(if app
  (if (= (strcase (substr app (1+ (- (strlen app) (strlen nom_lisp))) (strlen nom_lisp))) nom_lisp)
    (princ (strcat "..." nom_lisp " loaded."))
    (princ (strcat "\n" nom_lisp ".LSP loaded.... On keyboard: " nom_lisp " to run.")))
  (princ   (strcat "\n" nom_lisp ".LSP loaded.... On keyboard: " nom_lisp " to run.")))
(setq nom_lisp nil)
(princ)