copier arrière-plan dun mtexte

[fabcad]

Voici une sous-routine dune fonction qui copie les propriétés d'une sélection de (m)textes par rapport à un (m)texte de référence.

mais je sèche sur les arrière plans des mtextes.

Un peu d'aide serait la bienvenue.

 

(defun id-masque (js / c1 i typ-masq masq taille-masq nbr er)

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

);fin 1er while

(setq nbr (sslength js))

(setq i 0)

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

(setq typ-masq (cdr (assoc 90 (entget (car er)))))

(setq masq (cdr (assoc 63 (entget (car er)))))

(setq taille-masq (cdr (assoc 45 (entget (car er)))))

(setq c1 (ssname js i))

(setq ent (entget c1))

(setq ent (subst (cons 90 typ-masq) (assoc 90 ent) ent))

(setq ent (subst (cons 63 masq) (assoc 63 ent) ent))

(setq ent (subst (cons 45 taille-masq) (assoc 45 ent) ent))

(entmod ent)

(setq i (+ i 1))

); fin while

(setvar "cmdecho" 1)

)

 

[Maximilien]

Voici l'header de ma routine qui mets le blanc "SKIP" (selon l'expression d'Eric) en arrière plan d'un texte multiligne.

 

 (defun TXTMASK2005 (ARG_ENAME / PRIVE_BLANC PRIVE_BIBLE)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Masque le Texte Multiligne pointée par l'ARG_ENAME                 ;;;
;;;  avec les paramètres de codes DXF suivants :                       ;;;
;;;  (90 3) (63 9) (421 13158600) (45 1.25) (441 -1) : Masqué          ;;;
;;;  (90 2)                                          : non-Masqué      ;;;
;;;                                                                    ;;;
;;; Argument :                                                         ;;;
;;;    ARG_ENAME   : Entier correspondant au style Standard du BE      ;;;
;;;                                                                    ;;;
;;; Retourne       : Le nom d'entité du texte multiligne               ;;;
;;;                                                                    ;;;
;;; Remarque       : Le masquage est inopérent après une sauvegarde    ;;;
;;;                  sur les AutoCAD(s) dont la version est < 2005     ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 ;; PRIVE_BLANC correspond à blanc de chez "SKIP" en AutoCAD 2005
 ;; et blanc cassé en version antérieure
 (setq PRIVE_BLANC (- (expt 2 32) 1))

 

441 étant la couleur

 

[Edité le 25/5/2007 par Maximilien]

[fabcad]

Il me semblait que c'était le code 63 qui correspondait à la couleur !

A suivre...

 

[lecrabe]

 

Hello Fabcad

 

Cette routine de Lee Ambrosius ne convient elle pas plus ou moins à tes besoins ?

 

Le Decapode

 

 

;; Written by: Lee Ambrosius

;; Created on: 4/7/2004

;; http://www.hyperpics.com/

;; This program allows you to add Background Mask to several Mtext objects

;; at one time instead of using the Mtext editor

;; for each object or the Properties Palette.

;; The Properties Palette in 2005 doesn't allow you

;; to set Background Color or Border Offset.

 

(defun c:MTextMASK ( / kWordBackgroundMaskCurrent dOffsetCurrent ssMtext dxf90 dxf63 dxf45 dxf441)

(prompt "\nApply Mtext Mask")

 

(if (= kWordBackgroundMask nil)

(setq kWordBackgroundMask "Background" kWordBackgroundMaskCurrent "Background")

(setq kWordBackgroundMaskCurrent kWordBackgroundMask)

)

 

(initget "None Background Color")

(setq kWordBackgroundMask (getkword (strcat "\nSpecify Background Mask: [None/Background/Color] : ")))

 

(if (= kWordBackgroundMask nil)

(setq kWordBackgroundMask kWordBackgroundMaskCurrent)

)

 

(cond ((= kWordBackgroundMask "Color")

(if (or (= maskClr nil) (/= (type maskClr) 'LIST))

(setq maskClr (acad_truecolorcli 1))

(if (= (assoc 420 maskClr) nil)

(setq maskClr (acad_truecolorcli (cdr (assoc 62 maskClr))))

(setq maskClr (acad_truecolorcli (assoc 420 maskClr)))

)

)

)

((= kWordBackgroundMask "Background")(setq maskClr 256))

((= kWordBackgroundMask "None")(setq maskClr 0 dOffset 1.0))

)

 

(if (/= maskClr nil)

(progn

(if (/= kWordBackgroundMask "None")

(progn

(setq dOffsetCurrent dOffset)

 

(if (= dOffsetCurrent nil)

(setq dOffset 1.0 dOffsetCurrent 1.0)

(setq dOffsetCurrent dOffset)

)

 

(setq dOffset (getreal (strcat "\nSpecify border offset factor: : ")))

 

(if (= dOffset nil)

(setq dOffset dOffsetCurrent)

)

 

(if (> dOffset 5)(setq dOffset nil))

(if (

 

(while (= dOffset nil)

(setq dOffset (getreal (strcat "\nSpecify border offset factor: : ")))

 

(if (> dOffset 5)(setq dOffset nil))

(if (

)

)

(if (= dOffset nil)

(setq dOffset 1.0)

)

)

 

(if (setq ssMtext (ssget (list (cons 0 "MTEXT"))))

(progn

(cond ((= kWordBackgroundMask "None")

(setq mask_list (list (cons 90 2)(cons 63 0)(cons 45 dOffset)(cons 441 0))

dxf90 2

dxf63 nil

dxf45 nil

dxf441 nil

)

)

((and (= kWordBackgroundMask "Color")(/= (assoc 420 maskClr) nil))

(setq mask_list (list (cons 90 1)(cons 63 1)(cons 421 (cdr (assoc 420 maskClr)))(cons 45 dOffset)(cons 441 (cdr (assoc 420 maskClr))))

dxf90 1

dxf63 2

dxf45 dOffset

dxf441 (cdr (assoc 420 maskClr))

)

)

((and (= kWordBackgroundMask "Color")(= (assoc 420 maskClr) nil))

(setq mask_list (list (cons 90 1)(cons 63 (cdr (assoc 62 maskClr)))(cons 45 dOffset)(cons 441 2146608))

dxf90 1

dxf63 (cdr (assoc 62 maskClr))

dxf45 dOffset

dxf441 nil

)

)

((= kWordBackgroundMask "Background")

(setq mask_list (list (cons 90 3)(cons 63 3)(cons 45 dOffset)(cons 441 0))

dxf90 3

dxf63 256

dxf45 dOffset

dxf441 0

)

)

)

 

(setq emax (sslength ssMtext)

sscount 0

)

 

(while (

(setq EN (entget (ssname ssMtext sscount))

tempEN nil)

 

(if (/= dxf90 nil)

(progn

(if (/= (assoc 90 EN) nil)

(setq EN (subst (cons 90 dxf90) (assoc 90 EN) EN))

(setq EN (append EN (list (cons 90 dxf90))))

)

)

(progn

(setq CNT 0

nMembers (member (assoc 90 EN) EN))

 

(if (= nMembers nil)

(setq nMembers 0)

(setq nMembers (length nMembers))

)

(repeat (- (length EN) nMembers)

(setq tempEN (append tempEN (list (nth cnt EN))))

(setq CNT (1+ CNT))

)

 

(if (> nMembers 0)

(progn

(setq CNT 1)

(repeat (- nMembers 1)

(setq tempEN (append tempEN (list (nth cnt (member (assoc 90 EN) EN)))))

(setq CNT (1+ CNT))

)

)

)

(setq EN tempEN

tempEN nil)

)

)

 

 

(if (/= dxf63 nil)

(progn

(if (/= (assoc 63 EN) nil)

(setq EN (subst (cons 63 dxf63) (assoc 63 EN) EN))

(setq EN (append EN (list (cons 63 dxf63))))

)

)

(progn

(setq CNT 0

nMembers (member (assoc 63 EN) EN))

 

(if (= nMembers nil)

(setq nMembers 0)

(setq nMembers (length nMembers))

)

(repeat (- (length EN) nMembers)

(setq tempEN (append tempEN (list (nth cnt EN))))

(setq CNT (1+ CNT))

)

 

(if (> nMembers 0)

(progn

(setq CNT 1)

(repeat (- nMembers 1)

(setq tempEN (append tempEN (list (nth cnt (member (assoc 63 EN) EN)))))

(setq CNT (1+ CNT))

)

)

)

(setq EN tempEN

tempEN nil)

)

)

 

(if (/= dxf45 nil)

(progn

(if (/= (assoc 45 EN) nil)

(setq EN (subst (cons 45 dxf45) (assoc 45 EN) EN))

(setq EN (append EN (list (cons 45 dxf45))))

)

)

(progn

(setq CNT 0

nMembers (member (assoc 45 EN) EN))

 

(if (= nMembers nil)

(setq nMembers 0)

(setq nMembers (length nMembers))

)

(repeat (- (length EN) nMembers)

(setq tempEN (append tempEN (list (nth cnt EN))))

(setq CNT (1+ CNT))

)

 

(if (> nMembers 0)

(progn

(setq CNT 1)

(repeat (- nMembers 1)

(setq tempEN (append tempEN (list (nth cnt (member (assoc 45 EN) EN)))))

(setq CNT (1+ CNT))

)

)

)

(setq EN tempEN

tempEN nil)

)

)

 

(if (/= dxf441 nil)

(progn

(if (/= (assoc 441 EN) nil)

(setq EN (subst (cons 441 dxf441) (assoc 441 EN) EN))

(setq EN (append EN (list (cons 441 dxf441))))

)

)

(progn

(setq CNT 0

nMembers (member (assoc 441 EN) EN))

 

(if (= nMembers nil)

(setq nMembers 0)

(setq nMembers (length nMembers))

)

(repeat (- (length EN) nMembers)

(setq tempEN (append tempEN (list (nth cnt EN))))

(setq CNT (1+ CNT))

)

 

(if (> nMembers 0)

(progn

(setq CNT 1)

(repeat (- nMembers 1)

(setq tempEN (append tempEN (list (nth cnt (member (assoc 441 EN) EN)))))

(setq CNT (1+ CNT))

)

)

)

(setq EN tempEN)

)

 

)

 

(entmod EN)

(setq sscount (1+ sscount))

)

)

)

)

)

(princ)

)

 

(prompt "\nType MTEXTMASK to run the command")

(princ)

 

 

[(gile)]

Salut,

 

Vite fait, pour attribuer le masque source aux mtextes sélectionnés.

 

Tient compte des couleurs vraies et couleurs du carnet.

 

(defun c:match-mask (/ ref elst rlst ss n)
 (and (setq ref (car (entsel "\nSélectionnez le masque source: ")))
      (setq elst (entget ref))
      (setq rlst (vl-remove-if-not
	    '(lambda (x)
	       (or (member (car x) '(90 63 45 441))
		   (		       )
	     )
	    elst
	  )
      )
      (setq ss (ssget '((0 . "MTEXT"))))
      (repeat (setq n (sslength ss))
 (entmod (append
	   (vl-remove-if
	     '(lambda (x)
		(or (member (car x) '(90 63 45 441))
		    (			)
	      )
	     (entget (ssname ss (setq n (1- n))))
	   )
	   rlst
	 )
 )
      )
 )
) 

[fabcad]

Merci à tous,

Je vais décortiquer ces routines afin d'améliorer ma fonction ID-TXT qui copie les propriétés de plusieurs (M)Textes par rapport à un (M)Texte source.

 

A+