(defun c:ch_attribut(/ ordre blocd etiquetted nouvelle ancienne filtre selection ptr nbrmod entite pripriete actuelle k a)

 (write-line "\nTéléchargé depuis le site Internet http://www.decker-cs.com")

 (write-line "Auteur : Christian Decker")

 ;

 (write-line "Changer la valeur d'un attribut.")

 ;

 (while              ;Attend la sélection d'une méthode.

  (and             

   (/= ordre "CHA")

   (/= ordre "SUB")

   (/= ordre "DWG")

   (/= ordre "PRE")

   (/= ordre "SUF")

  )

  (setq ordre(strcase(getstring "Méthode (CHAnger / SUBstituer / DWGname / PREfixe / SUFfixe) : ")))

  (if (> (strlen ordre) 3)             ;La chaîne contient au moins quatre caractères.

   (setq ordre(substr ordre 1 3))      ;Préserve uniquement les trois premiers caractères de la chaîne.

  )

 )

 (if

  (or

   (= ordre "CHA")

   (= ordre "PRE")

   (= ordre "DWG")

   (= ordre "SUF")

   (= ordre "SUB")

  )

  (progn

   (if (= ordre "CHA")                ;Saisie des données avec l'option Changer.

    (progn

     (setq blocd(strcase(getstring "Nom du bloc contenant l'attribut à modifier : ")))

     (setq etiquetted(strcase(getstring "Etiquette de l'attribut à modifier : " 1))) 

     (setq nouvelle(getstring "Nouvelle valeur : " 1))

    )

   )

   (if (= ordre "SUB")                ;Saisie des données avec l'option Substituer.

    (progn

     (setq blocd(strcase(getstring "Nom du bloc contenant l'attribut à modifier : ")))

     (setq etiquetted(strcase(getstring "Etiquette de l'attribut à modifier : " 1)))

     (setq ancienne "")

     (while (= ancienne "")              ;Attend une occurrence de texte non nulle.

      (setq ancienne(getstring "Ancienne chaîne de caractères : " 1))

      (if (= ancienne "")                   ;La chaîne est vide.

       (write-line "L'ancienne chaîne de caractères doit être non nulle.")

      )

     )

     (setq nouvelle(getstring "Nouvelle chaîne de caractères : " 1))

    )

   )

   (if (= ordre "DWG")                ;Saisie des données avec l'option Dwgname.

    (progn

     (setq blocd(strcase(getstring "Nom du bloc contenant l'attribut à modifier : ")))

     (setq etiquetted(strcase(getstring "Etiquette de l'attribut à modifier : " 1)))

    )

   )

   (if (= ordre "PRE")                ;Saisie des données avec l'option Préfixe.

    (progn

     (setq blocd(strcase(getstring "Nom du bloc contenant l'attribut à modifier : ")))

     (setq etiquetted(strcase(getstring "Etiquette de l'attribut à modifier : " 1)))

     (setq nouvelle(getstring "Préfixe : " 1))

    )

   )

   (if (= ordre "SUF")                ;Saisie des données avec l'option Suffixe.

    (progn

     (setq blocd(strcase(getstring "Nom du bloc contenant l'attribut à modifier : ")))

     (setq etiquetted(strcase(getstring "Etiquette de l'attribut à modifier : " 1)))

     (setq nouvelle(getstring "Suffixe : " 1))

    )

   )

   (if (/= (tblsearch "BLOCK" blocd) nil)  ;La définition du bloc recherché existe dans le dessin.

    (progn

     (setq filtre(list (cons '0 "INSERT") (cons '2 blocd)))

     (setq selection(ssget "X" filtre))       ;Crée un jeu de sélection.

     (if (/= selection nil)                   ;Au moins un bloc trouvé dans le dessin.

      (progn

       (setq ptr 0)

       (setq nbrmod 0)

       (while (< ptr (sslength selection))       ;Pour chaque bloc dans le jeu de sélection...

        (setq entite(entnext(ssname selection ptr)))  ;Extraction du bloc.

        (while (and (/= entite nil) (/= (cdr(assoc '0 (entget entite))) "SEQEND"))   ;Pour chaque attribut du bloc...

         (setq propriete(entget entite))                 ;Extraction des propriétés de l'attribut.

         (if (= (cdr(assoc '2 propriete)) etiquetted)    ;L'attribut doit être modifié.

          (progn                                                  

           (if (= ordre "CHA")                              ;Option Changer.

            (progn

             (setq propriete(subst(cons '1 nouvelle) (assoc '1 propriete) propriete))

             (entmod propriete)

             (entupd entite)

             (setq nbrmod(+ nbrmod 1))

            )

           )

           (if (= ordre "SUB")                              ;Option Substituer.

            (progn

             (setq actuelle(cdr(assoc '1 propriete)))          ;Extrait la valeur de l'attribut.

             (setq k 1)                                        ;Positionne le pointeur sur le 1er caractère de la valeur de l'attribut.

             (setq a 0)                                        ;Sera égal à 1 si l'attribut est modifié.

             (while (and (<= k (strlen actuelle)) (>= (- (strlen actuelle) (- k 1)) (strlen ancienne)))

              ;

              ;Tant que k est inférieure ou égale à la longueur de la chaîne actuelle, et tant que

              ;(la longueur de la chaîne actuelle - (la position du pointeur - 1)) est égale ou

              ;supérieure à la longueur de l'occurrence du texte à rechercher.

              ;

              (if (= (substr actuelle k (strlen ancienne)) ancienne)

               (progn

                ;       

                ;Le pointeur est sur le 1er caractère de l'occurrence du texte recherché.

                ;

                ;Remplace l'occurrence de texte par la nouvelle valeur :

                ;1) Récupère les caractères situés en amont du pointeur.

                ;2) Ajoute la nouvelle valeur.

                ;3) Récupère les caractères situés en aval de l'occurrence de texte.

                ;

                (setq actuelle

                 (strcat

                  (substr actuelle 1 (- k 1))

                  nouvelle

                  (substr actuelle (+ k (strlen ancienne)) (- (strlen actuelle) (+ (- k 1) (strlen ancienne))))

                 )

                )

                ;Ajuste la position du pointeur sur le dernier caractère de la nouvelle valeur insérée.

                (setq k(+ (- k 1) (strlen nouvelle)))  

                (setq a 1)           ;La valeur de l'attribut est modifiée.

               )

              )

              (setq k(+ k 1))     ;Incrémente l'index du pointeur.

             )

             (if (= a 1)

              (progn

               (setq propriete(subst(cons '1 actuelle) (assoc '1 propriete) propriete))

               (entmod propriete)

               (entupd entite)

               (setq nbrmod(+ nbrmod 1))

              )

             )

            )

           )

           (if (= ordre "DWG")                              ;Option Dwgname.

            (progn

             (setq propriete(subst(cons '1 (getvar "DWGNAME")) (assoc '1 propriete) propriete))

             (entmod propriete)

             (entupd entite)

             (setq nbrmod(+ nbrmod 1))

            )

           )

           (if (= ordre "PRE")                              ;Option Préfixe.

            (progn

             (setq propriete(subst(cons '1 (strcat nouvelle (cdr(assoc '1 propriete)))) (assoc '1 propriete) propriete))

             (entmod propriete)

             (entupd entite)

             (setq nbrmod(+ nbrmod 1))

            )

           )

           (if (= ordre "SUF")                              ;Option Suffixe.

            (progn

             (setq propriete(subst(cons '1 (strcat (cdr(assoc '1 propriete)) nouvelle)) (assoc '1 propriete) propriete))

             (entmod propriete)

             (entupd entite)

             (setq nbrmod(+ nbrmod 1))

            )

           )

          )

         )   

         (setq entite(entnext entite))      ;Sélectionne l'attribut suivant du bloc.

        )

        (setq ptr(+ ptr 1))              ;Incrémente l'index du jeu de sélection des blocs.

       )

       (write-line (strcat "Nombre de blocs trouvés : " (itoa (sslength selection))))

       (write-line (strcat "Nombre d'attributs modifiés : " (itoa nbrmod)))

       (princ)

      )

     )

    )

   )

  )

 )