;;;=================================================================
;;;
;;; RB.LSP V2.02
;;;
;;; Refait les blocs de la couleur dubloc et sur le calque 0
;;;
;;; Copyright (C) Patrick_35
;;;
;;;=================================================================

(defun c:rb( / *errrb* bl ent js lst nombl doc s sel)

  (defun *errrb* (msg)
    (or (member (strcase msg) '("FUNCTION CANCELLED" ""QUIT / EXIT ABORT"" "FONCTION ANNULEE" "QUITTER / SORTIR ABANDON"))
      (princ (strcat "\nErreur : " 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)
    )
  )

  (vl-load-com)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark doc)
  (setq s *error*
	*error* *errrb*
  )
  (princ "\nSélectionnez les blocs <Tout les blocs> : ")
  (if (setq sel (ssget (list (cons 0 "insert"))))
    (progn
      (vlax-for bl (setq sel (vla-get-activeselectionset doc))
	(or (member (setq nom (nombl bl)) lst)
	  (setq lst (cons nom lst))
	)
      )
;      (foreach nom lst
;	(if js
;	  (setq js (strcat js "," nom))
;	  (setq js nom)
;	)
;      )
      (vla-delete sel)
    )
    (setq js "*")
  )

  ; ----------------------------------------------------------------
  ; Modifications dans la table des blocs
  ; ----------------------------------------------------------------

  (vlax-for bl (vla-get-blocks doc)
    (and (eq (vla-get-islayout bl) :vlax-false)
	 (or (eq js "*")
	     (member (vla-get-name bl) lst)
	 )
      (vlax-for ent bl

	; Forcer sur calque 0
	(vla-put-layer ent "0")

	; Forcer la couleur sur Dubloc
	(vla-put-color ent 0)

	; Forcer le type de ligne sur Dubloc
	(vla-put-linetype ent "ByBlock")

	; Forcer l'épaisseur de ligne sur Dubloc
	(vla-put-lineweight ent -2)

      )
    )
  )

  ; ----------------------------------------------------------------
  ; Modifications dans la table des mlines
  ; ----------------------------------------------------------------

  (and (dictsearch (namedobjdict) "ACAD_MLINESTYLE")  
    (vlax-for bl (vla-item (vla-get-dictionaries doc) "ACAD_MLINESTYLE")

      ; Forcer la couleur des mlines en dubloc
      (vl-catch-all-apply 'vla-put-color (list bl 0))

    )
  )

  ; ----------------------------------------------------------------
  ; Modifications dans le dessin (pour les attributs)
  ; ----------------------------------------------------------------

  (and (ssget "x" (list (cons 0 "insert") (cons 66 1)))
    (progn
      (vlax-for bl (setq sel (vla-get-activeselectionset doc))
	(and (or (eq js "*")
		 (member (vla-get-name bl) lst)
	     )

	  ; Forcer la couleur des attributs sur Dubloc
	  (mapcar '(lambda(x)(vla-put-color x 0)) (vlax-invoke bl 'getattributes))

	)
      )
      (vla-delete sel)
    )
  )
  (vla-regen doc acAllViewports)
  (vla-endundomark doc)
  (setq *error* s)
  (princ)
)

(setq nom_lisp "RB")
(if (/= app nil)
  (if (= (strcase (substr app (1+ (- (strlen app) (strlen nom_lisp))) (strlen nom_lisp))) nom_lisp)
    (princ (strcat "..." nom_lisp " chargé."))
    (princ (strcat "\n" nom_lisp ".LSP Chargé.....Tapez " nom_lisp " pour l'éxecuter.")))
  (princ (strcat "\n" nom_lisp ".LSP Chargé......Tapez " nom_lisp " pour l'éxecuter.")))
(setq nom_lisp nil)
(princ)