Changer la casse d\'un prénom composé

[fabcad]

Bonjour voici une sous-routine qui fonctionne mais je ne trouve pas élégant mon :

(setq prenom_a_modifier (substr chaine_temporaire 2)) 

afin d'enlever mon trait d'union qui se trouve en 1ere positon de mon prénom composé concaténé dans cet exemple : "jean-rené-charles" devient "-Jean-René-Charles"

Merci pour vos idées,

Fabcad

 

;;; Fonction permettant de changer la casse d'un prénom en vérifiant l'existence d'un prénom composé
(defun casse_prenom (/ pos)
 (setq prenom_a_modifier "jean-rené-charles")
 (setq pos (vl-string-search "-" prenom_a_modifier))
 (if pos
   (progn
     ;; Séparation en plusieurs mots du prenom en cours
     (setq liste_prenoms (dos_strtokens prenom_a_modifier "-" T))
     ;; Comptage du nombre de mots dans la liste créee par dos_strtokens
     (setq nombre_mots (length liste_prenoms))
     (setq liste_retournee (mapcar '(lambda (x)
                                      (strcat (strcase (substr x 1 1))
                                              (strcase (substr x 2) T)
                                      )
                                    )
                                   liste_prenoms
                           ) ;_ fin mapcar
     ) ;_ fin setq liste_retournee
     (setq i 0)
     (setq chaine_temporaire "")
     (while (<= i (- nombre_mots 1))
       (setq prenom_a_modifier (nth i liste_retournee))
       (setq
         chaine_temporaire (strcat chaine_temporaire "-" prenom_a_modifier)
       )
       (setq i (+ i 1))
     ) ;_ fin while
     [b]
     ;; ICI afin d'enlever le trait d'union qui se trouve en tete de la chaine_temporaire [/b]
     (setq prenom_a_modifier (substr chaine_temporaire 2))
   ) ;_ fin progn de la 1ere condition
   ;; sinon
   (setq prenom_a_modifier (strcat (strcase (substr prenom_a_modifier 1 1))
                                   (strcase (substr prenom_a_modifier 2) T)
                           )
   )
 ) ;_ fin if pos
 (princ)
 prenom_a_modifier
) ;_ fin defun casse_prenom

[Edité le 7/10/2009 par fabcad][Edité le 7/10/2009 par fabcad]

[Bred]

Salut,

j'avoue ne pas comprendre quel est ton but...

 

Et je ne peux faire fonctionner ta routine car il manque "dos_strtokens"...

[bonuscad]

Idem que Bred, je n'utilise pas DOS-LIB.

 

Mais,

afin d'enlever mon trait d'union

 

(vl-string-translate "-" " " "jean-rené-charles")

 

-> "jean rené charles"

 

Cela ne conviendrait-il pas?

[Tramber]

Coucou, moi j'ai Dos-lib.

 

Mais quel est ton but ?

[fabcad]

J'ai a traiter des noms de voies et de séparer chaque terme du nom de voie dans des catégories.

J'ai fini mon programme mais il me reste cette petite conversion de prénoms composés :

 

jean-rené-charles ou JEAN-RENÉ-CHARLES en Jean-René-Charles

 

 

Merci mais dos_strtokens permet de séparer les mots et aussi créer en même temps une liste.

 

exemple la chaine de caractères jean-rené-charles traitée par (dos_strtokens "jean-rené-charles" "-" T) donne une liste ("jean' "rené" "charles") qui permet ensuite avec length de compter le nombre de mots.

 

Si vous avez trouvé la meme chose en Visual LISP, je suis preneur.

 

Par contre, je reste en attente pour la question posée,

 

Merci,

 

a+[Edité le 7/10/2009 par fabcad]

 

[Edité le 7/10/2009 par fabcad]

[(gile)]

Salut,

 

Je n'utilise pas DosLib non plus (je n'aime pas trop les bibliothèques faites par d'autres et en plus, celle là, il faut la mettre à jour à chaque nouveau format de dwg/arx), mais j'ai souvent donné ici deux petites routines : une qui transforme une chaine avec séparateur en liste de chaînes et la fonction inverse qui concatène une liste de chaînes avec un séparateur.

 

;; str2lst (gile)
;; Transforme un chaine avec séparateur en liste de chaines
;;
;; Arguments
;; str : la chaine à transformer en liste
;; sep : le séparateur
;;
;; Exemples
;; (str2lst "a b c" " ") -> ("a" "b" "c")
;; (str2lst "1,2,3" ",") -> ("1" "2" "3")
;; (mapcar 'read (str2lst "1,2,3" ",")) -> (1 2 3)

(defun str2lst (str sep / pos)
 (if (setq pos (vl-string-search sep str))
   (cons (substr str 1 pos)
  (str2lst (substr str (+ (strlen sep) pos 1)) sep)
   )
   (list str)
 )
)

;; lst2str (gile)
;; Concatène une liste et un séparateur en une chaine
;;
;; Arguments
;; lst : la liste à transformer en chaine
;; sep : le séparateur
;;
;; Exemples
;; (lst2str '("1" "2" "3") ",") -> "1,2,3"
;; (lst2str '("a" "b" "c") " ") -> "a b c"

(defun lst2str (lst sep)
 (if (cdr lst)
   (strcat (car lst)
    sep
    (lst2str (cdr lst) sep)
   )
   (car lst)
 )
)

 

Il suffit ensuite d'appeler ces deux fonctions :

 

(defun PrenomCompose (prenom)
 (lst2str
   (mapcar
     (function
       (lambda (x)
         (strcat (strcase (substr x 1 1)) (strcase (substr x 2) T))
       )
     )
     (str2lst prenom "-")
   )
   "-"
 )
)

 

_$ (PrenomCompose "jean-rené-charles")

"Jean-René-Charles"

_$ (PrenomCompose "JEAN-RENÉ-CHARLES")

"Jean-René-Charles"

 

 

[bonuscad]

Ma contribution en VL

 

(defun strcase-first ( n / l l_rv )
 (cond
   ((eq (type n) 'STR)
     (setq l (vl-string->list (strcase n T)))
     (if (and (> (cadr l) 96) (< (cadr l) 123))
       (setq l (cons (- (car l) 32) (cdr l)))
     )
     (while l
       (cond
         ((and (eq (car l) 45) (cadr l) (> (cadr l) 96) (< (cadr l) 123))
           (setq
             l_rv (cons (- (cadr l) 32) (cons 45 l_rv))
             l (cddr l)
           )
         )
         (T
           (setq
             l_rv (cons (car l) l_rv)
             l (cdr l)
           )
         )
       )
     )
     (vl-list->string (reverse l_rv))
   )
   (T n)
 )
)

 

Commande: (strcase-first "jour-mois-année")

"Jour-Mois-Année"

Commande: (strcase-first "CHARLES-ANTOINE-ALEXANDRE")

"Charles-Antoine-Alexandre"

 

[Edité le 7/10/2009 par bonuscad]

[fabcad]

Merci pour vos réponses, je vais pouvoir pour cette sous-routine me passer effectivement des fonctions Doslib.

 

A+

 

Fabrice