Besoin d\'un coup de main en Lisp

[balyoa]

Bonjour,

 

Ne maîtrisant pas trop le lisp, j'ai un programme (qui marche bien) mais que je souhaiterais optimiser. Voilà ce que fait le programme :

 

- dans mon dessin j'ai des blocs anonymes nommés *Uxxxx qui représentent des altitudes.

- le programme remplace ces blocs par des blocs points topo (type covadis) avec matricule et altitude en attribut. Il récupère l'altitude dans le texte du bloc anonyme, ainsi que la position et la rotation du texte.

 

Par contre le programme doit être lancé pour chaque calque, et écrit les blocs dans le calque courant, et les attributs dans les calques définis au sein du bloc point de remplacement. Je souhaiterais que le lisp puisse traiter plusieurs layers à la suite, et écrire les blocs et les attributs dans les layers des blocs anonymes d'origine, ou bien dans les layers à choisir.

 

Je ne sais pas si c'est clair, mais voici le lisp en question :

 

(defun C:toto ( / NomCalque JEU I f NbJeu Elt EltLst EltBlcName EntTxt TXT PT)

(setq JEU (ssget (list (cons 0 "INSERT"))))

(setq I 0 NbJeu (sslength JEU))

(setq f (open "c:\\pts.txt" "w"))

(repeat NbJeu

(setq Elt (ssname JEU I))

(setq I (1+ I))

(setq EltLst (entget Elt))

(setq EltBlcName (cdr (assoc 2 EltLst)))

(if (= "*U" (substr EltBlcName 1 2))

(if (setq EntCercle (cdr (assoc -2 (tblsearch "BLOCK" EltBlcName))))

(if (= (cdr (assoc 0 (entget EntCercle))) "CIRCLE")

(if (setq EntTxt (entnext EntCercle))

(if (= (cdr (assoc 0 (entget EntTxt))) "TEXT")

(progn

(setq TXT (cdr (assoc 1 (entget EntTxt))))

(setq PtBloc (cdr (assoc 10 EltLst)))

(setq PtCercle (cdr (assoc 10 (entget EntCercle))))

(setq X (+ (car PtBloc) (car PtCercle)))

(setq Y (+ (cadr PtBloc) (cadr PtCercle)))

(setq Rot (cdr (assoc 50 (entget EntTxt))))

(setq Rot (- 0.0 (* 200.0 (/ Rot PI))))

(write-line (strcat (rtos X 2 4) "," (rtos Y 2 4) "," TXT) f)

(command "-inserer" "PTSA" (list X Y 0.0) "" "" Rot (itoa I) TXT)

(setq EntPTopo (entlast))

(setq PtTxt (cdr (assoc 10 (entget EntTxt))))

(setq X (+ (car PtBloc) (car PtTxt)))

(setq Y (+ (cadr PtBloc) (cadr PtTxt)))

(setq EntPTopoLst (entget (entnext (entnext EntPTopo))))

(setq EntPTopoLst (subst (cons 72 0) (assoc 72 EntPTopoLst) EntPTopoLst))

(setq EntPTopoLst (subst (cons 74 0) (assoc 74 EntPTopoLst) EntPTopoLst))

(setq EntPTopoLst (subst (cons 11 (list 0.0 0.0 0.0)) (assoc 11 EntPTopoLst) EntPTopoLst))

(setq EntPTopoLst (subst (cons 10 (list X Y 0.0)) (assoc 10 EntPTopoLst) EntPTopoLst))

(entmod EntPTopoLst)

(entupd EntPTopo)

)

)

) ; Fin EntTxt

) ; Fin test du Cercle

) ; fin EntCercle

) ; Fin du texte du nom du bloc *U

)

(close f)

)

 

 

Si l'un d'entre vous a une idée sur la façon d'optimiser le lisp, je suis preneur. Je peux aussi faire passer un exemple de fichier Dwg à traiter par mail.

 

Merci d'avance pour votre aide.

 

Cordialement.

 

Yoann

 

 

 

[Edité le 25/1/2010 par balyoa]

[lecrabe]

 

Hello

 

Ce charmant programme ne viendrait il pas de notre ami Olivier Eckmann

de Geomedia Brest (www.geo-media.com)

qui repond souvent sur ce forum avec l'alias "covasupport" ?

 

Le Decapode

 

 

 

 

[didier]

coucou

 

mets un dwg à disposition

 

je regarderai ce que je peux faire,

sans manquer de respect à Géomédia

si l'idée du Décapode s'avère

 

amicalement

[balyoa]

Bonjour,

 

En effet, encore un lisp d'Olivier Eckmann qui m'a déjà débrouillé pas mal de problème avec ses lisp.

Et il a trouvé le temps de me le modifier hier soir, donc je teste et si c'est ok je clos le sujet (en publiant la source modifiée si j'ai son autorisation).

 

Merci de votre attention et bonne journée.

 

Cordialement

[lecrabe]

 

Hello

 

Tu passeras le bonjour a Olivier que j'ai au telephone de temps en temps

ainsi qu'a son collegue Thierry :)

 

En effet ce Lisp serait interessant ... :D

 

Le Decapode