Routines pour TEXT/MTEXT

[lecrabe]

 

Hello Camarades

 

SVP j'aurais besoin de 2 routines Lisp sur les TEXTes et MTEXTEs :

 

1) Selectionner N Textes/MTextes (numériques) et donner la somme des valeurs ?

 

2) Selectionner N Textes/MTextes (numeriques) et appliquer un coefficient (=x.xx, par exemple = 2/ 2.50 / 0.75 / 0.50 / etc)

et donc générer partout un nouveau texte qui est la nouvelle valeur !

 

On supposera que l'on a changé de calques et donc les nouveaux textes

sont générés sur le calque courant ...

 

Ces 2 routines doivent pouvoir fonctionner sur toute version AutCAD 2004-2008

 

Merci d'avance de vos efforts

 

Le Decapode (qui tripote les Textes/MTextes)

 

[Patrick_35]

2) Selectionner N Textes/MTextes (numeriques) et appliquer un coefficient (=x.xx, par exemple = 2/ 2.50 / 0.75 / 0.50 / etc)

et donc générer partout un nouveau texte qui est la nouvelle valeur !

A la place des anciens textes ou en remplacement de ceux-ci ?

 

Sinon, pour la première routine

 

(defun c:tot(/ doc sel tot)
 (vl-load-com)
 (setq tot 0 doc (vla-get-activedocument (vlax-get-acad-object)))
 (if (ssget (list (cons 0 "TEXT,MTEXT")))
   (progn
     (vlax-map-collection (setq sel (vla-get-activeselectionset doc)) '(lambda (x) (setq tot (+ (atof (vla-get-textstring x)) tot))))
     (vla-delete sel)
     (princ (strcat "\nLe total est de " (rtos tot)))
   )
 )
 (princ)
)

 

@+

[Bred]

Salut,

à tester :

1) Selectionner N Textes/MTextes (numériques) et donner la somme des valeurs ?

(defun c:add-txt (/ S SEL X)
 (setq sel (ssget (list (cons 0 "TEXT,MTEXT")))
s 0)
 (repeat (setq x (sslength sel))
   (setq s (+ s (atof (cdr (assoc 1 (entget (ssname sel (setq x (1- x)))))))))
   )
 (alert (strcat "Somme = " (rtos s)))
 (princ)
 )

 

2) Selectionner N Textes/MTextes (numeriques) et appliquer un coefficient (=x.xx, par exemple = 2/ 2.50 / 0.75 / 0.50 / etc)

(defun c:coef-txt (/ COEF N-VAL SEL X L LST-ENT)
(vl-load-com)
 (setq sel (ssget (list (cons 0 "TEXT,MTEXT")))
coef (getreal "\n Coefficient à appliquer :")
L (getstring T ":\n Nom du Calque sur Lequel créer les textes :"))  
   (if (not (tblobjname "LAYER" L))
     (vla-add (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) L)
     )
 
 (repeat (setq x (sslength sel))
   (setq N-val (* coef (atof (cdr (assoc 1 (entget (ssname sel (setq x (1- x))))))))
  lst-ent (cdr (subst (cons 1 (rtos N-val))
		      (assoc 1 (entget (ssname sel x)))
		      (entget (ssname sel x))))
  lst-ent (subst (cons 8 L)
		 (assoc 8 (entget (ssname sel x)))
		 lst-ent))
   (entmake lst-ent)
   )
 (princ)
)

 

 

 

[Edité le 11/7/2007 par Bred]

 

[Edité le 11/7/2007 par Bred]

[Patrick_35]

Salut Bred

Ton filtre prends aussi les Rtexts

 

@+

[Bred]

Salut Patrik_35.

Ben je vais te piquer ton filtre alors...

mais....

c'est quoi des "Rtexts" ??? :casstet:

[Patrick_35]

Avant l'apparition des champs, cela permettait grâce aux express-tools d'avoir des textes avec des expressions diesel comme d'indiquer le nom du fichier, le chemin, les propriétés du dessin, etc...

 

@+

[Bred]

Ok, merci !

[lecrabe]

 

Hello

 

Le Decapode vous salue et vous remercie beaucoup ! :D

 

Je vous serre la pince 10 fois avec mes 10 pattes, pas trop fort ! :cool:

 

Que le soleil daigne "arroser" les vacances de Bred et Patrick_35 !!! :P

 

Le Decapode "tripatouilleur de textes"

 

[lecrabe]

 

ReBonjour

 

Je sollicite encore votre aide et ce toujours pour des Textes / MTextes numériques

car tout le monde ne dispose pas d'un MAP (ou CIVIL) ...

pour thématiser les valeurs numériques

 

C'est dur quand on est sur un simple AutoCAD ! :o

 

Un exemple pour tous les Textes / MTextes dont la valeur est comprise entre :

0-3 : transfert sur le calque xxxx_0_3

4-9 : transfert sur le calque xxxx_4_9

10-19 : transfert sur le calque xxxx_10_19

etc

 

Les Textes/MTextes NON COMPRIS dans les intervalles ne seront pas transférés !

 

A partir d'une table d'intervalle qui serait en DUR dans le programme Lisp

donc modifiable facilement !

 

Qui qui va gagner ce petit challenge ?

 

Le Decapode "coloriant Texte / MTexte"

 

 

[Bred]

Re,

Vite fait, à approfondir :

 

;;; liste d'écart
(defun list_tri_txt ()
 (list
[b]    "Nom_du_calque"
   (cons 0 3)
   (cons 4 9)
   (cons 10 19)[/b]
   )
 )

;;; Commande à Lancer
(defun c:test ()
 (vl-load-com)
 (if (setq lst (list_tri_txt))
   (progn
     (repeat (1- (setq x (length lst)))
(vla-add (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) (strcat (car lst) "-"
										  (rtos (car (nth (setq x (1- x)) lst)))
										  "_"
										  (rtos (cdr (nth x lst))))))
     (setq sel (ssget (list (cons 0 "TEXT,MTEXT"))))
     
     (repeat (setq i (sslength sel))
(setq val (atof (cdr (assoc 1 (entget (ssname sel (setq i (1- i))))))))

(repeat (1- (setq x (length lst)))
  (if (and (> val (car (nth (setq x (1- x)) lst)))
	   (< val (cdr (nth x lst))))
    (vla-put-layer (vlax-ename->vla-object (ssname sel i))
      (strcat (car lst) "-"
	      (rtos (car (nth x lst)))
	      "_" (rtos (cdr (nth x lst)))))
    )
  )
)
     )
   )
 (princ)
 )   

[lecrabe]

 

Hello

 

Il y a un petit probleme avec ce programme ! :casstet:

 

Les Textes avec une valeur strictement egal aux intervallles NE SONT PAS traités !

 

0

4

etc

 

J'ai corrigé en faisant :

 

(if (and (>= val (car (nth (setq x (1- x)) lst)))

(

 

Ca marche mieux !

 

Mille Mercis aux vaillants développeurs :) :D :cool:

 

Le Decapode "reconnaissant"

 

[Bred]

Il y a un petit probleme avec ce programme !

Les Textes avec une valeur strictement egal aux intervallles NE SONT PAS traités !

Désolé.... mais c'est ce que tu avais demandé !

Un exemple pour tous les Textes / MTextes dont la valeur est comprise entre :

[lecrabe]

 

Hello Bred

 

I am very sorry ! :exclam:

 

Je voulais surtout dire que les textes dont la valeur est "totalement" en dehors des intervalles ne seront pas traités ...

 

C'est à dire inférieur à la plus petite valeur ou supérieure à la plus haute valeur d'intervalle !

 

Comme quoi, je n'ai pas été assez PRECIS dans mon micr cahier des charges ... Sniff

 

Encore Merci, Le Decapode "très reconnaissant"

 

[lecrabe]

 

Hello

 

Merci pour toutes ces routines qui fonctionnent bien !

 

Cependant j'ai un petit problème avec la routine COEF-TXT

 

En effet elle demande IMPERATIVEMENT un nom de calque pour créer les nouveaux textes !

 

J'aimerais pouvoir faire simplement ENTREE / RETURN pour les créer sur le calque courant

 

ou bien

 

Donner un nom de calque (pas forcément existant) et dans ce cas, le calque est créé

automatiquement et les textes sont générés dessus !

 

Le Decapode "pointilleux"

 

 

[Bred]

Salut,

voilà :

(attention : met sur calque courant, pas sur calque du texte !)

 

; met un coef sur une valeur numérique de texte.
(defun c:coef-txt (/ COEF N-VAL SEL X L LST-ENT)
(vl-load-com)
 (setq sel nil)
 (while (not sel)
   (setq sel (ssget '((0 . "*TEXT")))))

 (initget 1)
 (setq	coef (getreal "\n Coefficient à appliquer :"))

 (setq L (getstring T ":\n Nom du Calque sur Lequel créer les textes :"))
 
 (if (equal L "") (setq L (getvar "Clayer")))
 (if (not (tblobjname "LAYER" L))
   (vla-add (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) L)
   )

 (repeat (setq x (sslength sel))
   (setq N-val (* coef (atof (cdr (assoc 1 (entget (ssname sel (setq x (1- x))))))))
  lst-ent (cdr (subst (cons 1 (rtos N-val))
		      (assoc 1 (entget (ssname sel x)))
		      (entget (ssname sel x))))
  lst-ent (subst (cons 8 L)
		 (assoc 8 (entget (ssname sel x)))
		 lst-ent))
   (entmake lst-ent)
   )
 (princ)
)

 

[Edité le 18/7/2007 par Bred]

[lecrabe]

 

Hello Bred

 

Encore merci pour ton aide :) :D

 

Le Decapode

 

[lecrabe]

 

Hello

 

J'ai fait 2 micro-modifs dans le Lisp pour créer éventuellement le calque si il n'existe pas déjà ... je ne comprend pas grand chose au coeur du programme , mais bon ça marche !

 

Voici donc le magnifique COEF_TXT.LSP de Bred

 

 

;; Creation de nouveaux textes a partir de textes NUMERIQUES existants

;; soit sur un calque EXISTANT (ATTENTION: le calque DOIT exister)

;; soit sur le calque COURANT

;; et APPLIQUE un Coefficient (Valeur numerique = xx.xx / -yy.yy)

;; La routine fonctionne sur des TEXTEs simples et NON PAS des MTEXTs

;; Taper au clavier COEF_TXT - Version 1.1

 

(defun c:COEF_TXT (/ COEF N-VAL SEL X L LST-ENT)

(vl-load-com)

(setq sel nil)

 

(while (not sel)

(setq sel (ssget '((0 . "*TEXT")))))

 

(initget 1)

 

(setq coef (getreal "\n Coefficient numerique a appliquer : "))

 

(setq sauvelayer (getvar "Clayer"))

(setq L (getstring T "\n Nom du Calque EXISTANT pour creer les textes ou ENTREE pour calque COURANT : "))

;; (if (equal L "") (setq L (getvar "Clayer")))

(if (equal L "") (setq L (getvar "Clayer")) (command "_-LAYER" "_M" L "") )

 

 

(if (not (tblobjname "LAYER" L))

(vla-add (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) L)

)

 

(repeat (setq x (sslength sel))

(setq N-val (* coef (atof (cdr (assoc 1 (entget (ssname sel (setq x (1- x))))))))

lst-ent (cdr (subst (cons 1 (rtos N-val))

(assoc 1 (entget (ssname sel x)))

(entget (ssname sel x))))

lst-ent (subst (cons 8 L)

(assoc 8 (entget (ssname sel x)))

lst-ent))

(entmake lst-ent)

)

 

;; Retour sur le calque courant

(command "_-LAYER" "_M" sauvelayer "")

 

(princ)

)

 

 

Le Decapode salue bien bas Bred :) :D :cool:

 

[Bred]

Re,

heu... c'est bizarre mais mon lisp créait déjà le calque si il n'existait pas .... :casstet:

 

; met un coef sur une valeur numérique de texte.
(defun c:coef-txt (/ COEF N-VAL SEL X L LST-ENT)
(vl-load-com)
(setq sel nil)
(while (not sel)
(setq sel (ssget '((0 . "*TEXT")))))

(initget 1)
(setq coef (getreal "\n Coefficient à appliquer :"))

(setq L (getstring T ":\n Nom du Calque sur Lequel créer les textes :"))

(if (equal L "") (setq L (getvar "Clayer")))

[b](if (not (tblobjname "LAYER" L))
(vla-add (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) L)
)[/b]

(repeat (setq x (sslength sel))
(setq N-val (* coef (atof (cdr (assoc 1 (entget (ssname sel (setq x (1- x))))))))
lst-ent (cdr (subst (cons 1 (rtos N-val))
(assoc 1 (entget (ssname sel x)))
(entget (ssname sel x))))
lst-ent (subst (cons 8 L)
(assoc 8 (entget (ssname sel x)))
lst-ent))
(entmake lst-ent)
)
(princ)
)

 

[Edité le 18/7/2007 par Bred]

[lecrabe]

 

Hello Bred

 

Ton Lisp tu l'as testé sur quelle version excatement d'AutoCAD ?

 

Moi je suis en ce moment avec une version 2005 !

 

C sur que mon horrible (command layer make ...

est particulièrement moche !

 

Le Decapode

 

 

 

[Bred]

HUUU !

Je le faisait sur 2008...

je viens de le tester sur 2006 : ça m'a fait carrément planter autocad (fermeture....)

je te tiens au courant.... :exclam:

[lecrabe]

 

ReHello Bred

 

J'ai fait cette horrible MODIF car ton programme me provoque une erreur irrécupérable et mortelle de type:

 

erreur: une exception s'est produite: 0xC0000005 (Violation d'accés)

avertissement: fonction unwind ignorée exception ...

 

Uniquement bien sur si le nom de calque fourni est inexistant dans le DWG ! :o

 

Le Decapode "bricolo" :exclam:

 

 

[lecrabe]

 

ReReHello

 

Si tu fais une jolie modfif pour qu'il fonctionne sur toutes les versions d'AutoCAD (Disons de la 2004 jusqu'à la 2008) sans surprise, SVP pourrais tu lui faire traiter AUSSI les MTEXTs numériques bien sur !?

 

Le Decapode

 

 

[Bred]

Alors là.... comprends pas....

Quand je fais fonctionner le lisp "petit à petit" en passant par le visual, pas de souci....

par contre, si je le fais en lançant la commande :

http://xs117.xs.to/xs117/07293/tetete.JPG

... et je ne trouve rien sur internet....

 

pourrais tu lui faire traiter AUSSI les MTEXTs numériques

:casstet:

c'est pas ce qu'il fait ?

[lecrabe]

 

Hello Bred

 

Mais OUI il traite aussi les MTEXT, je n'avais pas vu ton option / filtre subtil

avec l'étoile ( '"*TEXT" ) et donc comme le dit Patrick, cela va traiter aussi les RTEXT !

 

Aucune importance :)

 

Je pense que NOTRE bug est un problème classique et mystérieux du V-Lisp !

et qu'il dépend sans doute de la version d'AutoCAD !!

 

La fonction VLA-ADD se plante royalement !!! :o :(

 

Le Decapode "heureux quand même"

 

 

 

 

[Bred]

Re, lecrabe !

je vais ici révéler quelque chose : quand on arrive à un certain niveau, il faut comme en karaté revenir à une ceinture blanche, comme un départ à 0....

Pourquoi ?

la ligne de création de calque (vla-add ... est totalement inutile !

en effet : j'avais omis que la chose magique de l'utilsation de entmake, c'est la création automatique du calque !!!!

donc, ceci suffit ! :

; met un coef sur une valeur numérique de texte.
(defun c:coef-txt (/ COEF L LST-ENT N-VAL SEL X)
 (setq sel nil)
 (while (not sel)
   (setq sel (ssget '((0 . "*TEXT")))))

 (initget 1)
 (setq coef (getreal "\n Coefficient à appliquer :"))
 (setq L (getstring T (strcat ":\n Nom du Calque sur Lequel créer les textes : <" (getvar "Clayer")">")))
 (if (equal L "") (setq L (getvar "Clayer")))

 (repeat (setq x (sslength sel))
   (setq N-val (* coef (atof (cdr (assoc 1 (entget (ssname sel (setq x (1- x))))))))
  lst-ent (cdr (subst (cons 1 (rtos N-val))
		      (assoc 1 (entget (ssname sel x)))
		      (entget (ssname sel x))))
  lst-ent (subst (cons 8 L)
		 (assoc 8 (entget (ssname sel x)))
		 lst-ent))
   (entmake lst-ent)
   )
 (princ)
)

Désolé de t'avoir fait perdre du temps, mais je suis, je pense, un eternel débutant en lisp...

mais je persite ! :P

 

[Edité le 19/7/2007 par Bred]