Demande update Lisp XY Patrick_35

[duplanf]

Bonjour la communauté Autodesk France,

Je travaille en bureau d’étude structure béton, mon parcours professionnel m’a appris à utiliser les base d’Autocad 2D et qu’il y a autant de manière d’utiliser le programme qu’il y a d’utilisateur, hélas je n’ai pas appris le Lisp que j’ai découvert il y a quelques semaines.

Je suis persuadé que dans mon domaine nous n’utilisons pas les capacités du logiciel, la preuve en est en parcourant ce forum. Nos clients, essentiellement des maçons nous demandent des éléments que nous n’avions pas l’habitude de donner auparavant, dans mon cas des coordonnées XY suivant un point 0.

J’ai trouvé la Lisp de Patrick_35 qui répond à mes attentes suivant ce post de 2005 (https://forums.autodesk.com/t5/autocad-francais/bloc-avec-en-attribut-ses-coordonnees-xy/td-p/145432...), oui je déterre un vieux sujet. Mon bloc reprend les mêmes étiquettes du poste c-a-d :

« Nom du bloc: XY
1ere etiquette: Numero (c est le numero du point que je defini a l insertion du bloc)
2eme etiquette: X (coordonnee X du point d insertion du bloc)
3 eme etiquette :Y (coordonnee Y du point d insertion du bloc) »

Je compte reprendre cette Lisp, sauf si je ne me trompe, car cette méthode me semble plus simple qu’un bloc composé d’un point plus du texte avec un champ (lors de mes essaies, le bloc ne se mettait pas à jour malgré des Regens ou la commande Explose, et le texte n’était pas déplaçable comme peuvent l’être les étiquettes).

Le code est le suivant (toujours d’après le post indiqué):

(defun Attributs_xyz(Rea Cde / bl js js1 n xyz)
  (cond
    ((or (eq (car Cde) "MOVE") (eq (car Cde) "STRETCH"))
      (setq js (ssget "_p"))
    )
    ((eq (car Cde) "INSERT")
      (setq js (ssadd))
      (ssadd (entlast) js)
    )
    ((or (eq (car Cde) "UCS") (eq (car Cde) "COPY") (eq (car Cde) "GRIP_MOVE") (eq (car Cde) "GRIP_STRETCH"))
      (setq js (ssget "x" (list (cons 0 "INSERT") (cons 2 "XY"))))
    )
  )
  (if js
    (progn
      (setq n 0)
      (while (ssname js n)
        (setq bl (entget (ssname js n)))
        (if (and (eq (cdr (assoc 0 bl)) "INSERT") (eq (strcase (cdr (assoc 2 bl))) "XY"))
          (if (cdr (assoc 66 bl))
            (progn
              (setq xyz (trans (cdr (assoc 10 bl)) (cdr (assoc -1 bl)) 1))
              (while (not (eq (cdr (assoc 0 bl)) "SEQEND"))
                (if (eq (cdr (assoc 0 bl)) "ATTRIB")
                  (cond
                    ((eq (strcase (cdr (assoc 2 bl))) "X")
                      (setq bl (subst (cons 1 (rtos (car xyz))) (assoc 1 bl) bl))
                      (entmod bl)
                      (entupd (cdr (assoc -1 bl)))
                    )
                    ((eq (strcase (cdr (assoc 2 bl))) "Y")
                      (setq bl (subst (cons 1 (rtos (cadr xyz))) (assoc 1 bl) bl))
                      (entmod bl)
                      (entupd (cdr (assoc -1 bl)))
                    )
                  )
                )
                (setq bl (entget (entnext (cdr (assoc -1 bl)))))
              )
            )
          )
        )
        (setq n (1+ n))
      )
    )
  )
  (princ)
)

(defun c:spt(/ i j n)
  (if (vlr-reactors :vlr-Command-Reactor)
    (progn
      (setq n 1)
      (while (setq i (nth n (car (vlr-reactors :vlr-Command-Reactor))))
        (if (eq (cdr (car (vlr-reactions i))) 'ATTRIBUTS_XYZ)
          (setq j i)
        )
        (setq n (1+ n))
      )
      (if j
        (vlr-remove j)
      )
      (if mrea_mpt
        (princ "\n\tDésactivation de la mise à jour XY du bloc XY.")
      )
      (setq mrea_mpt nil)
    )
  )
  (princ)
)

(defun c:mpt()
  (if (not mrea_mpt)
    (progn
      (c:spt)
      (setq mrea_mpt (vlr-command-reactor nil '((:vlr-commandEnded . Attributs_xyz))))
      (princ "\n\tActivation de de la mise à jour XY du bloc XY.")
    )
    (princ "\n\tLa mise à jour XY du bloc XY est déjà activée.")
  )
  (princ)
)

(vl-load-com)
(princ "\n\tPour activer la mise à jour XY du bloc XY, lancez la commande MPT.\n\tPour revenir à la normale, faites la commande SPT.")
(princ)

Ma demande est la suivante et paraît simple au premier abord que l’on connaisse ou pas le Lisp. Je souhaite avoir respectivement avant les abscisses et les ordonnées le préfix « x : » et « y : ».

Je vous remercie d’avance.

[patrick_35]

Salut

Il n'est plus tout jeune le lisp 

Tu remplaces

(cons 1 (rtos (car xyz)))

par

(strcat "x : " (cons 1 (rtos (car xyz))))

et

(cons 1 (rtos (cadr xyz))

par

(strcat "y : " (cons 1 (rtos (cadr xyz)))

@+

[duplanf]

En remplacant le code soumis, puis en le chargeant dans Autocad (v2015 Full) j'ai le message d'erreur suivant:

"Commande: (LOAD "C:/Users/f.duplan/Documents/ABAK/Autocad/mpt.lsp") ; erreur: structure incorrecte de la liste en entrée"

J'ai la portion de code suivante après avoir remplacé l'ancien:

                  (cond
                    ((eq (strcase (cdr (assoc 2 bl))) "X")
                      (setq bl (subst (strcat "x : " (cons 1 (rtos (car xyz))) (assoc 1 bl) bl))
                      (entmod bl)
                      (entupd (cdr (assoc -1 bl)))
                    )
                    ((eq (strcase (cdr (assoc 2 bl))) "Y")
                      (setq bl (subst (strcat "y : " (cons 1 (rtos (cadr xyz))) (assoc 1 bl) bl))
                      (entmod bl)
                      (entupd (cdr (assoc -1 bl)))
                    )
                  )

Merci de vos réponses.

[patrick_35]

Regarde bien ma réponse et ton copier/coller. Il te manque à chaque fois une parenthèse fermante. il faut 4 parenthèses après

xyz))))

LISP : Lost In Stupid Parenthesis

@+

[duplanf]

Effectivement, c'est bien "Lost In Stupid Parenthesis" mais ce message "Spécifiez le point d'insertion ou [Pointdebase/Echelle/X/Y/Z/rOtation]: ; erreur: type d'argument incorrect: stringp (1 . "186.2")" que signifie t'il ?

Le bloc est bien inséré mais les coordonnées n'aparaissent pas, et ne se mettent pas à jour lorsque que je déplace le bloc donc est-ce mon bloc ou bien la LISP ?

J'ai bien peur de ne pas avoir fair une nouvelle fois la bonne manip quelque part.

[Kevin_Megel]

---

patrick_35 a écrit :

LISP : Lost In Stupid Parenthesis

---

un peux tout les code c'est comme ça non ?

[patrick_35]

Salut

Oui, du moins pour les lisps car on est très vite perdu avec toutes ces parenthèses.

Le lisp est un langage intelligent car on peut jouer avec les fonctions et les variables comme dans cet exemple

(mapcar '(lambda(x)(set_tile x (eval (read x)))) '("titr" "nbin" "ipas" "ind0")) ; Les variables sont les mêmes que dans la boite de dialogue

Ou encore, une fonction qui apprend

@duplanf  Je ne t'oublie pas, j'ai juste une urgence

@+

[Kevin_Megel]

ARf je comprend mieux le python !

[patrick_35 · Accepted solution]

Salut

Je viens de tester avec le code modifié et tout fonctionne

Le code au cas où

(defun Attributs_xyz(Rea Cde / bl js js1 n xyz)
  (cond
    ((or (eq (car Cde) "MOVE") (eq (car Cde) "STRETCH"))
      (setq js (ssget "_p"))
    )
    ((eq (car Cde) "INSERT")
      (setq js (ssadd))
      (ssadd (entlast) js)
    )
    ((or (eq (car Cde) "UCS") (eq (car Cde) "COPY") (eq (car Cde) "GRIP_MOVE") (eq (car Cde) "GRIP_STRETCH"))
      (setq js (ssget "x" (list (cons 0 "INSERT") (cons 2 "XY"))))
    )
  )
  (if js
    (progn
      (setq n 0)
      (while (ssname js n)
        (setq bl (entget (ssname js n)))
        (if (and (eq (cdr (assoc 0 bl)) "INSERT") (eq (strcase (cdr (assoc 2 bl))) "XY"))
          (if (cdr (assoc 66 bl))
            (progn
              (setq xyz (trans (cdr (assoc 10 bl)) (cdr (assoc -1 bl)) 1))
              (while (not (eq (cdr (assoc 0 bl)) "SEQEND"))
                (if (eq (cdr (assoc 0 bl)) "ATTRIB")
                  (cond
                    ((eq (strcase (cdr (assoc 2 bl))) "X")
                      (setq bl (subst (cons 1 (strcat "X:" (rtos (car xyz)))) (assoc 1 bl) bl))
                      (entmod bl)
                      (entupd (cdr (assoc -1 bl)))
                    )
                    ((eq (strcase (cdr (assoc 2 bl))) "Y")
                      (setq bl (subst (cons 1 (strcat "Y:" (rtos (cadr xyz)))) (assoc 1 bl) bl))
                      (entmod bl)
                      (entupd (cdr (assoc -1 bl)))
                    )
                  )
                )
                (setq bl (entget (entnext (cdr (assoc -1 bl)))))
              )
            )
          )
        )
        (setq n (1+ n))
      )
    )
  )
  (princ)
)

(defun c:spt(/ i j n)
  (if (vlr-reactors :vlr-Command-Reactor)
    (progn
      (setq n 1)
      (while (setq i (nth n (car (vlr-reactors :vlr-Command-Reactor))))
        (if (eq (cdr (car (vlr-reactions i))) 'ATTRIBUTS_XYZ)
          (setq j i)
        )
        (setq n (1+ n))
      )
      (if j
        (vlr-remove j)
      )
      (if mrea_mpt
        (princ "\n\tDésactivation de la mise à jour XY du bloc XY.")
      )
      (setq mrea_mpt nil)
    )
  )
  (princ)
)

(defun c:mpt()
  (if (not mrea_mpt)
    (progn
      (c:spt)
      (setq mrea_mpt (vlr-command-reactor nil '((:vlr-commandEnded . Attributs_xyz))))
      (princ "\n\tActivation de de la mise à jour XY du bloc XY.")
    )
    (princ "\n\tLa mise à jour XY du bloc XY est déjà activée.")
  )
  (princ)
)

(vl-load-com)
(princ "\n\tPour activer la mise à jour XY du bloc XY, lancez la commande MPT.\n\tPour revenir à la normale, faites la commande SPT.")
(princ)

@+

[duplanf]

Merci beaucoup.