Routines pour TEXT/MTEXT

lecrabe · le 11 juillet 2007

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 · le 11 juillet 2007

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 · le 11 juillet 2007

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]

Patrick_35 · le 11 juillet 2007

Salut Bred

Ton filtre prends aussi les Rtexts

@+

Bred · le 11 juillet 2007

Salut Patrik_35.

Ben je vais te piquer ton filtre alors...

mais....

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

Patrick_35 · le 11 juillet 2007

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 · le 11 juillet 2007

Ok, merci !

lecrabe · le 11 juillet 2007

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 · le 11 juillet 2007

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 · le 11 juillet 2007

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 · le 12 juillet 2007

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 · le 12 juillet 2007

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 · le 12 juillet 2007

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 · le 18 juillet 2007

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 · le 18 juillet 2007

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 · le 18 juillet 2007

Hello Bred

Encore merci pour ton aide :) :D

Le Decapode

lecrabe · le 18 juillet 2007

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 · le 18 juillet 2007

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 · le 18 juillet 2007

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 · le 18 juillet 2007

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 · le 18 juillet 2007

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 · le 18 juillet 2007

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 · le 18 juillet 2007

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 · le 18 juillet 2007

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 · le 18 juillet 2007

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]

Connexion

Routines pour TEXT/MTEXT

Messages recommandés

lecrabe

Patrick_35

Bred

Patrick_35

Bred

Patrick_35

Bred

lecrabe

lecrabe

Bred

lecrabe

Bred

lecrabe

lecrabe

Bred

lecrabe

lecrabe

Bred

lecrabe

Bred

lecrabe

lecrabe

Bred

lecrabe

Bred

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante