LISP changement de couleur d\'un texte multilgnes

[autospeed]

J'ai un plan qui contient des textes multilignes dont la couleur à été forcée et je recherche un lisp qui permettrait de les remettre tous en couleur ducalque sans avoir besoin de les sélectionner un par un .

Quelqu'un aurait-il ça sous la main ?

Bonne journée

Phil

[yalta]

Bonjour,

 

...essaie ça, mais ce n'est pas de moi.

 

; supprimer les propriétés qui auraient pu être forcées (couleur, fonte, caractères gras, italique ou sous-ligné)

; qu'il soit en textes ou en mtextes dans le dessin

 

 

 

(defun c:mtxt2Std (/ ss n txt e_lst str)

(setq ss (ssget "_X" '((0 . "*TEXT"))))

(repeat (setq n (sslength ss))

(setq txt (ssname ss (setq n (1- n)))

e_lst (entget txt)

str (cdr (assoc 1 e_lst))

)

(if (= "{" (substr str 1 1))

(progn

(while (and (setq start (vl-string-search "\\" str))

(setq end (vl-string-search ";" str start))

)

(setq str (vl-string-subst

""

(substr str (1+ start) (- end start -1))

str

)

)

)

(if (= "\\L" (substr str 2 2))

(setq str (vl-string-subst

""

(substr str 2 2)

str

)

)

)

(setq str (vl-string-right-trim

"}"

(vl-string-left-trim "{" str)

)

e_lst (subst (cons 7 (getvar "TEXTSTYLE"))

(assoc 7 e_lst)

(subst (cons 1 str) (assoc 1 e_lst) e_lst)

)

)

(entmod e_lst)

)

)

)

(princ)

)

 

Sylvain

[yalta]

Re..... je te mets également celui-ci, à tout hasard, ce peut être utile aussi.

 

Remettre un (ou des) mtext dans le style de texte courant

 

(defun c:mtxt2cstyle (/ ss n txt e_lst)

(setq ss (ssget "_X" '((0 . "*TEXT"))))

(repeat (setq n (sslength ss))

(setq txt (ssname ss (setq n (1- n)))

e_lst (entget txt)

e_lst (subst (cons 7 (getvar "TEXTSTYLE"))

(assoc 7 e_lst)

e_lst

)

)

(entmod e_lst)

)

(princ)

)

[(gile)]

Quoi ????!!!!

Autospeed ne fait pas ça ????!!!! :casstet:

 

Mais gile l'a fait ;)

Tu devrais trouver ton bonheur ici

[bonuscad]

Voici un lisp, mais je pense que Qselect pouvais faire aussi bien l'affaire

 

((lambda ( / )
(princ "\nChanger la couleur forcée des entités TEXTE en DuCalque.")
(initget "Selection Tout _Select All")
(if (eq (getkword "\nChoix par [selection/Tout] : ") "Select")
	(setq js (ssget '((0 . "*TEXT") (-4 . "!=") (62 . 256))))
	(setq js (ssget "_X" '((0 . "*TEXT") (-4 . "!=") (62 . 256))))
)
(cond
	(js
		(repeat (setq n (sslength js))
			(setq dxf_ent (entget (ssname js (setq n (1- n)))))
			(entmod (subst (cons 62 256) (assoc 62 dxf_ent) dxf_ent))
		)
	)
	(T (princ "\nAucun TEXTE ou MultiTEXTE trouvé!"))
)
(prin1)
))

 

Viens de voir la réponse de (gile), ce qui me faire dire que ta question n'est pas assez précise.

Couleur Forcée d'accord, mais où? Dans l'éditeur Mtext ou dans ses propriétés ?!?!

 

[Edité le 20/4/2007 par bonuscad]

[autospeed]

merci , c'est exactement ce que je recherchais.

Phil http://www.autospeed.biz

[Patrick_35]

Salut

Une routine que j'ai récupéré sur le net et dont je me suis servit dans LXL

Il ne reste plus qu'a compléter pour une boucle avec un jeu de sélection ou télécharger la routine complète

 

ps : je viens de constater que le lien d'origine n'est plus valide :(

 

;-------------------------------------------------------------------------
; Récuperer la valeur String d'un Mtext
; Extrait du lisp de Custom Stuff StripMtext v3.07
; http://www.users.qwest.net/~sdoman/
;-------------------------------------------------------------------------

 (defun UnFormat (Mtext Formats / All Format1 Format2 Text Str)
   (and
     Mtext
     Formats
     (= (type Mtext) 'STR)
     (= (type Formats) 'STR)
     (setq Formats (strcase Formats))
     (setq Text "")
     (setq All T)
     (if (= Formats "*")
(setq Formats "S"
      Format1 "\\[LO`~]"
      Format2 "\\[ACFHQTW]"
      Format3 "\\P"
)
(progn
  (setq Format1 "" Format2 "" Format3 "")
  (foreach item '("L" "O" "~")
    (if (vl-string-search item Formats)
      (setq Format1 (strcat Format1 "`" item))
      (setq All nil)
    )
  )
  (if (= Format1 "")
    (setq Format1 nil)
    (setq Format1 (strcat "\\[" Format1 "]"))
  )
  (foreach item '("A" "C" "F" "H" "Q" "T" "W")
    (if (vl-string-search item Formats)
      (setq Format2 (strcat Format2 item))
      (setq All nil)
    )
  )
  (if (= Format2 "")
    (setq Format2 nil)
    (setq Format2 (strcat "\\[" Format2 "]"))
  )
  (if (vl-string-search "P" Formats)
    (setq Format3 "\\P")
    (setq Format3 nil All nil)
  )
  T
)
     )
     (while (/= Mtext "")
(cond
  ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[\\{}]")
    (setq Mtext (substr Mtext 3)
	  Text   (strcat Text Str)
    )
  )
  ((and All (wcmatch (substr Mtext 1 1) "[{}]"))
    (setq Mtext (substr Mtext 2))
  )
  ((and Format1 (wcmatch (strcase (substr Mtext 1 2)) Format1))
    (setq Mtext (substr Mtext 3))
  )
  ((and Format2 (wcmatch (strcase (substr Mtext 1 2)) Format2))
    (setq Mtext (substr Mtext (+ 2 (vl-string-search ";" Mtext))))
  )
  ((and Format3 (wcmatch (strcase (substr Mtext 1 2)) Format3))
    (if
      (or
	(= " " (substr Text (strlen Text)))
	(= " " (substr Mtext 3 1))
      )
       (setq Mtext (substr Mtext 3))
       (setq Mtext (substr Mtext 3) Text (strcat Text " "))
    )
  )     
  ((and (vl-string-search "S" Formats)(wcmatch (strcase (substr Mtext 1 2)) "\\S"))
    (setq Str   (substr Mtext 3 (- (vl-string-search ";" Mtext) 2))
	  Text  (strcat Text (vl-string-translate "#^\\" "/^\\" Str))
	  Mtext (substr Mtext (+ 4 (strlen Str)))
    )
  )
  (1
    (setq Text (strcat Text (substr Mtext 1 1))
	  Mtext (substr Mtext 2)
    )
  )
)
     )
   )
   Text
 )

 

@+