Comment récupérer la justification d\'un texte dans un lisp

[argilles]

Hello,

 

la question est dans le titre, mais je me répète.

 

Comment récupérer la justification d'un texte dans un lisp

 

Merci d'avance.

 

@rgilles

[Tramber]

Faut que tu tapes TEXT dans l'aide et tu tomberas sur les codes DXF en premeire rubrique.

 

72

Justification horizontale du texte (facultatif, valeur par défaut = 0) ; les codes sont des entiers (valeurs non binaires)

0 = Gauche ; 1 = Centre ; 2 = Droite

3 = Aligné (si alignement vertical = 0)

4 = Milieu (si alignement vertical = 0)

5 = Ajusté (si alignement vertical = 0)

Pour plus d'informations, voir le tableau des codes entiers des groupes 72 et 73.

(A voir dans l'aide, c'est un tableau croisé)

 

(cdr(assoc 72(entget(setq enttext(car(entsel))))))
(cdr(assoc 73(entget enttext)))

[fabcad]

tiens un extrait d'une fonction lisp id-txt.lsp qui copie les propriétés texte par rapport à un objet texte source

 

(defun justif (nom /)

 

(setq lst-nom (entget nom))

(setq typ-nom (cdr (assoc 0 lst-nom)))

 

(cond

((= typ-nom "MTEXT")

(cond

((= 1 (cdr (assoc 71 lst-nom)))

(progn

(prompt "\n Justification de type Haut-Gauche !!!\n")

(setq res-lst (list (cons 71 1) (cons 72 0) (cons 73 3)))

);fin progn

);fin si cdr egal à 1

 

((= 2 (cdr (assoc 71 lst-nom)))

(progn

(prompt "\n Justification de type Haut-Centre !!!\n")

(setq res-lst (list (cons 71 2) (cons 72 1) (cons 73 3)))

);fin progn

);fin si cdr egal à 2

 

((= 3 (cdr (assoc 71 lst-nom)))

(progn

(prompt "\n Justification de type Haut-Droite !!!\n")

(setq res-lst (list (cons 71 3) (cons 72 2) (cons 73 3)))

);fin progn

);fin si cdr egal à 3

 

((= 4 (cdr (assoc 71 lst-nom)))

(progn

(prompt "\n Justification de type Milieu-Gauche !!!\n")

(setq res-lst (list (cons 71 4) (cons 72 0) (cons 73 2)))

);fin progn

);fin si cdr egal à 4

 

((= 5 (cdr (assoc 71 lst-nom)))

(progn

(prompt "\n Justification de type Milieu-Centre !!!\n")

(setq res-lst (list (cons 71 5) (cons 72 1) (cons 73 2)))

);fin progn

);fin si cdr egal à 5

 

((= 6 (cdr (assoc 71 lst-nom)))

(progn

(prompt "\n Justification de type Milieu-Droite !!!\n")

(setq res-lst (list (cons 71 6) (cons 72 2) (cons 73 2)))

);fin progn

);fin si cdr egal à 6

 

((= 7 (cdr (assoc 71 lst-nom)))

(progn

(prompt "\n Justification de type Bas-Gauche !!!\n")

(setq res-lst (list (cons 71 7) (cons 72 0) (cons 73 0)))

);fin progn

);fin si cdr egal à 4

 

((= 8 (cdr (assoc 71 lst-nom)))

(progn

(prompt "\n Justification de type Bas-Centre !!!\n")

(setq res-lst (list (cons 71 8) (cons 72 1) (cons 73 0)))

);fin progn

);fin si cdr egal à 5

 

((= 9 (cdr (assoc 71 lst-nom)))

(progn

(prompt "\n Justification de type Bas-Droite !!!\n")

(setq res-lst (list (cons 71 9) (cons 72 2) (cons 73 0)))

);fin progn

);fin si cdr egal à 6

 

);fin 2eme cond

 

); fin obj egal a MTEXT

 

((= typ-nom "TEXT")

(cond

 

((and (= 0 (cdr (assoc 72 lst-nom))) (= 3 (cdr (assoc 73 lst-nom))))

(progn

(prompt "\n Justification de type Haut-Gauche !!!\n")

(setq res-lst (list (cons 71 1) (cons 72 0) (cons 73 3)))

);fin progn

);fin

 

((and (= 1 (cdr (assoc 72 lst-nom))) (= 3 (cdr (assoc 73 lst-nom))))

(progn

(prompt "\n Justification de type Haut-Centre !!!\n")

(setq res-lst (list (cons 71 2) (cons 72 1) (cons 73 3)))

);fin progn

);fin

 

((and (= 2 (cdr (assoc 72 lst-nom))) (= 3 (cdr (assoc 73 lst-nom))))

(progn

(prompt "\n Justification de type Haut-Droite !!!\n")

(setq res-lst (list (cons 71 3) (cons 72 2) (cons 73 3)))

);fin progn

);fin

 

((and (= 0 (cdr (assoc 72 lst-nom))) (= 2 (cdr (assoc 73 lst-nom))))

(progn

(prompt "\n Justification de type Milieu-Gauche !!!\n")

(setq res-lst (list (cons 71 4) (cons 72 0) (cons 73 2)))

);fin progn

);fin

 

((and (= 1 (cdr (assoc 72 lst-nom))) (= 2 (cdr (assoc 73 lst-nom))))

(progn

(prompt "\n Justification de type Milieu-Centre !!!\n")

(setq res-lst (list (cons 71 5) (cons 72 1) (cons 73 2)))

);fin progn

);fin

 

((and (= 2 (cdr (assoc 72 lst-nom))) (= 2 (cdr (assoc 73 lst-nom))))

(progn

(prompt "\n Justification de type Milieu-Droite !!!\n")

(setq res-lst (list (cons 71 6) (cons 72 2) (cons 73 2)))

);fin progn

);fin

 

((and (= 0 (cdr (assoc 72 lst-nom))) (= 1 (cdr (assoc 73 lst-nom))))

(progn

(prompt "\n Justification de type Bas-Gauche !!!\n")

(setq res-lst (list (cons 71 7) (cons 72 0) (cons 73 1)))

);fin progn

);fin

 

((and (= 1 (cdr (assoc 72 lst-nom))) (= 1 (cdr (assoc 73 lst-nom))))

(progn

(prompt "\n Justification de type Bas-Centre !!!\n")

(setq res-lst (list (cons 71 8) (cons 72 1) (cons 73 1)))

);fin progn

);fin

 

((and (= 2 (cdr (assoc 72 lst-nom))) (= 1 (cdr (assoc 73 lst-nom))))

(progn

(prompt "\n Justification de type Bas-Droite !!!\n")

(setq res-lst (list (cons 71 9) (cons 72 2) (cons 73 1)))

);fin progn

);fin

 

((and (= 0 (cdr (assoc 72 lst-nom))) (= 0 (cdr (assoc 73 lst-nom))))

(progn

(prompt "\n Justification de type Bas-Gauche !!!\n")

(setq res-lst (list (cons 71 7) (cons 72 0) (cons 73 0)))

);fin progn

);fin

 

((and (= 1 (cdr (assoc 72 lst-nom))) (= 0 (cdr (assoc 73 lst-nom))))

(progn

(prompt "\n Justification de type Bas-Centre !!!\n")

(setq res-lst (list (cons 71 8) (cons 72 1) (cons 73 0)))

);fin progn

);fin

 

((and (= 2 (cdr (assoc 72 lst-nom))) (= 0 (cdr (assoc 73 lst-nom))))

(progn

(prompt "\n Justification de type Bas-Droite !!!\n")

(setq res-lst (list (cons 71 9) (cons 72 2) (cons 73 0)))

);fin progn

);fin

 

((and (= 4 (cdr (assoc 72 lst-nom))) (= 0 (cdr (assoc 73 lst-nom))))

(progn

(prompt "\n Justification de type Milieu-Centre !!!\n")

(setq res-lst (list (cons 71 5) (cons 72 4) (cons 73 0)))

);fin progn

);fin

 

);fin cond

); fin obj egal a TEXT

 

);fin 1er cond

res-lst

);fin defun

 

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

(defun id-just (js / c1 i just just2 pti nbr er)

(while (= (setq er (car (entsel "\n Choisir le texte de reference : "))) nil)

);fin 1er while

(setq nbr (sslength js))

(setq i 0)

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

(if (= (cdr (assoc 0 (entget (ssname js i)))) "TEXT")

(progn

(setq lst-er (justif er))

(setq just (cdr (assoc 72 lst-er)))

(setq just2 (cdr (assoc 73 lst-er)))

(setq c1 (ssname js i))

(setq ent (entget c1))

(setq pti (cdr (assoc 10 (entget c1))))

(setq ent (subst (cons 72 just) (assoc 72 ent) ent))

(setq ent (subst (cons 73 just2) (assoc 73 ent) ent))

(setq ent (subst (cons 11 pti) (assoc 11 ent) ent))

(entmod ent)

);fin progn

(progn

(setq lst-er (justif er))

(setq just (cdr (assoc 71 lst-er)))

(setq c1 (ssname js i))

(setq ent (entget c1))

(setq pti (cdr (assoc 10 (entget c1))))

(setq ent (subst (cons 71 just) (assoc 71 ent) ent))

(setq ent (subst (cons 11 pti) (assoc 11 ent) ent))

(entmod ent)

);fin progn

 

);fin if

 

(setq i (+ i 1))

); fin while

(setvar "cmdecho" 1)

)

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

 

bonne utilisation

 

fabcad

 

[argilles]

Hello

 

Merci beaucoup de votre aide, je vais tester le prog de Fabcad. Tu m'as mis sur une bonne piste Tramber en faissant un mix il y aura un bon résultat qui en sortira.

 

Merci beaucoup

 

@+ @rgilles

[zebulon_]

Salut petit scarabé

 

Il y a peut être aussi la fonction textbox qui peut être intéressante.

 

Measures a specified text object, and returns the diagonal coordinates of a box that encloses the text

 

(textbox elist)

 

Arguments

 

elist

 

An entity definition list defining a text object, in the format returned by entget.

 

If fields that define text parameters other than the text itself are omitted from elist, the current (or default) settings are used.

 

The minimum list accepted by textbox is that of the text itself.

 

Return Values

 

A list of two points, if successful; otherwise nil.

 

The points returned by textbox describe the bounding box of the text object as if its insertion point is located at (0,0,0) and its rotation angle is 0. The first list returned is generally the point (0.0 0.0 0.0) unless the text object is oblique or vertical, or it contains letters with descenders (such as g and p). The value of the first point list specifies the offset from the text insertion point to the lower-left corner of the smallest rectangle enclosing the text. The second point list specifies the upper-right corner of that box. Regardless of the orientation of the text being measured, the point list returned always describes the lower-left and upper-right corners of this bounding box.

 

Examples

 

The following command supplies the text and accepts the current defaults for the remaining parameters:

 

Command: (textbox '((1 . "Hello world.")))

 

((0.000124126 -0.00823364 0.0) (3.03623 0.310345 0.0))

 

 

En exemple un prog qui dessine un cadre autour d'une entité texte sélectionnée et qui utilise textbox.

 

 

 
(defun c:tbox (/ textent tb ll ur ul lr OLDOS)
 (setq OLDOS (getvar "osmode"))
 (setvar "osmode" 0)
 (setq textent (car (entsel "\nSélectionner un texte : ")))
 (command "_ucs" "_e" textent)
 (setq tb (textbox (list (cons -1 textent)))
 ll (car tb)
 ur (cadr tb)
 ul (list (car ll) (cadr ur))
 lr (list (car ur) (cadr ll))
 )
 (command "_pline" ll lr ur ul "_c")
 (command "_ucs" "_p")
 (setvar "osmode" OLDOS)
 (princ)
)

 

à toutes fins utiles

 

Amicalement

 

Zebulon_

[argilles]

Bonjour maître Gildas,

 

pas mauvaise ton idée j'avais pas pensé à utiliser tbox qui à une bonne fonction caché. Je vais explorer cette piste.

 

Bye faut que je bosse j'ai un APS à rendre pour 14h00, tu sais ce que son les charette.

Fait attention à toi "es ruscht drüce" (littéralement "dehors ça glisse").

 

Argilles