Cadre/Masque pour textes et mtextes

[(gile)]

Suite à ce sujet, une routine pour placer un cadre ou un masque d'arrière plan (hachure SOLID) sur les textes (simples ou multilignes).

 

EDIT : Tout bien pesé, je pense qu'il vaut mieux 2 commandes séparées (CT pour les cadres et MT pour les masques) : moins d'options à valider ou modifier.

 

EDIT : Nouvelles versions, fonctionnent avec les "couleurs vraies" pour les version 2004 et plus, en couleurs de l'index pour les version antérieures.

 

EDIT : Ajout d'une option Wipeout dans MT

 

EDIT : Ajout d'une option Largeur (de polyligne) dans CT

 

;; CT & MT (gile) 18/11/07
;; Fonctionnent avec textes simples et multilignes
;; Les paramètres (couleur et la distance de décalage)
;; sont conservées dans le dessin pendant la session

;; CT Encadre les textes sélectionnés

(defun c:ct (/ of col wid opt par wo n ss n tx elst plst)
 (or *TextFrameOffset*
     (setq *TextFrameOffset* (/ (getvar "TEXTSIZE") 5.0))
 )
 (or *TextFrameColor*
     (setq *TextFrameColor* (list '(62 . 256)))
 )
 (or *TextFrameWidth*
     (setq *TextFrameWidth* 0.0)
 )
 (setq	of  *TextFrameOffset*
col *TextFrameColor*
wid *TextFrameWidth*
 )
 (while
   (and (princ	(strcat	"\nDécalage: "
		(rtos of)
		"\tCouleur: "
		(TrueColor2String col)
		"\tLargeur: "
		(rtos wid)
		"\nSélectionnez les textes ou [b]<[/b]Paramètres>."
	)
 )
 (not (setq ss (ssget '((0 . "MTEXT,TEXT")))))
   )
    (initget 1 "Décalage Couleur Largeur")
    (setq par (getkword
	 "\nChoix de l'option [Décalage/Couleur/Largeur]: "
       )
    )
    (cond
      ((= par "Couleur")
 (if (< 15 (atoi (substr (getvar "ACADVER") 1 2)))
   (if (setq col (acad_truecolordlg
		   (cond
		     ((assoc 420 col))
		     ((assoc 62 col))
		   )
		 )
       )
     (setq *TextFrameColor* col)
     (setq col *TextFrameColor*)
   )
   (if (setq col (acad_colordlg (cdr (assoc 62 col))))
     (setq *TextFrameColor* (setq col (list (cons 62 col))))
     (setq col *TextFrameColor*)
   )
 )
      )
      ((= par "Décalage")
      (if (setq of (getdist (strcat "\nSpécifiez le décalage du cadre <"
			     (rtos of)
			     ">: "
		     )
	    )
   )
 (setq *TextFrameOffset* of)
 (setq of *TextFrameOffset*)
      )
)
      (T
(if (setq wid (getdist (strcat "\nSpécifiez la largeur du cadre <"
			     (rtos wid)
			     ">: "
		     )
	    )
   )
 (setq *TextFrameWidth* wid)
 (setq wid *TextFrameWidth*)
      )
)
    )
 )
 (setq n -1)
 (while (setq tx (ssname ss (setq n (1+ n))))
   (setq elst (entget tx)
  plst (text2box-plst elst of)
   )
   (make-frame elst col wid plst)
 )
 (princ)
)

;; ==========================================================;;

;; MT Place un masque (hachure SOLID ou wipeout) derrière les textes sélectionnés

(defun c:mt (/ of col par n ss n tx elst plst ec)
 (or *TextMaskOffset*
     (setq *TextMaskOffset* (/ (getvar "TEXTSIZE") 5.0))
 )
 (or *TextMaskColor*
     (setq *TextMaskColor* (list '(62 . 1)))
 )
 (setq	of  *TextMaskOffset*
col *TextMaskColor*
 )
 (while
   (and (princ	(strcat	"\nDécalage: "
		(rtos of)
		"\tCouleur: "
		(TrueColor2String col)
		"\nSélectionnez les textes ou [b]<[/b]Paramètres>."
	)
 )
 (not (setq ss (ssget '((0 . "MTEXT,TEXT")))))
   )
    (initget 1 "Décalage Couleur Wipeout")
    (setq par (getkword
	 "\nChoix de l'option [Décalage/Couleur/Wipeout]: "
       )
    )
    (cond
      ((= par "Wipeout")
(setq *TextMaskColor* (setq col (list (cons 430 "Wipeout"))))
      )
      ((= par "Couleur")
(if (< 15 (atoi (substr (getvar "ACADVER") 1 2)))
  (if (setq col	(acad_truecolordlg
		  (cond
		    ((assoc 420 col))
		    ((assoc 62 col))
		    (T '(62 . 1))
		  )
		)
      )
    (setq *TextMaskColor* col)
    (setq col *TextMaskColor*)
  )
  (if (setq col	(acad_colordlg
		  (cond	((cdr (assoc 62 col)))
			(T 1)
		  )
		)
      )
    (setq *TextMaskColor* (setq col (list (cons 62 col))))
    (setq col *TextMaskColor*)
  )
)
      )
      (T
(setq of (getdist (strcat "\nSpécifiez le décalage du cadre <"
			  (rtos of)
			  ">: "
		  )
	 )
)
(setq *TextMaskOffset* of)
(setq of *TextMaskOffset*)
      )
    )
 )
 (setq n -1)
 (while (setq tx (ssname ss (setq n (1+ n))))
   (setq elst (entget tx)
  plst (text2box-plst elst of)
   )
   (make-mask elst col plst)
 )
 (setq ec (getvar "CMDECHO"))
 (setvar "CMDECHO" 0)
 (command "_draworder" ss "" "_f")
 (setvar "CMDECHO" ec)
 (princ)
)

;; ==========================================================;;

;; Text2Box-plst
;; Retourne la liste des sommets (coordonnées SCO) de la boite
;; englobant le texte après décalage
;;
;; Arguments
;; elst : liste DXF de l'entité
;; of : distance de décalage

(defun Text2box-plst (elst of / nor ref rot wid hgt jus org box plst)
 (if (= "MTEXT" (cdr (assoc 0 elst)))
   (setq nor  (cdr (assoc 210 elst))
  ref  (trans (cdr (assoc 10 elst)) 0 nor)
  rot  (angle '(0 0 0) (trans (cdr (assoc 11 elst)) 0 nor))
  wid  (cdr (assoc 42 elst))
  hgt  (cdr (assoc 43 elst))
  jus  (cdr (assoc 71 elst))
  org  (list
	 (cond
	   ((member jus '(2 5 8)) (/ wid -2))
	   ((member jus '(3 6 9)) (- wid))
	   (T 0.0)
	 )
	 (cond
	   ((member jus '(1 2 3)) (- hgt))
	   ((member jus '(4 5 6)) (/ hgt -2))
	   (T 0.0)
	 )
       )
  plst (mapcar
	 (function
	   (lambda (p)
	     (mapcar '+ org p)
	   )
	 )
	 (list
	   (list (- of) (- of))
	   (list (+ wid of) (- of))
	   (list (+ wid of) (+ hgt of))
	   (list (- of) (+ hgt of))
	 )
       )
   )
   (setq box  (textbox elst)
  ref  (cdr (assoc 10 elst))
  rot  (cdr (assoc 50 elst))
  plst (list
	 (list (- (caar box) of) (- (cadar box) of))
	 (list (+ (caadr box) of) (- (cadar box) of))
	 (list (+ (caadr box) of) (+ (cadadr box) of))
	 (list (- (caar box) of) (+ (cadadr box) of))
       )
   )
 )
 (setq	mat  (list (list (cos rot) (- (sin rot)) 0)
	   (list (sin rot) (cos rot) 0)
	   '(0 0 1)
     )
plst (mapcar
       (function
	 (lambda (p)
	   (mapcar '+ (mxv mat p) (list (car ref) (cadr ref)))
	 )
       )
       plst
     )
 )
)

;; ==========================================================;;

;; Make-Frame
;; Crée une polyligne encadrant le texte
;;
;; Arguments
;; elst : liste DXF de l'entité
;; col : couleur de la polyligne
;; plst : liste des sommets

(defun make-frame (elst col wid plst / nor elv)
 (setq nor (cdr (assoc 210 elst)))
 (if (= "MTEXT" (cdr (assoc 0 elst)))
   (setq elv (caddr (trans (cdr (assoc 10 elst)) 0 nor)))
   (setq elv (caddr (cdr (assoc 10 elst))))
 )
 (entmake
   (append
     (list '(0 . "LWPOLYLINE")
    '(100 . "AcDbEntity")
    (assoc 8 elst)
    (if	(and (< 15 (atoi (substr (getvar "ACADVER") 1 2)))
	     (assoc 420 col)
	)
      (assoc 420 col)
      (assoc 62 col)
    )
    '(100 . "AcDbPolyline")
    '(90 . 4)
    '(70 . 1)
    (cons 43 wid)
    (cons 38 elv)
    (cons 210 nor)
     )
     (mapcar (function (lambda (x) (cons 10 x))) plst)
   )
 )
)

;; ==========================================================;;

;; Make-Mask
;; Crée une hachure SOLID figurant un masque d'arrière plan
;;
;; Arguments
;; elst : liste DXF de l'entité texte
;; col : couleur de la hachure
;; plst : liste des sommets

(defun make-mask (elst col plst / nor elv)
 (setq nor (cdr (assoc 210 elst)))
 (if (= "MTEXT" (cdr (assoc 0 elst)))
   (setq elv (caddr (trans (cdr (assoc 10 elst)) 0 nor)))
   (setq elv (caddr (cdr (assoc 10 elst))))
 )
 (if (= (cdr (assoc 430 col)) "Wipeout")
   (MakeWipeout
     (mapcar
(function
  (lambda (p)
    (list (car p) (cadr p) elv)
  )
)
plst
     )
     nor
     (cdr (assoc 8 elst))
   )
   (entmake
     (list
'(0 . "HATCH")
'(100 . "AcDbEntity")
(assoc 8 elst)
(if (and (< 15 (atoi (substr (getvar "ACADVER") 1 2)))
	 (assoc 420 col)
    )
  (assoc 420 col)
  (assoc 62 col)
)
'(100 . "AcDbHatch")
(list 10 0.0 0.0 elv)
(cons 210 nor)
'(2 . "SOLID")
'(70 . 1)
'(71 . 0)
'(91 . 1)
'(92 . 1)
'(93 . 4)
'(72 . 1)
(cons 10 (car plst))
(cons 11 (cadr plst))
'(72 . 1)
(cons 10 (cadr plst))
(cons 11 (caddr plst))
'(72 . 1)
(cons 10 (caddr plst))
(cons 11 (cadddr plst))
'(72 . 1)
(cons 10 (cadddr plst))
(cons 11 (car plst))
'(97 . 0)
'(75 . 0)
'(76 . 1)
'(98 . 1)
'(10 0.0 0.0 0.0)
     )
   )
 )
)

 

;; ==========================================================;;

 ;; MakeWipeout crée un objet "wipeout" à partir d'une liste de points et du vecteur normal de l'objet

(defun MakeWipeout (pt_lst nor lay / dxf10 max_dist cen dxf_14)
 (or (member "acwipeout.arx" (arx)) (arxload "acwipeout.arx"))
 (setq	dxf10 (list (apply 'min (mapcar 'car pt_lst))
	    (apply 'min (mapcar 'cadr pt_lst))
	    (caddar pt_lst)
      )
 )
 (setq
   max_dist
    (float
      (apply 'max
      (mapcar '- (apply 'mapcar (cons 'max pt_lst)) dxf10)
      )
    )
 )
 (setq cen (mapcar '+ dxf10 (list (/ max_dist 2) (/ max_dist 2) 0.0)))
 (setq
   dxf14 (mapcar
    '(lambda (p)
       (mapcar '/
	       (mapcar '- p cen)
	       (list max_dist (- max_dist) 1.0)
       )
     )
    pt_lst
  )
 )
 (setq dxf14 (reverse (cons (car dxf14) (reverse dxf14))))
 (entmake (append (list '(0 . "WIPEOUT")
		 '(100 . "AcDbEntity")
		 (cons 8 lay)
		 '(100 . "AcDbWipeout")
		 '(90 . 0)
		 (cons 10 (trans dxf10 nor 0))
		 (cons 11 (trans (list max_dist 0.0 0.0) nor 0))
		 (cons 12 (trans (list 0.0 max_dist 0.0) nor 0))
		 '(13 1.0 1.0 0.0)
		 '(70 . 7)
		 '(280 . 1)
		 '(71 . 2)
		 (cons 91 (length dxf14))
	   )
	   (mapcar '(lambda (p) (cons 14 p)) dxf14)
   )
 )
)

;; ==========================================================;;

;; Applique une matrice de transformation à un vecteur (Vladimir Nesterovsky)
(defun mxv (m v)
 (mapcar (function (lambda (r) (apply '+ (mapcar '* r v))))
  m
 )
)

;; ==========================================================;;

;; Retourne une chaîne indiquant l'index de la couleur ou les valeurs RVB
(defun TrueColor2String	(lst / ind)
 (setq	ind (cond ((cdr (assoc 430 lst)))
      ((cdr (assoc 420 lst)))
	  ((cdr (assoc 62 lst)))
	  (T 256)
    )
 )
 (cond
   ((= (type ind) 'STR) ind)
   ((= ind 256) "DuCalque")
   ((= ind 0) "DuBloc")
   ((< 256 ind)
    (strcat (itoa (lsh ind -16))
     ","
     (itoa (lsh (lsh ind 16) -24))
     ","
     (itoa (lsh (lsh ind 24) -24))
    )
   )
   ((itoa ind))
 )
) 

[Edité le 18/11/2007 par (gile)]

[Edité le 20/11/2007 par (gile)]

[cdi]

gile

 

 

 

Gratitude et respect encore et encore pour tout ce travail ainsi qu' aux nombreux participants de ce lsphttp://www.cadxp.com/modules/XForum/images/smilies/sad.gif

http://www.cadxp.com/modules/XForum/images/smilies/sad.gif

[lecrabe]

 

Hello Gilles

 

Comme d'hab, ca marche nickel-chrome (testé sur AutoCAD 2008) :) :D

 

Un petit coup de MT puis un petit coup de CT et enfin un bon Pastis ! :P

 

Encore Merci, Le Decapode

[(gile)]

Petite amélioration, on peut désormais utiliser les "couleurs vraies" avec les versions 2004 et plus, ça reste compatible pour les versions antérieures (en couleurs de l'index).

[PHILPHIL]

Salut gile

 

petit souci chez moi pour la derniere version

 

autocdeskarchi2008 me renvoie ca :

 

CT modifier en CADT

MAST modifier en MT

 

obliger d'attaquer les racourcis clavier a 4 5 lettres les deux lettre sont epuisés

 

Commande: CADT

*Annuler*

type d'argument incorrect: listp 256

Commande: MAST

*Annuler*

type d'argument incorrect: listp 3

 

phil

[(gile)]

Salut,

 

C'est à cause le la gestion des couleurs qui a changé (true color oblige).

Tu as du essayer dans unfichier où tu avais utilisé les anciennes vesions. il faut que tu remettes les variables globales (non déclarées) *TextFrameColor* et *TextMaskColor* à nil.

 

 (setq *TextFrameColor* nil *TextMaskColor* nil)

 

PS : je ré-édite le code (problème d'affichage avec

[lecrabe]

 

Hello Gilles

 

Tu as fait le maximum, à mon avis on ne peut plus rajouter grand chose ! :)

 

Cette routine devrait rendre bien des services à tout le monde et je t'en remercie au nom de toute la communauté ! :)

 

Testée et validée ce matin sur AutoCAD 2004 (pour changer) :P

 

Bon WE, Le Decapode

 

[(gile)]

J'ai rajouté la possibilité de mettre un Wipeout à la place d'une hachure dans MT.

[lecrabe]

 

Bonsoir Gilles

 

Et si et si, Gilles a trouvé et réalisé une amélioration (excellente d'ailleurs) ! :) :D

 

Que ne ferait -il pas pour me faire mentir ... :P

 

Le Decapode "dépité & humble"

 

[(gile)]

Une autre, très minime.

 

J'ai juste modifié les invites pour éviter une entrée supplémentaire :

 

Commande: mt

 

Décalage: 0.5000 Couleur: 1 Sélectionnez les textes ou .

Choix des objets: Entrée pour Paramètres

 

Choix de l'option [Décalage/Couleur/Wipeout]: w

 

Décalage: 0.5000 Couleur: Wipeout Sélectionnez les textes ou .

Choix des objets: 1 trouvé(s)

[(gile)]

Encore une : ajout d'une option "Largeur" à CT.

 

Commande: ct

 

Décalage: 0.5000 Couleur: DuCalque Largeur0.0000

Sélectionnez les textes ou .

Choix des objets: Entrée pour Paramètres

 

Choix de l'option [Décalage/Couleur/Largeur]: L

 

Spécifiez la largeur du cadre : 0.2

 

Décalage: 0.5000 Couleur: DuCalque Largeur: 0.2000

Sélectionnez les textes ou .

Choix des objets: 1 trouvé(s)

 

[Edité le 19/11/2007 par (gile)]

[lili2006]

Bonsoir à toutes et tous,

 

(gile) a encore frappé, les express-tools n'ont qu'à bien s'tenir,...

 

J'avais pris l'habitude d'utiliser "TCIRCLE" pour les cadres car l'option "oblong" est plutôt sympa, je trouve. Quant à l'arrière plan, le Lisp "BGF" (je ne connais pas l'auteur !!) qui, par l'intermédiaire d'une BD permet de choisir le masque , la couleur de remplissage et le facteur de décalage.

 

Ce qui aurait été sympa, (gile) , c'était d'avoir ensuite la possibilité de "démasquer" le texte (ça arrive d'en avoir besoin !). J'ai essayé avec "textunmask", voici ce que me renvoi AutoCAD :

 

 

Commande: textunmask

Select text or MText object from which mask is to be removed.

Choix des objets: 1 trouvé(s)

Choix des objets:

No masked text objects selected.

 

Bonne fin de WE.

 

[Edité le 18/11/2007 par lili2006]

[(gile)]

J'ai essayé avec "textunmask"

 

textunmask fonctionne avec les masques faits avec textmask (solid, 3dface ou wipeout groupé et lié avec le texte). MT crée une hachure motif SOLID (ou un wipeout) qui ne sont pas groupés avec le texte, il suffit de les effacer.

[lili2006]

Re,

 

Vu ! Merci (gile).

 

Bonne soirée.

[(gile)]

La version finalisée est en téléchargement.

[lecrabe]

 

Bon Matin

 

Ca marche toujours et même sur un bon vieil AutoCAD 2002 ! :)

 

Il est TROP FORT notre Gilles :( ;)

 

Le Decapode