[Résolu] MACRO avec ATTEDIT ou GATTE

[La Lozère]

Bonjour,

Voici mon problème.

J'ai 100 fichiers, chacun contenant un bloc cartouche avec attributs. Je vais donc macroter tout ça et utiliser SuperAutoScript.

 

Sur ces 100 fichier, je souhaite changer la date.

Sur ces 100 fichiers, pour l'instant j'ai des dates différentes.

 

Au départ, je pensais utiliser -ATTEDIT, oui mais voilà, il faudrait que la date sois la même sur chaque fichier, car à un moment de la commande, on demande la valeur de l'attribut en question à changer. Or moi, c'est variable d'un fichier à l'autre

 

Ensuite, j'ai trouvé la commande GATTE des Expres Tools, seulement, apparemment il y a un bug dans la commande.

Pour utiliser la commande par une macro, il faut utiliser le clavier.

Donc en lançant la commande GATTE, voici ce que j'obtiens:

 

GATTE

Select block or attribute [Block name]: B

Enter block name: BLO_CARTOUCHE

Known tag names for block: STATUT_6 DESCRIPTION_6 VALIDE_6 VERIFIE_6 ETABLI_6 DATE_6 IND_6 STATUT_5 DESCRIPTION_5 VALIDE_5 VERIFIE_5 ETABLI_5 DATE_5 IND_5 STATUT_4 DESCRIPTION_4 VALIDE_4 VERIFIE_4 ETABLI_4 DATE_4 IND_4 STATUT_3 DESCRIPTION_3 VALIDE_3 VERIFIE_3 ETABLI_3 DATE_3 IND_3 STATUT_2 DESCRIPTION_2 VALIDE_2 VERIFIE_2 ETABLI_2 DATE_2 IND_2 STATUT_1 DESCRIPTION_1 VALIDE_1 VERIFIE_1 ETABLI_1 DATE_1 IND_1 STATUT_0 DESCRIPTION_0 VALIDE_0 NB_PAGES VERIFIE_0 ETABLI_0 DATE_0 IND_0 X-Y-Z DOSSIER CLASSEMENT ECHELLE FORMAT TITRE_4 TITRE_3 TITRE_2 TITRE_1

Select attribute or type attribute name: DATE_0

*Sélection non valable*

Attend un point ou STATU

Select attribute or type attribute name:

 

En rouge, la partie où ça bug.

Impossible de lui saisir le nom de l'attribut à modifier. Si je clic l'attribut, ça marche.

 

Est-ce que quelqu'un aurait une idée pour débloquer la situation?

 

Merci.

[jpeg]

Bonjour

j'utilise un lisp de patrick_35 (PAT V1.01 Mettre tous les attributs à la même valeur)

pour modifier les valeurs de mon cartouche

Cdt

[vincentp010]

Je viens de parcourir le lisp gatte.

A un moment il y a un initget avec la liste des attributs, or il ne peut y avoir de "_" dans les noms avec initget.

[(gile)]

Salut,

 

tu dois pouvoir utiliser directement cette expression LISP après avoir remplacé "03/05/2017" par la date que tu veux (mais en conservant les guillemets).

Essaye d'abord en collant l'expression sur la ligne de commande, puis, si ça fonctionne, intègre là dans le script.

 

(if (setq s (ssget "_X" '((0 . "INSERT") (2 . "BLO_CARTOUCHE"))))
 (repeat (setq i (sslength s))
   (setpropertyvalue
     (ssname s (setq i (1- i)))
     "DATE_0"                          ; étiquette de l'attribut
     "03/05/2017"                      ; valeur de l'attribut
   )
 )
)

[jpeg]

;;;=================================================================

;;;

;;; PAT V1.01

;;;

;;; Mettre tous les attributs à la même valeur

;;;

;;; Copyright © Patrick_35

;;;

;;;=================================================================

 

(defun c:pat(/ bl choix dcl_id doc js ent fic lay liste_bl liste_at liste_att lst n modif

nom_bloc old old_error posbl posat resultat rep sav sel tot val_at

*errmat* MsgBox modif_at rech_at affiche affiche_va rech_bl rech_blat dirbox

affiche_rep rechercher_blocs ouvrir_dessin_dbx)

 

;;;---------------------------------------------------------------

;;;

;;; Gestion des erreurs

;;;

;;;---------------------------------------------------------------

 

(defun *errmat* (msg)

(or (member (strcase msg) '("FUNCTION CANCELLED" ""QUIT / EXIT ABORT"" "FONCTION ANNULEE" "QUITTER / SORTIR ABANDON"))

(princ (strcat "\nErreur : " msg))

)

(setq *error* old_error)

(unload_dialog dcl_id)

(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))

(princ)

)

 

;;;---------------------------------------------------------------

;;;

;;; Afficher un message

;;;

;;;---------------------------------------------------------------

 

(defun MsgBox (Titre Bouttons Message / Reponse WshShell)

(setq WshShell (vlax-create-object "WScript.Shell"))

(setq Reponse (vlax-invoke WshShell 'Popup Message 0 Titre (itoa Bouttons)))

(vlax-release-object WshShell)

Reponse

)

 

;;;---------------------------------------------------------------

;;;

;;; Choix du répertoire

;;;

;;;---------------------------------------------------------------

 

(defun dirbox(txt / cdl rep)

(if (setq cdl (vlax-create-object "Shell.Application"))

(progn

(and (setq rep (vlax-invoke cdl 'browseforfolder 0 txt 512 ""))

(setq rep (vlax-get-property (vlax-get-property rep 'self) 'path))

)

(vlax-release-object cdl)

)

)

rep

)

 

;;;---------------------------------------------------------------

;;;

;;; Ouvrir un dessin via ObjectDbx

;;;

;;;---------------------------------------------------------------

 

(defun ouvrir_dessin_dbx(dwg / dbx)

(if (< (atoi (substr (getvar "ACADVER") 1 2)) 16)

(setq dbx (vlax-create-object "ObjectDBX.AxDbDocument"))

(setq dbx (vlax-create-object (strcat "ObjectDBX.AxDbDocument." (substr (getvar "ACADVER") 1 2))))

)

(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-open (list dbx dwg)))

(progn

(vlax-release-object dbx)

nil

)

dbx

)

)

 

;;;---------------------------------------------------------------

;;;

;;; Rechercher les attributs d'un bloc

;;;

;;;---------------------------------------------------------------

 

(defun rech_at(nom / at bl tb)

(setq bl (vla-item (vla-get-blocks doc) nom))

(vlax-for at bl

(and (eq (vla-get-objectname at) "AcDbAttributeDefinition")

(if (eq (vla-get-constant at) :vlax-true)

(setq tb (cons (list (vla-get-tagstring at)) tb))

(setq tb (cons

(cons (vla-get-tagstring at)

(if (eq (vla-get-promptstring at) "")

(vla-get-tagstring at)

(vla-get-promptstring at)

)

)

tb

)

)

)

)

)

(reverse tb)

)

 

;;;---------------------------------------------------------------

;;;

;;; Afficher les attributs d'un bloc

;;;

;;;---------------------------------------------------------------

 

(defun affiche(/ val)

(if (setq liste_at (rech_at (nth (atoi posbl) liste_bl)))

(progn

(foreach val (list "txtat" "listeat" "txtva" "valeur" "accept" "sel" "nou" "pre" "suf")

(mode_tile val 0)

)

(start_list "listeat")

(mapcar '(lambda (x) (if (cdr x)

(add_list (cdr x))

(add_list (strcat "Constant-->" (car x)))

)

) liste_at)

(end_list)

(affiche_va)

)

(foreach val (list "listeat" "txtva" "valeur" "accept" "sel" "nou" "pre" "suf")

(mode_tile val 1)

)

)

(set_tile "sel" sel)

(set_tile "valeur" val_at)

(affiche_rep rep)

)

 

;;;---------------------------------------------------------------

;;;

;;; Affiche le Répertoire

;;;

;;;---------------------------------------------------------------

 

(defun affiche_rep(txt / sel)

(if (> (strlen txt) 46)

(setq txt (strcat (substr txt 1 3) "...." (substr txt (- (strlen txt) 45))))

)

(set_tile "txt" (strcat "Actuel : " txt))

)

 

;;;---------------------------------------------------------------

;;;

;;; Griser si attribut constant

;;;

;;;---------------------------------------------------------------

 

(defun affiche_va()

(mode_tile "valeur" 0)

(mode_tile "accept" 0)

(or (cdr (nth (atoi posat) liste_at))

(progn

(mode_tile "valeur" 1)

(mode_tile "accept" 1)

)

)

)

 

;;;---------------------------------------------------------------

;;;

;;; Modifier le texte de l'attribut

;;;

;;;---------------------------------------------------------------

 

(defun modif_at(ent / lst att)

(and (eq nom_bloc

(if (vlax-property-available-p ent 'effectivename)

(vla-get-effectivename ent)

(vla-get-name ent)

)

)

(not (eq (cdr (nth (atoi posat) liste_at)) ""))

(progn

(setq lst (vlax-invoke ent 'getattributes)

att (nth (atoi posat) lst)

modif T

)

(cond

((eq choix "nou")

(vla-put-textstring att val_at)

)

((eq choix "pre")

(vla-put-textstring att (strcat val_at (vla-get-textstring att)))

)

(T

(vla-put-textstring att (strcat (vla-get-textstring att) val_at))

)

)

)

)

)

 

;;;---------------------------------------------------------------

;;;

;;; Sélection d'un bloc pour récuperer son nom

;;;

;;;---------------------------------------------------------------

 

(defun rech_bl(/ lst nom sel)

(defun nom(val)

(setq val (vlax-ename->vla-object val))

(if (vlax-property-available-p val 'effectivename)

(vla-get-effectivename val)

(vla-get-name val)

)

)

 

(and (setq sel (entsel "\nVeuillez sélectionner un bloc : "))

(eq (cdr (assoc 0 (entget (car sel)))) "INSERT")

(setq lst (member (nom (car sel)) liste_bl))

(setq posbl (itoa (- (length liste_bl) (length lst))))

)

)

 

;;;---------------------------------------------------------------

;;;

;;; Sélection d'un attribut pour récuperer son étiquette et le nom du bloc

;;;

;;;---------------------------------------------------------------

 

(defun rech_blat(/ att bl lst sel)

(and (setq sel (nentsel "\nVeuillez sélectionner un attribut : "))

(eq (vla-get-objectname (setq att (vlax-ename->vla-object (car sel)))) "AcDbAttribute")

(not (vl-catch-all-error-p (setq bl (vl-catch-all-apply 'vla-objectidtoobject (list (vla-get-database att) (vla-get-ownerid att))))))

(setq lst (member

(if (vlax-property-available-p bl 'effectivename)

(vla-get-effectivename bl)

(vla-get-name bl)

)

liste_bl

)

)

(setq posbl (itoa (- (length liste_bl) (length lst))) posat "0")

(setq liste_att (rech_at (vla-get-name bl)))

(setq lst (mapcar 'vla-get-objectid (vlax-invoke bl 'getattributes)))

(setq posat (itoa (- (length lst) (length (member (vla-get-objectid att) lst)))))

)

)

 

;;;---------------------------------------------------------------

;;;

;;; Rechercher les blocs dans le document référencé

;;;

;;;---------------------------------------------------------------

 

(defun rechercher_blocs(env / ava bl ent express lay lok tot)

(if (member "acetutil.arx" (arx))

(setq express T ava 0 tot 0)

)

(vlax-for lay (vla-get-layers env)

(and (eq (vla-get-lock lay) :vlax-true)

(setq lok (cons lay lok))

(vla-put-lock lay :vlax-false)

)

)

(vlax-for lay (vla-get-layouts env)

(and express

(setq tot (+ tot (vla-get-count (vla-get-block lay))))

)

)

(and express

(acet-ui-progress-init "" tot)

)

(vlax-for lay (vla-get-layouts env)

(vlax-for ent (vla-get-block lay)

(and express

(setq ava (1+ ava))

(acet-ui-progress-safe ava)

)

(and (eq (vla-get-objectname ent) "AcDbBlockReference")

(modif_at ent)

)

)

)

(foreach lay lok

(vla-put-lock lay :vlax-true)

)

(and express

(acet-ui-progress-done)

)

)

 

;;;---------------------------------------------------------------

;;;

;;; Routine principale.

;;;

;;;---------------------------------------------------------------

 

(vl-load-com)

(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))

(setq Old_Error *error* *error* *errmat* doc (vla-get-activedocument (vlax-get-acad-object)))

(if (setq dcl_id (findfile "Pat.dcl"))

(progn

(vlax-for bl (vla-get-blocks doc)

(or (wcmatch (vla-get-name bl) "`**,*|*")

(eq (vla-get-isxref bl) :vlax-true)

(setq liste_bl (cons (vla-get-name bl) liste_bl))

)

)

(if liste_bl

(progn

(setq dcl_id (load_dialog dcl_id)

liste_bl (acad_strlsort liste_bl)

val_at ""

posbl "0"

posat "0"

sel "1"

choix "nou"

rep (substr (getvar "dwgprefix") 1 (1- (strlen (getvar "dwgprefix"))))

old rep

)

(while (and (/= resultat 0)

(/= resultat 1)

)

(new_dialog "pat" dcl_id)

(set_tile "titre" "PAT V1.01")

(set_tile choix "1")

(affiche)

(mode_tile "cancel" 2)

(start_list "listebl")

(mapcar 'add_list liste_bl)

(end_list)

(set_tile "listebl" posbl)

(and liste_att

(set_tile "listeat" posat)

)

(action_tile "listebl" "(setq posbl $value)(affiche)")

(action_tile "chbl" "(done_dialog 2)")

(action_tile "listeat" "(setq posat $value)(affiche_va)")

(action_tile "chat" "(done_dialog 3)")

(action_tile "valeur" "(setq val_at $value)")

(action_tile "sel" "(setq sel $value)")

(action_tile "rep" "(done_dialog 4)")

(action_tile "nou" "(setq choix \"nou\")")

(action_tile "pre" "(setq choix \"pre\")")

(action_tile "suf" "(setq choix \"suf\")")

(action_tile "cancel" "(done_dialog 0)")

(action_tile "accept" "(done_dialog 1)")

(setq resultat (start_dialog))

(cond

((eq resultat 1)

(setq nom_bloc (nth (atoi posbl) liste_bl))

(if liste_at

(progn

(and (eq sel "1")

(progn

(princ (strcat "\n Travail sur " (getvar "dwgname") " (dessin courant)"))(princ)

(rechercher_blocs doc)

(princ " ...OK")(princ)

)

)

(if (setq lst (vl-directory-files rep "*.dwg" 1))

(progn

(and (eq (strcase rep) (strcase (substr (getvar "dwgprefix") 1 (1- (strlen (getvar "dwgprefix"))))))

(setq lst (vl-remove (getvar "dwgname") lst))

)

(foreach fic lst

(setq sav nil modif nil)

(if (and (not (vl-catch-all-error-p (setq lay (vl-catch-all-apply 'vla-item (list (vla-get-documents (vlax-get-acad-object)) fic)))))

(eq (vla-get-path lay) rep)

)

(setq doc lay)

(setq doc (ouvrir_dessin_dbx (strcat rep "/" fic))

sav T

)

)

(if doc

(progn

(princ (strcat "\n Travail sur " fic))(princ)

(rechercher_blocs doc)

(if modif

(if sav

(progn

(princ " ...sauvegarde")(princ)

(vla-saveas doc (strcat rep "/" fic))

(princ " ...OK")

)

(princ " ...déjà chargé, REGEN nécessaire si vous l'activez pour voir les modifications.")

)

(princ " ...n'a pas été modifié.")

)

(princ)

(vlax-release-object doc)

)

)

)

)

(msgbox "PAT" 64 (strcat "Pas de dessin dans " rep))

)

)

(msgbox "PAT" 48 "Bloc sans attribut")

)

)

((eq resultat 2)

(rech_bl)

)

((eq resultat 3)

(rech_blat)

)

((eq resultat 4)

(if (setq rep (dirbox "Choisissez un répertoire pour traiter tous les dessins et changer la valeur de l'attribut sélectionné."))

(setq old rep)

(setq rep old)

)

)

)

)

(unload_dialog dcl_id)

)

(msgbox "PAT" 48 "Pas de bloc dans le dessin")

)

)

(msgbox "PAT" 16 "Le fichier PAT.DCL est introuvable.")

)

(setq *error* Old_Error)

(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))

(princ)

)

 

(setq nom_lisp "PAT")

(if (/= app nil)

(if (= (strcase (substr app (1+ (- (strlen app) (strlen nom_lisp))) (strlen nom_lisp))) nom_lisp)

(princ (strcat "..." nom_lisp " chargé."))

(princ (strcat "\n" nom_lisp ".LSP Chargé.....Tapez " nom_lisp " pour l'éxecuter.")))

(princ (strcat "\n" nom_lisp ".LSP Chargé......Tapez " nom_lisp " pour l'éxecuter.")))

(setq nom_lisp nil)

(princ)

[La Lozère]

Merci (Gile), merci JPEG.

Je viens de tester avec l'expression lisp de (gile), c'est parfait.

J'ai plus qu'à lancer SuperAutoScript et aller boire un café.

 

JPEG, je garde ce lisp de Patrick_35 sous le coude au cas ou.

 

Merci encore.

[La Lozère]

Bonjour (gile),

Dans le même genre d'idée, je cherche à changer la couleur du texte d'un attribut pour la passer en noir?

 

Et là, je ne vois pas...

[La Lozère]

Bon, avec la commande DEFDUCALQUE je dois m'en sortir.

Merci quand même.