(defun c:Du_textesfichier(/ fichier modsel c1 c2 jeu entite index sens ligneav ligneap identificateur propriete valeur position nbrtextes f positionactu ptr1 ptr2 a indexinvalide indexposition)

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

 (write-line "Auteur : Christian Decker")

 ;

 ;----------- SAISIE UTILISATEUR ----------

 ;

 (write-line "Dupliquer une colonne de textes dans un fichier.")

 ;

 (setq fichier(getstring "Fichier à renseigner : "))

 (setq jeu(ssget))

 (if (= jeu nil)

  (progn

   (write-line "Aucun objet sélectionné.")

   (princ)

  )

 )

 (while              ;Prend les paramètres, même sans objet sélectionné, pour utilisation

  (and               ;avec un générateur de script (évite le plantage du script).

   (/= sens "H")

   (/= sens "V")

  )

  (setq sens(strcase(getstring "Sens de lecture (Horizontal / Vertical) : ")))

  (if (> (strlen sens) 0)              ;La chaîne contient au moins un caractère.

   (setq sens(substr sens 1 1))        ;Préserve uniquement le premier caractère de la chaîne.

  )

 )

 (while

  (and

   (/= ligneav "O")

   (/= ligneav "N")

  )

  (setq ligneav(strcase(getstring "Générer une ligne vide dans le fichier avant écriture (Oui / Non) : ")))

  (if (> (strlen ligneav) 0)              ;La chaîne contient au moins un caractère.

   (setq ligneav(substr ligneav 1 1))     ;Préserve uniquement le premier caractère de la chaîne.

  )

 )

 (while

  (and

   (/= ligneap "O")

   (/= ligneap "N")

  )

  (setq ligneap(strcase(getstring "Générer une ligne vide dans le fichier après écriture (Oui / Non) : ")))

  (if (> (strlen ligneap) 0)              ;La chaîne contient au moins un caractère.

   (setq ligneap(substr ligneap 1 1))     ;Préserve uniquement le premier caractère de la chaîne.

  )

 )

 (while

  (and

   (/= identificateur "O")

   (/= identificateur "N")

  )

  (setq identificateur(strcase(getstring "Ajouter une colonne pour l'identification des données (Oui / Non) : ")))

  (if (> (strlen identificateur) 0)                     ;La chaîne contient au moins un caractère.

   (setq identificateur(substr identificateur 1 1))     ;Préserve uniquement le premier caractère de la chaîne.

  )

 )

 (if (= identificateur "O")

  (setq identificateur(getstring t "Identificateur : " ))

  (setq identificateur nil)

 )

 ;

 ;----------- FIN SAISIE UTILISATEUR ----------

 ;

 ;

 ;----- SELECTION DES TEXTES ET MISE EN LISTE DES POSITIONS ET DES VALEURS -----

 ;

 (if (/= jeu nil)

  (progn

   (setq index 0)

   (setq nbrtextes 0)

   (repeat (sslength jeu)                                          ;Scrute le jeu de sélection.

    (setq entite(ssname jeu index))

    (if (= (cdr(assoc '0(entget entite))) "TEXT")                     ;L'entité est un texte.

     (progn

      (setq propriete(entget entite))

      (setq valeur(cons (cdr(assoc '1 propriete)) valeur))               ;Ajoute la valeur dans la liste "valeur".

      (if (= sens "H")

       (setq position(cons (car(cdr(assoc '10 propriete))) position))       ;Ajoute X dans la liste "position" dans le sens horizontal.

       (setq position(cons (car(cdr(cdr(assoc '10 propriete)))) position))  ;Ajoute Y dans la liste "position" dans le sens vertical.

      )

      (setq nbrtextes(+ nbrtextes 1))                                    ;Compte le nombre de textes sélectionnés.

     )

    )

    (setq index(+ index 1))                                           ;Cible la prochaine entité dans le jeu de sélection.

   )

   (if (= nbrtextes 0)

    (progn

     (write-line "Aucun texte sélectionné.")

     (princ)

    )

   )

  )

 )

 ;

 ;--- FIN SELECTION DES TEXTES ET MISE EN LISTE DES POSITIONS ET DES VALEURS ---

 ;

 ;

 ;---------- ECRITURE DES VALEURS DANS LE FICHIER ----------

 ;

 (if (/= jeu nil)

  (progn

   (setq index 0)

   (setq f(open fichier "a"))            ;Crée le fichier s'il n'existe pas, ou, ajoute les données à la fin du fichier.

   (if (= ligneav "O")                   ;Adjonction d'une ligne vide avant écriture.

    (progn

     (princ (chr 13) f)

     (princ (chr 10) f)

    )

   )

   (repeat (length valeur)              ;Cherche les valeurs sélectionnées suivant l'ordre de tri demandé par l'utilisateur.

    ;

    ;---------- RECHERCHE LA PROCHAINE VALEUR A ECRIRE DANS LE FICHIER ----------

    ;

    (setq positionactu nil)                ;Cible la position la plus petite.

    (setq ptr1 0)                          ;Pointeur de la liste valeur.

    (repeat (length valeur)                ;Cherche la position (X ou Y) la moins élevée parmi les valeurs non sauvegardées.

     (setq ptr2 0)                            ;Pointeur de la liste "indexinvalide".

     (setq a 0)                               ;Initialisation de l'état de la recherche.

     (while

      (and

       (= a 0)

       (< ptr2 (length indexinvalide))

      )

      (if (= (nth ptr2 indexinvalide) ptr1)      ;La valeur stockée à l'index courant est déjà sauvegardée.

       (setq a 1)

      )

      (setq ptr2(+ ptr2 1))                   ;Incrémente l'index de la liste "indexinvalide".

     )

     (if (= a 0)                                              ;La valeur stockée à l'index courant n'est pas encore sauvegardée.

      (progn

       (if (= positionactu nil)                                  ;Première position valide (démarrage).

        (progn

         (setq positionactu(nth ptr1 position))

         (setq indexposition ptr1)

        )

        (progn                                                   ;Position valide à comparer avec la position actuelle.

         (if (= sens "H")

          (progn                                                    ;Sens horizontal demandé (de gauche à droite).

           (if (< (nth ptr1 position) positionactu)                    ;La nouvelle position valide est plus petite

            (progn                                                     ;que la position actuelle.

             (setq positionactu(nth ptr1 position))

             (setq indexposition ptr1)

            )

           )

          )

          (progn                                                    ;Sens vertical demandé (de haut en bas).

           (if (> (nth ptr1 position) positionactu)                    ;La nouvelle position valide est plus grande

            (progn                                                     ;que la position actuelle.

             (setq positionactu(nth ptr1 position))

             (setq indexposition ptr1)

            )

           )

          )

         )

        )

       )

      )

     )

     (setq ptr1(+ ptr1 1))

    )

    (setq indexinvalide(cons indexposition indexinvalide))          ;Sauvegarde l'index.

    ;                                                     

    ;---------- FIN RECHERCHE LA PROCHAINE VALEUR A ECRIRE DANS LE FICHIER ----------

    ;

    ;---------- ECRITURE DE LA VALEUR DANS LE FICHIER ----------

    ;

    (if (= identificateur nil)                            ;Ne pas ajouter l'identificateur de données.

     (princ (nth indexposition valeur) f)                    ;Ecriture de la valeur dans le fichier.

     (progn                                               ;Ajouter l'identificateur de données.

      (princ (nth indexposition valeur) f)                   ;Ecrit la valeur dans le fichier.

      (princ (chr 9) f)                                      ;Ajoute le séparateur de colonnes.

      (princ identificateur f)                               ;Ajoute l'identificateur de données.

     )

    )

    (princ (chr 13) f)

    (princ (chr 10) f)

    ;

    ;---------- FIN ECRITURE DE LA VALEUR DANS LE FICHIER ----------

    ;

   )

   (if (= ligneap "O")        ;Demande d'une ligne vide après écriture.

    (progn

     (princ (chr 13) f)

     (princ (chr 10) f)

    )

   )

   (close f)

   (princ)

   ;

   ;--------- FIN ECRITURE DES VALEURS DANS LE FICHIER ----------

   ;

  )   

 )