programme LISP

[arbtlm]

Bonjour à tous, est ce que quelqu'un pourrais m'écrire un petit programme LISP  permettant de mettre à jour deux attributs d'un bloc Autocad ?

Pour l'instant je fais tout manuellement et je perd beaucoup de temps.

voici ce qu'il faudrait faire :

1- sélectionner le bloc de gauche (bloc TCPOINT)

2- sélectionner le bloc de droite (bloc TCPOINT1)

3- remplacer l'attribut  ALT du TCPOINT1 par celui du TCPOINT (remplacer 99.13 par 100.03 dans l'exemple)

4-remplacer l'attribut CH du TCPOINT1 par ALT-ZSG (remplacer 0.00 par 0.90 dans l'exemple) (100.03-99.13)

Merci d'avance si quelqu'un arrive à faire ça, ça serait top.

[braudpat]

Hello @arbtlm 

1) Desole mais je n'ai pas tout a fait la routine demandee !

2) La routine jointe "SwapAtt" de Gilles (gile) echange 2 attributs sur le meme Bloc !

Et elle permet de selectionner N Blocs a traiter ...

3) A partir de cette routine, un "bon" en Lisp devrait pouvoir l'adapter sur 2 Blocs et non pas sur 1 seul ...

La Sante, Bye, Patrice (The Old French EE Froggy)

[CADaSchtroumpf · Accepted solution]

Bonjour,

Ceci ferait-il l'affaire?

(vl-load-com)
(defun c:chg_att ( / js blk val_alt val_zsg)
  (princ "\nSelectionner un bloc TCPOINT source.")
  (cond
    ((setq js (ssget "_+.:E:S" '((0 . "INSERT") (66 . 1) (2 . "TCPOINT"))))
      (setq blk (vlax-ename->vla-object (ssname js 0)))
      (mapcar 
        '(lambda (att)
          (if (eq (vla-get-TagString att) "ALT") (setq val_alt (vla-get-TextString att)))
        )
        (vlax-invoke blk 'GetAttributes)
      )
      (princ "\nSelectionner un bloc TCPOINT1 cible.")
      (cond
        ((setq js (ssget "_+.:E:S" '((0 . "INSERT") (66 . 1) (2 . "TCPOINT1"))))
          (setq blk (vlax-ename->vla-object (ssname js 0)))
          (mapcar 
            '(lambda (att)
              (if (eq (vla-get-TagString att) "ALT") (vla-put-TextString att val_alt))
              (if (eq (vla-get-TagString att) "ZSG") (setq val_zsg (vla-get-TextString att)))
              (if (eq (vla-get-TagString att) "CH")
                (progn
                  (vla-put-TagString att "ALT-ZSG")
                  (vla-put-TextString att (rtos (- (atof val_alt) (atof val_zsg)) 2 2))
                )
              )
            )
            (vlax-invoke blk 'GetAttributes)
          )
        )
      )
    )
  )
  (prin1)
)

[braudpat]

Hello

Avec une instruction supplementaire au debut :

(vl-load-com)

Je pense que cela devrait aller !?

La Sante, Bye, Patrice

[Luna1]

Coucou,

Je veux bien le corriger pour gérer deux blocs différents mais...comment suis-je supposée savoir quels blocs sont ensembles si je dois traiter N blocs ?!

Voici un exemple pour gérer uniquement 2 références de blocs :

(defun c:CopyAtt (/ *error* getAtts selAtt source target o)
  (defun *error* (msg)
    (setvar "OSMODE" o)
    (princ msg)
  )
  (defun getAtts (ent / elst atts)
    (while (= "ATTRIB" (cdr (assoc 0 (setq elst (entget (setq ent (entnext ent)))))))
      (setq atts (cons (cons (strcase (cdr (assoc 2 elst))) elst) atts))
    )
  )
  (defun selAtt (msg / ent att)
    (while
      (and
        (setq ent (getpoint msg))
        (not
          (and
            (setq ent (nentselp ent))
            (cond
              ( (= "ATTRIB" (cdr (assoc 0 (entget (car ent)))))
                (setq ent (entget (car ent)))
              )
              ( (and
                  (setq ent (car (last ent)))
                  (= 'ENAME (type ent))
                  (setq ent (entget ent))
                  (= "INSERT" (cdr (assoc 0 ent)))
                  (setq att (getAtts (cdr (assoc -1 ent))))
                  (cond
                    ( (= 1 (length att)) (setq ent (cdar att)))
                    ( (progn
                        (initget 1 (apply 'strcat (mapcar '(lambda (a) (strcat (car a) " ")) att)))
                        (setq ent
                          (getkword
                            (strcat
                              "\nSélectionner l'attribut souhaité ["
                              (substr
                                (apply
                                  'strcat
                                  (mapcar '(lambda (a) (strcat "/" (car a))) att)
                                )
                                2
                              )
                              "] : "
                            )
                          )
                        )
                        (setq ent (cdr (assoc ent att)))
                      )
                    )
                  )
                )
              )
            )
            (setq att (cdr (assoc 2 ent)))
          )
        )
      )
      (princ "\nL'objet sélectionné n'est pas un attribut...")
    )
    (if (and ent att) (cons att ent))
  )
  (setq o (getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (if
    (and
      (setq source (selAtt "\nSélectionner l'attribut source : "))
      (setq target (selAtt "\nSélectionner l'attribut cible : "))
    )
    (entmod
      (subst
        (assoc 1 (cdr source))
        (assoc 1 (cdr target))
        (cdr target)
      )
    )
  )
  (setvar "OSMODE" o)
  (princ)
)

C'est pas perfect mais bon

Bisous,
Luna

[braudpat]

Hello @Luna1 / Luna

1) J'adore ta routine qui permet de cliquer sur les attributs

ou bien de cliquer sur le Bloc et choisir apres l'attribut ...

2) Mais ta routine ne fait pas exactement ce qui est demande (A mon avis) !

Pour moi elle copie le contenu du 1er attribut en "ecrasant" le contenu du 2eme attribut !?

3) Alors que la demande est : echanger le contenu des 2 attributs !

Ou alors je ne sais pas l'utiliser correctement !?

Bon WE, La Sante, Bye, Patrice

[arbtlm]

Merci beaucoup pour la rapidité de la réponse. Par contre je suis en week end. Je ne peut pas vérifier si votre programme fonctionne avant lundi. 

vivement lundi 😂

[arbtlm]

CADaSchtroumpf c'est top un grand merci à toi.

[Luna1]

Coucou lecrabe,
Il me semblait au contraire répondre à la demande grosso merdo étant donné qu'il faut :
3- remplacer l'attribut ALT du TCPOINT1 par celui du TCPOINT (remplacer 99.13 par 100.03 dans l'exemple)
4-remplacer l'attribut CH du TCPOINT1 par ALT-ZSG (remplacer 0.00 par 0.90 dans l'exemple) (100.03-99.13)

Donc je vois nulle part le besoin d'échanger la valeur entre les deux blocs d'un même attribut. Après peut-être ne suis-je pas suffisamment réveillée pour comprendre correctement la demande mais il me semble qu'il faut uniquement remplacer la valeur d'un attribut par un autre 😉

Et j'ai souvent du mal à répondre exactement au problème posé...j'aime pas quand un programme est limité par une valeur écrite en dur, définie par la demande d'un utilisateur ^^

Bisous,
Luna

[braudpat]

Hello @Luna1 

OUI je n'etais sans doute pas bien reveille !

Merci pour tes contributions "parametrables"

Bonne semaine, La Sante, Bye, Patrice

[arbtlm]

Bonjour, désolé de revenir sur le sujet, mais la fonction ne marche plus alors que je ne pense pas avoir changé quelque chose.

Apres avoir lancé la fonction, je sélectionne mon premier objet (le bloc TCPOINT) et la fonction me renvoie

; erreur: no function definition: VLAX-ENAME->VLA-OBJECT

@CADaSchtroumpf 

[CADaSchtroumpf]

---

@arbtlm  a écrit :

Bonjour, désolé de revenir sur le sujet, mais la fonction ne marche plus alors que je ne pense pas avoir changé quelque chose.

Apres avoir lancé la fonction, je sélectionne mon premier objet (le bloc TCPOINT) et la fonction me renvoie

; erreur: no function definition: VLAX-ENAME->VLA-OBJECT

@CADaSchtroumpf 

---

Insère une ligne vide au tout début du code dans la quelle tu tapes: (vl-load-com)

Enregistre le fichier et recharge le lisp.

[arbtlm]

je ne comprends pas à quel endroit dans le lisp il faut insérer la ligne vide.

[CADaSchtroumpf]

J'ai édité le message 3 où j'ai inséré la ligne manquante

Refais un copié-collé du code.

[arbtlm]

ca ne change rien, toujours la meme erreur.
Pourtant ton programme fonctionnait très bien jusqu'à la semaine dernière.

[CADaSchtroumpf]

Je ne vois pas trop, à moins qu'il reste un doublon du fichier ailleurs et que tu ne charge pas le bon ?

Essayes de copier-coller le code que j'ai édité (ET RIEN QUE LE CODE) directement dans la ligne de commande d'Autocad pour voir si la commande fonctionne à nouveau.

[arbtlm]

Non toujours pareil, j'ai essayé a partir de différents postes, le même problème.
Dans les recherches google il parlent de problème de mise à jour du registre dans le fichier vl16.tlb.
j'ai fait la manip à partir de ce forum (Autocad 2022), mais ça ne fonctionne pas

https://knowledge.autodesk.com/fr/support/autocad/troubleshooting/caas/sfdcarticles/sfdcarticles/FRA...

Sinon, serait il possible de compléter le code Elunelly qui ne fait que la première partie de ma demande initiale (mise à jour de la valeur ALT) il ne manque qu'a mettre à jour la valeur de CH avec une soustraction entre ALT-ZSG.

[CADaSchtroumpf · Accepted solution]

@arbtlm 

En ouvrant ton dessin d'exemple, on s'aperçoit que celui-ci n'a pas été produit par AutoDesk.

Il ce serait révélé par le passé que des fonction comme (vlax-invoke ne fonctionne toujours pas comme prévu avec des produits concurrents.

Donc j'ai reproduit le code en écartant ces fonctions et écrite en pure Lisp (vl-load-com) n'est plus nécessaire.

Ce code à de forte chance de fonctionner avec un produit concurrent comprenant le lisp.

(defun c:chg_att ( / js blk dxf_ent val_alt val_zsg)
  (princ "\nSelectionner un bloc TCPOINT source.")
  (cond
    ((setq js (ssget "_+.:E:S" '((0 . "INSERT") (66 . 1) (2 . "TCPOINT"))))
      (setq blk (ssname js 0))
      (while (/= (cdr (assoc 0 (setq dxf_ent (entget (entnext blk))))) "SEQEND")
        (if (eq (cdr (assoc 2 dxf_ent)) "ALT") (setq val_alt (cdr (assoc 1 dxf_ent))))
        (setq blk (cdar dxf_ent))
      )
      (princ "\nSelectionner un bloc TCPOINT1 cible.")
      (cond
        ((setq js (ssget "_+.:E:S" '((0 . "INSERT") (66 . 1) (2 . "TCPOINT1"))))
          (setq blk (ssname js 0))
					(while (/= (cdr (assoc 0 (setq dxf_ent (entget (entnext blk))))) "SEQEND")
						(if (eq (cdr (assoc 2 dxf_ent)) "ALT")
							(entmod (subst (cons 1 val_alt) (assoc 1 dxf_ent) dxf_ent))
						)
						(if (eq (cdr (assoc 2 dxf_ent)) "ZSG")
							(setq val_zsg (cdr (assoc 1 dxf_ent)))
						)
						(if (eq (cdr (assoc 2 dxf_ent)) "CH")
							(entmod (subst (cons 1 (rtos (- (atof val_alt) (atof val_zsg)) 2 2)) (assoc 1 dxf_ent) (subst (cons 2 "ALT-ZSG") (assoc 2 dxf_ent) dxf_ent)))
						)
						(setq blk (cdar dxf_ent))
					)
					(entupd blk)
        )
      )
    )
  )
  (prin1)
)

[arbtlm]

Salut @CADaSchtroumpf ta modification fonctionne sur mon poste.

Un grand merci à toi d'avoir pris du temps pour modifié ton 1er code.

T'es au TOP.

[braudpat]

Hello @arbtlm 

1) Merci @CADaSchtroumpf 

2) Au fait tu es avec quel logiciel: ZWCad, BricsCAD, etc ??

La Sante, Bye, Patrice