Résolu : Re : Demande update Lisp XY Patrick_35

duplanf · ‎10-27-2015

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 · ‎10-28-2015

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)))

@+

Les Lisps de Patrick_35

duplanf · ‎10-28-2015

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 · ‎10-28-2015

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

@+

Les Lisps de Patrick_35

duplanf · ‎10-28-2015

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 · ‎10-29-2015

patrick_35 a écrit :

LISP : Lost In Stupid Parenthesis

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

Kevin Megel
Ce post vous a été utile ? N'hésitez pas à aimer ce post.
Ce post a-t-il répondu à votre question ? Cliquez sur le bouton Accepter la solution.

Je suis un simple utilisateur, je ne travaille pas pour Autodesk

patrick_35 · ‎10-29-2015

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

@+

Les Lisps de Patrick_35

Kevin_Megel · ‎10-29-2015

ARf je comprend mieux le python !

Kevin Megel
Ce post vous a été utile ? N'hésitez pas à aimer ce post.
Ce post a-t-il répondu à votre question ? Cliquez sur le bouton Accepter la solution.

Je suis un simple utilisateur, je ne travaille pas pour Autodesk

patrick_35 · ‎11-04-2015

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)

@+

Les Lisps de Patrick_35

duplanf · ‎11-04-2015

Merci beaucoup.

Demande update Lisp XY Patrick_35

Demande update Lisp XY Patrick_35

Liens vers les forums

Publier dans les forums