Besoin d'aide en Lisp

[balyoa]

Bonjour,

 

J'aurais besoin d'un coup de main sur un programme en lisp (programme développé par un certain Olivier qui a changé de crémerie apparemment), d'ailleurs si il rode par là je le cherche activement ;-)

 

Mon programme (ci-dessous), à la base, traite un dessin à la recherche de blocs anonymes, dont le nom commence par "*U", et les remplace par des blocs points avec attributs. Le probleme c'est que là j'ai un dessin avec des blocs à substituer dont le nom commence par "_N". J'ai essayé de modifier mon lisp mais il ne marche pas. Quand je lance le lisp, je sélectionne les objets à traiter et il me renvoie juste "(nil <Selection set: 11cd>)" .

 

Je cherche un peu d'aide svp. Je peux si nécessaire vous faire passer un exemple de fichier DWG.

 

Merci d'avance.

 

(defun C:toto ( / NomCalque JEU I f NbJeu Elt EltLst EltBlcName EntTxt TXT PT JEU2)
 (setvar "ATTDIA" 0)
 (setvar "ATTREQ" 1)
 (setq JEU (ssget (list (cons 0 "INSERT"))))
 (setq I 0  NbJeu (sslength JEU))
 (setq f (open "c:\\pts.txt" "w"))
 (setq JEU2 (ssadd))
 (repeat NbJeu
   (setq Elt (ssname JEU I))
   (setq I (1+ I))
   (setq EltLst (entget Elt))
   (setq EltBlcName (cdr (assoc 2 EltLst)))
   (setq EltLayer (cdr (assoc 8 EltLst)))
   (setvar "CLAYER" EltLayer)
   (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))
      (setq EntPTopoLst (subst (cons  8 EltLayer) (assoc 8 EntPTopoLst) EntPTopoLst))
      (entmod EntPTopoLst)
      (entupd EntPTopo)
      )
             ;; SI le 2nd élément n'est pas un texte
             (ssadd Elt JEU2)
	    )
           ;; SI pas de 2nd élément
           (ssadd Elt JEU2)
         ) ; Fin EntTxt
         ;; SI le 1er élément n'est pas un cercle
         (ssadd Elt JEU2)
) ; Fin test du Cercle
     ) ; fin EntCercle
     ;; SI bloc pas nommé *U
     (ssadd Elt JEU2)
   ) ; Fin du test du nom du bloc *U
 )
 (close f)
 (setvar "ATTDIA" 1)
 (sssetfirst nil JEU2)
)

[lecrabe]

Hello le Grenoblois

 

Eh oui, Olivier a quitte Brest (15 ans d'air marin) pour s'installer en Ile de France

 

mais il est tres actif neanmoins sous un nouveau login : Olivier Eckmann

 

Bon Dimanche, Le Decapode (lecrabe)