Lier 2 LISP

[nicolas2]

Bonjour à tous, vivement la fin de l'hiver... :( , c'est long cette année !

 

J'ai 2 LISP's (récemment écrit par de grands bonhommes de chez CADxp que je remercie encore !) et je voudrais les compiler (en rajoutant une "bricole" au passage).

 

1 ière routine me permettant de tout nettoyer sur mon dessin, sauf des cercles d'un Ø donné.

2 ième routine me permettant de choisir un ordre sur ces cercles.

 

Sur la 1ière routine je voudrais qu'au moment du "nettoyage", tous les cercles restant soit mis dans un calque UT1. Si le calque UT1 (Trait continu blanc, genre calque 0...) n'existe pas, il sera créé.

 

Déroulement du programme :

1 - Je clique sur un icône (déja créé lien avec la routine)

2 - Je clique sur 1 cercle (nettoyage + mis sous UT1 (créé si non existant))

3 - Les cliques suivant je choisi l'ordre

 

Est-il possible de rajouter un message (après avoir cliquer sur l'icône) en haut à gauche de l'écran par exemple, pour suivre les étapes du déroulement. En fait, faire apparaitre ce qui se trouve sur la ligne commande.

NETTOYAGE + UT1 (arrêt après le clique sur le cercle)

puis ORDRE (pendant tout le déroulement de la 2ième routine).

 

En relisant mon souhait, je me rend compte que j'en demande beaucoup, mais si quelqu'un peut s'y pencher dessus.

 

1 ière routine :

 

(defun c:nettoyeur ()
((lambda ( / ent dxf_ent js jsc n)
(while (null (setq ent (entsel "\nDésigner un cercle type: "))))
(setq dxf_ent (entget (car ent)))
(cond
((eq (cdr (assoc 0 dxf_ent)) "CIRCLE")
(setq
js (ssget "_x" (list (assoc 410 dxf_ent) (assoc 67 dxf_ent)))
jsc (ssget "_x" (list (assoc 0 dxf_ent) (assoc 410 dxf_ent) (assoc 67 dxf_ent) (assoc 40 dxf_ent)))
n -1
)
(repeat (sslength jsc)
(ssdel (ssname jsc (setq n (1+ n))) js)
)
(if js (command "_.erase" js ""))
)
)
)) 
)

2 ième routine :

 

(defun c:ordre ( / nw_js js n i l_dxf h)
(setq nw_js (ssadd) i 0)
(while (setq js (ssget"_:S"))
(ssadd (ssname js 0) nw_js)
(setq l_dxf (entget (ssname js 0)))
(setq h (* (cdr (assoc 40 l_dxf)) 0.5) i (1+ i))
(entmake
(list
'(0 . "TEXT")
'(10 0. 0. 0.)
(cons 11 (cdr (assoc 10 l_dxf)))
(cons 40 h)
(cons 1 (itoa i))
'(72 . 1)
'(73 . 2)
)
)
)
(setq js (ssget "_X"))
(cond
(js
(repeat (setq n (sslength js))
(ssadd (ssname js (setq n (1- n))) nw_js)
)
)
)
(cond
(nw_js
(setq n -1)
(repeat (sslength nw_js)
(entmake (setq l_dxf (entget (ssname nw_js (setq n (1+ n))))))
(entdel (cdar l_dxf))
)
)
)
(prin1)
)

 

Mes remerciements sont sincères.

[nicolas2]

Bon, mon message est imbuvabe ! :mad:

une seule question à la fois.

 

La 1ière routine efface tout sauf les cercles de ØX.

Peut-on (en même temps que tout est effacé sauf les cercles) les mettre dans le calque UT1 (du même type que le calque 0 (trait continu - blanc...)) et créer automatiquemlent (inséré dans la routine) ce calque s'il est inexistant ?

 

Cela me paraît plus propre comme explication :P

 

Merci à tous pour votre aide !

[bonuscad]

une seule question à la fois.

 

Observes bien les modifications, c'est comme cela que l'on apprend les subtilités du langage.

 

(defun c:nettoyeur ( / ent dxf_ent js jsc n)
 (while (null (setq ent (entsel "\nDésigner un cercle type: "))))
 (setq dxf_ent (entget (car ent)))
 (cond
   ((eq (cdr (assoc 0 dxf_ent)) "CIRCLE")
     (setq
       js (ssget "_x" (list (assoc 410 dxf_ent) (assoc 67 dxf_ent)))
       jsc (ssget "_x" (list (assoc 0 dxf_ent) (assoc 410 dxf_ent) (assoc 67 dxf_ent) (assoc 40 dxf_ent)))
       n -1
     )
     (repeat (sslength jsc)
       (ssdel (ssname jsc (setq n (1+ n))) js)
     )
     (if (not (tblsearch "LAYER" "UT1"))
       (entmake '((0 . "LAYER")
       (100 . "AcDbSymbolTableRecord")
       (100 . "AcDbLayerTableRecord")
       (2 . "UT1")
       (70 . 0)
       (62 . 7)
       (6 . "Continuous")
       (290 . 1)
       (370 . -3)
      )
      )
     )
     (if js
       (repeat (setq n (sslength js))
         (entdel (ssname js (setq n (1- n))))
       )
     )
     (if jsc
       (repeat (setq n (sslength jsc))
         (entmod (subst '(8 . "UT1") (assoc 8 (setq dxf_ent (entget (ssname jsc (setq n (1- n)))))) dxf_ent))
       )
     )
   )
 )
 (prin1)
)

[nicolas2]

Merci Bonucad pour ta réponse.

Vu mes compétences en LISP et après de multiples essais, le lien entre les 2 lisps ne se fait pas.

La 2ième question ne m'est jamais posé, la routine 1 s'arrrête comme si la suite de la routine était ignorée.

Merci pour votre aide !

[nicolas2]

Bonjour, voila où j'en suis :

 

(defun c:nettoyeur ( / ent dxf_ent js jsc n)
(while (null (setq ent (entsel "\nDésigner un cercle type: "))))
(setq dxf_ent (entget (car ent)))
(cond
((eq (cdr (assoc 0 dxf_ent)) "CIRCLE")
(setq
js (ssget "_x" (list (assoc 410 dxf_ent) (assoc 67 dxf_ent)))
jsc (ssget "_x" (list (assoc 0 dxf_ent) (assoc 410 dxf_ent) (assoc 67 dxf_ent) (assoc 40 dxf_ent)))
n -1
)
(repeat (sslength jsc)
(ssdel (ssname jsc (setq n (1+ n))) js)
)
(if (not (tblsearch "LAYER" "UT1"))
(entmake '((0 . "LAYER")
(100 . "AcDbSymbolTableRecord")
(100 . "AcDbLayerTableRecord")
(2 . "UT1")
(70 . 0)
(62 . 7)
(6 . "Continuous")
(290 . 1)
(370 . -3)
)
)
)
(if js
(repeat (setq n (sslength js))
(entdel (ssname js (setq n (1- n))))
)
)
(if jsc
(repeat (setq n (sslength jsc))
(entmod (subst '(8 . "UT1") (assoc 8 (setq dxf_ent (entget (ssname jsc (setq n (1- n)))))) dxf_ent))
)
)
)
)
( / nw_js js n i l_dxf h)
(setq nw_js (ssadd) i 0)
(while (setq js (ssget"_:S"))
(ssadd (ssname js 0) nw_js)
(setq l_dxf (entget (ssname js 0)))
(setq h (* (cdr (assoc 40 l_dxf)) 0.5) i (1+ i))
(entmake
(list
'(0 . "TEXT")
'(10 0. 0. 0.)
(cons 11 (cdr (assoc 10 l_dxf)))
(cons 40 h)
(cons 1 (itoa i))
'(72 . 1)
'(73 . 2)
)
)
)
(setq js (ssget "_X"))
(cond
(js
(repeat (setq n (sslength js))
(ssadd (ssname js (setq n (1- n))) nw_js)
)
)
)
(cond
(nw_js
(setq n -1)
(repeat (sslength nw_js)
(entmake (setq l_dxf (entget (ssname nw_js (setq n (1+ n))))))
(entdel (cdar l_dxf))
)
)
)
(prin1)
) 

avec maintenant comme message d'erreur :

[surligneur] Désigner un cercle type: ; erreur : type d'argument incorrect : numberp : nil[/surligneur]

 

Merci à vous

[(gile)]

Salut,

 

Tout d'abord, pense à mette le code que tu postes entre des balises bbcode :

[code] le code ici [/code]

(tu peux utiliser le bouton #)

 

L'erreur : "; erreur : type d'argument incorrect : numberp : nil" veut dire qu'une fonction attend un nombre comme arguement mais que l'argument qui lui est passé est nil.

Pour localiser une erreur dans un LISP, on peut utiliser la méthode décrite ici (D'où vient l'erreur).

 

Dans le cas pré"sent, l'erreur vient de l'expression :

(/ nw_js js n i l_dxf h)

Dans le LISP original, cette expression était la déclaration des variables (deuxième argument de la fonction defun).

Ici, elle est placée au milieu du code et l'interpréteur cherche à l'évaluer comme tout expression. donc à effectuer une division (/) avec des variables qui sont nil, d'où l'erreur.

 

Pour que ton assemblage fonctionne, il faut supprimer cette expression.

Pour q'uen plus, il soit "propre", il faudrait mettre ces variables à la suite de celles déclarées au début du code :

( / ent dxf_ent js jsc n nw_js i l_dxf h)

[nicolas2]

Merci Gile. Cela fonctionne très bien.

Mon problème vient que je survole le LISP et qu'à chaque routine je bloque et suis obligé de vous demander conseil.

 

Que penses-tu de ceci pour "évoluer"

 

http://img12.imageshack.us/img12/8020/programmerautocadov3.jpg

 

Merci de votre aide et de vos conseils