texte et multitexte en MAJUSCULES

[harfang]

Bonjour les dessineux...

 

j'ai une question toute simple:

Peu t'on mettre automatiquement un texte ou multitexte en majuscule ou minuscule?

 

Merci pour votre réponse.

[lelise]

par le menu express/texte/changer la case d'un texte tu peux choisir tes texte par 'intermediaire d'un filtre si tu le veux et tous les mettre en majuscule ou la premiere lettre en majuscule et le reste en minuscule tu as ainsi 5 possibilitées

 

voila peut être la réponse à ce que tu as demandé

[Steven]

Pour le texte multiligne sans avoir besoin des express tools, il suffit de faire un clic droite dans l'éditeur de texte et sélection MAJ Auto. De ce faite, à chaque fois qu'on écris un texte multiligne, il se fera tout en majuscule automatiquement.

[fabcad]

Voila ma routine que j'avais faite il y a fort longtemps,

 

Voici le fichier DCL nomme ddchcase.dcl :

CHCASSE : dialog {

label = "Changer la casse";

: boxed_radio_column {

key = "Boutons";

: radio_button {

label = "Majuscule en début de phrase";

key = "MAJ-D";

}

: radio_button {

label = "Tout en minuscules";

key = "MINUSCULE";

}

: radio_button {

label = "Tout en majuscules";

key = "MAJUSCULE";

}

: radio_button {

label = "1ere lettre des mots en majuscule";

key = "1-MAJ";

}

}

ok_cancel;

}

 

Voici le fichier LISP nommé DDCHCASE.LSP :

 

; DDCHCASE.LSP

;---------------------------------------------------------------

; Permet de changer la casse d'un ou plusieurs textes

;---------------------------------------------------------------

; Le 24.02.99 - Fabrice DEMIEL.

;---------------------------------------------------------------

(defun c:ch-case (/ fic cou Ok)

 

(setq j-sel (ssget

'(

(-4 . "

 

(-4 . "")

(-4 . "")

(-4 . "")

 

(-4 . "OR>")

)

);ssget

);fin setq j-sel

 

 

 

(setq fic (load_dialog "Ddchcase.dcl"))

(if (not (new_dialog "CHCASSE" fic)) (exit))

(action_tile "Boutons" "(setq cou $value)")

(action_tile "accept" "(done_dialog 1)")

(action_tile "cancel" "(done_dialog 0)")

(setq Ok (start_dialog))

(unload_dialog fic)

(if (and (= 1 Ok) cou)

(cond

((= cou "MINUSCULE")

(progn

(princ "\n---Tout en minuscules")

(change T j-sel)

);fin progn

)

((= cou "MAJUSCULE")

(progn

(princ "\n---Tout en MAJUSCULES")

(change nil j-sel)

);fin progn

)

((= cou "1-MAJ")

(progn

(princ "\n---1ere lettre des mots en majuscule")

(majmin j-sel)

);fin progn

)

 

((= cou "MAJ-D")

(progn

(princ "\n---Majuscule en début de phrase")

(maj-1 j-sel)

);fin progn

)

);fin cond

);fin if

(prompt "\n---COPYRIGHT Février 1999 par Fabrice DEMIEL---")

(princ)

);fin defun

 

;;;------------------------------------------------------------

conversion MAJUSCULE en MINUSCULE et vice-versa

;;;------------------------------------------------------------

(defun change (ex js / tt m c1 i nbr)

(setq nbr (sslength js))

(setq i 0)

(while (<= i (- nbr 1))

(setq c1 (ssname js i))

(setq ent (entget c1))

(setq m (cdr (assoc 1 (entget c1))))

(setq tt (strcase m ex))

(setq ent (subst (cons 1 tt) (assoc 1 ent) ent))

(entmod ent)

(setq i (+ i 1))

)

(setvar "cmdecho" 1));fin defun change

;;;------------------------------------------------------------

(defun majmin (js / nbr i nom_ent ent chn chn-mod)

(setq nbr (sslength js))

(setq i 0)

(while (<= i (- nbr 1))

(setq nom_ent (ssname js i)) (setq ent (entget nom_ent))

(setq chn (cdr (assoc 1 ent))) (setq chn-mod (t-ligne chn))

(setq ent (subst (cons 1 chn-mod) (assoc 1 ent) ent))

(entmod ent)

(setq i (+ i 1))

); fin while

(setvar "cmdecho" 1)

); fin defun

;---------------------------------------------------------------

; sous-fonction permettant la suppression des espaces superflus

; paramètre global : ch

; paramètres locaux : n i bul a b

;---------------------------------------------------------------

(defun SUP_ES (ch / n i bul a b)

(setq n (strlen ch) b "")

(if (/= n 0)

(progn

(setq i 1 bul t)

(while (<= i n)

(setq a (substr ch i 1))

(if (/= a " ")

(progn

(setq b (strcat b a))

(setq bul nil)

);fin progn

(if (= bul nil)

(progn

(setq b (strcat b a))

(setq bul t)

); fin progn

);fin if

);fin if

(setq i (+ 1 i))

); fin while

(if (= (substr b (strlen b) 1) " ")

(setq b (substr b 1 (- (strlen b) 1)))

); fin if

); fin progn

); fin if

b

); fin

 

;;;------------------------------------------------------------------------

;;; sous-fonction permettant la vérification de certains mots clés

;;; met en minuscules les articles.

;;; paramètre global : chn

;;; paramètres locaux : néant

;;;------------------------------------------------------------------------

(defun cle (chn)

(cond

((= chn "De") (setq chn "de")) ((= chn "La") (setq chn "la"))

((= chn "DE") (setq chn "de")) ((= chn "LA") (setq chn "la"))

((= chn "de") (setq chn "de")) ((= chn "la") (setq chn "la"))

 

((= chn "DU") (setq chn "du")) ((= chn "du") (setq chn "du"))

((= chn "Du") (setq chn "du"))

 

((= chn "Et") (setq chn "et")) ((= chn "LE") (setq chn "Le"))

 

((= chn "Au") (setq chn "au")) ((= chn "A") (setq chn "à"))

((= chn "Aux") (setq chn "aux")) ((= chn "AUX") (setq chn "aux"))

((= chn "Dans") (setq chn "dans")) ((= chn "DANS") (setq chn "dans"))

 

((= chn "DES") (setq chn "des")) ((= chn "des") (setq chn "des"))

((= chn "Des") (setq chn "des"))

 

((= chn "SUR") (setq chn "sur")) ((= chn "SOUS") (setq chn "sous"))

((= chn "sur") (setq chn "sur")) ((= chn "sous") (setq chn "sous"))

 

((= chn "ALLEE") (setq chn "Allée"))

((= chn "Allee") (setq chn "Allée")) ((= chn "allee") (setq chn "Allée"))

((= chn "St") (setq chn "St"))

 

((= chn "CITE") (setq chn "Cité"))

((= chn "COTE") (setq chn "Côté"))

((= chn "Cote") (setq chn "Côté"))

((= chn "Coté") (setq chn "Côté"))

((= chn "Cite") (setq chn "Cité")) ((= chn "cite") (setq chn "Cité"))

((= chn "Sncf") (setq chn "S.N.C.F."))

((= chn "Za") (setq chn "ZA"))

((= chn "Zi") (setq chn "ZI"))

 

((= chn "DEPURATION") (setq chn "d'Epuration"))

 

);fin cond

chn

);fin cle

 

;;;------------------------------------------------------------------------

;;; sous-fonction permettant de changer la casse d'une ligne

;;; chaque mot est vérifié par la sous-fonction MAJ

;;; vérifie les signes de ponctuation entre chaque mot de la ligne.

;;; paramètre global : chaine

;;; paramètres locaux : lg-chaine mot carac i phrase

;;;------------------------------------------------------------------------

(defun t-ligne (chaine / lg-chaine mot carac i phrase)

; longueur numérique de la chaine

(setq lg-chaine (strlen chaine))

 

(setq i 1 mot " " phrase " ")

 

;parcours de la chaine du 1er au dernier caractère

(while (<= i lg-chaine)

 

;Test si le caractere courant est different

;d'1 caractere de ponctuation

(if (= (member (setq carac (substr chaine i 1)) '(" " "\\P" "\\L" "<" "," "-" "_" ":" "." "/" "|" "(" "(chr 34)")) nil)

; concaténation normale

(setq mot (strcat mot carac))

; sinon concaténation avec le signe de ponctuation

(progn

(setq ca (substr chaine i 1))

(setq mot (substr mot 2))

(if (/= mot (cle mot))

; différents tests sur le mot en cours

(setq mot (cle mot)) (setq mot (maj mot)));fin if

(setq phrase (strcat phrase (sup_es mot) ca))

(setq mot " ")

);fin progn

);fin si

(setq i (1+ i))

);fin while

(if (/= mot " ")

(progn

(setq mot (substr mot 2))

(if (/= mot (cle mot))

(setq mot (cle mot)) (setq mot (maj mot)));fin if

(setq phrase (strcat phrase (sup_es mot)))

);fin progn

);fin si

(setq phrase (SUP_ES phrase))

);fin defun verif-ligne

;;;------------------------------------------------------------------------

 

;;;------------------------------------------------------------------

;;; sous-fonction permettant de changer la casse d'un mot

;;; vérifie si les deux premiers caractères sont égaux

;;; à lettre + apostrophe.

;;; paramètre global : txte paramètres locaux : néant

;;;------------------------------------------------------------------------

(defun maj (txte /)

; si les deux premiers caractères du mot ne sont pas dans la liste

(if (= (member (substr txte 1 2) '("D'" "L'" "l'" "d'" "\\L" "\\P")) nil)

 

; faire une casse normale

(progn

(setq txte (strcat (strcase (substr txte 1 1))

(strcase (substr txte 2) T))); fin setq txte

);fin 1er progn

 

; sinon faire une casse en prévoyant l'apostrophe

(progn

(setq txte (strcat (strcase (substr txte 1 2) T)

(strcase (substr txte 3 1)) (strcase (substr txte 4) T))

); fin setq txte

);fin 2eme progn

);fin if

);fin defun

;;;------------------------------------------------------------------

(defun maj-1 (js /)

(setq nbr (sslength js))

(setq i 0)

(while (<= i (- nbr 1))

(setq nom_ent (ssname js i)) (setq ent (entget nom_ent))

(setq chn (cdr (assoc 1 ent))) (setq chn-mod (maj chn))

(setq ent (subst (cons 1 chn-mod) (assoc 1 ent) ent))

(entmod ent)

(setq i (+ i 1))

); fin while

(setvar "cmdecho" 1)

); fin defun

;;;------------------------------------------------------------------

(prompt "\nFonction chargée- Pour lancer tapez : ch-case")

(prin1)