Changer attribut

[azrael]

Bonjour,

J'avais depuis plus de 20 ans un fichier lsp qui permettait de remplir l'attribut d'un bloc via un script suivant

 

Non du bloc

Non du Tag

Valeur du tag

 

En pratique, voici le script:

(load "u:/hv/changeattribut")

chattribut (la commande lsp)

carta3_b (le bloc)

Nom (le tag)

15001-JOL-H-101 (la valeur)

chattribut(la commande lsp)

carta3_b(le bloc)

date(le tag)

07/07/2016(la valeur)

...

Si quelqu'un a déjà ce programme ou une idée pour le réaliser et le partager, j'en serais ravi.

[azrael]

Sans pourvoir retrouver mon malheureux cours de lisp oublié depuis plus de 20 ans, j'ai écris ceci

SS0 = nom du bloc

SS2 = le tag

SS3 = la réponse à inscrire

 

(defun c:mod ( / ss0 ss2 ss3)
  	(setq ss1 (ssget "x" (list (cons 0 "insert") (cons 2 ss0))))
(setq ct 0)
(repeat (sslength ss1) (sub1)
(princ)
)
(defun sub1 ()
(setq en (ssname ssl ct))
(setq test T)
	(while test
		(setq en (entnext en))
		(setq ent (entget en))
			(if (=(cdr (assoc 0 ent)) "ATTRIB")
				(progn
					(if (= (cdr (assoc 2 ent)) ss2)
						(progn
							(setq att (cdr (assoc 1 ent)))
							(setq ent (subst (cons 1 ss3) (assoc 1 ent) ent))
							(entmod ent) 'modification de l'entité
							(entupd en)
						)
					)
					(princ)
				)
			(setq test nil)
			)
		)
(setq ct (1+ ct))
)
)

 

Evidemment, cela bug :blink::) je continue à chercher ...

[Patrick_35]

Salut

 

Je pense que tu peux t'inspirer de ce sujet

 

@+

[(gile)]

Salut,

 

Si tu cibles des version d'AutoCAD antérieures à 2012 (ou si tu préfères passer par les listes DXF), tu peux utiliser ces fonctions à la place de getpropertyvalue et setpropertyvalue.

 

;; GetAttValue
;; Retourne la valeur de l'attribut ou nil s'il n'est pas trouvé.
;;
;; Arguments
;; blk: référence de bloc (ENAME)
;; tag: étiquette de l'attribut (STR)
(defun GetAttValue (blk tag / elst val)
 (setq tag  (strcase tag)
       elst (entget (entnext blk))
 )
 (while (and (not val) (= (cdr (assoc 0 elst)) "ATTRIB"))
   (if (= (cdr (assoc 2 elst)) tag)
     (setq val (cdr (assoc 1 elst)))
     (setq elst (entget (entnext (cdr (assoc -1 elst)))))
   )
 )
 val
)

;; SetAttValue
;; Assigne la valeur de l'attribut.
;; Retourne la valeur ou nil si l'attribut n'est pas trouvé
;;
;; Arguments
;; blk: référence de bloc (ENAME)
;; tag: étiquette de l'attribut (STR)
;; val: nouvelle valeur de l'attribut (STR)
(defun SetAttValue (blk tag val / elst done)
 (setq tag  (strcase tag)
       elst (entget (entnext blk))
 )
 (while (and (not done) (= (cdr (assoc 0 elst)) "ATTRIB"))
   (if (= (cdr (assoc 2 elst)) tag)
     (entmod (subst (cons 1 (setq done val)) (assoc 1 elst) elst))
     (setq elst (entget (entnext (cdr (assoc -1 elst)))))
   )
 )
 done
)

[azrael]

Bonjour Gile et merci pour ton aide,

J'ai essayé la commande SetAttValue

Malheureusement, le script ne fonctionne pas. j'ai ajouté c:SetAttValue au lisp

J'ai créé le fichier texte de 4 lignes suivant:

 

SetAttValue

Nom du bloc

nom du tag

valeur

 

Normalement, cela doit fonctionné ou je déraille ? I

A la maison, cela bug :(

 

PS: merci aussi à Patrick

[Patrick_35]

Salut

 

La routine de (gile) s'utilise comme ceci

(SetAttValue (car (entsel)) "TAG" "Valeur")

 

(car (entsel)) --> Choix d'un bloc

"TAG" --> Nom de l'étiquette

"Valeur" --> Valeur à écrire

 

@+

[(gile)]

Non, ça ne devrait pas fonctionner.

De plus, il semble que tu mélanges LISP et script

 

SetAttValue et GetAttValue sont des fonction LISP à utiliser à la place de setpropertyvalue et getpropertyvalue (lis bien les commentaires).

 

Pour pouvoir faire ce que tu demandes dans le premier message, il faut définir une commande LISP qui invite l'utilisateur à spécifier successivement le nom du bloc, l'étiquette de l'attribut et sa valeur, puis qui sélectionne tous le blocs ayant ce nom pour changer la valeur de l'attribut.

 

avec setpropertyvalue

(defun c:ChangeAttribut (/ nom tag val sel i bloc)
 (if
   (and
     (setq nom (getstring "\nNom du bloc: "))
     (setq tag (getstring "\nEtiquette de l'attribut: "))
     (setq val (getstring T "\nValeur de l'attribut: "))
     (setq sel (ssget "_X" (list (cons 0 "INSERT") (cons 2 nom))))
   )
    (repeat (setq i (sslength sel))
      (setq bloc (ssname sel (setq i (1- i))))
      (setpropertyvalue bloc (strcase tag) val)
    )
 )
 (princ)
)

 

avec SetAttValue (la routine doit être chargée dans le dessin.

 

(defun c:ChangeAttribut (/ nom tag val sel i bloc)
 (if
   (and
     (setq nom (getstring "\nNom du bloc: "))
     (setq tag (getstring "\nEtiquette de l'attribut: "))
     (setq val (getstring T "\nValeur de l'attribut: "))
     (setq sel (ssget "_X" (list (cons 0 "INSERT") (cons 2 nom))))
   )
    (repeat (setq i (sslength sel))
      (setq bloc (ssname sel (setq i (1- i))))
      (SetAttValue bloc (strcase tag) val)
    )
 )
 (princ)
)

 

Une fois le LISP chargé dans le dessin, tu peux faire un script du style:

ChangeAttribut
Nom du bloc
nom du tag
valeur

[lecrabe]

Hello Gilles

 

Comme d'habitude: Superbe !

 

Merci, Bye, lecrabe

[azrael]

Merci Gilles, cela fonctionne. Le but est de gérer des scripts à partir de fichier Access avec des variables par plan

Ex simple:

(load "u:/hv/VARIABLE_1.1")

ChangeAttribut

Bloc_cartouche

NAME

VARIABLE_1.2

Qsave

(load "u:/hv/VARIABLE_2.1")

ChangeAttribut

Bloc_cartouche

NAME

VARIABLE_2.2

Qsave

 

Merci beaucoup Gille pour ton aide.

Merci aussi à ce site qui existe depuis tellement d'années :)

Maxime

[sada20]

Bonjour,

La commande ne fonctionne pas pour moi.

je charge bien

le lisp 'changeAttribut"

(defun c:ChangeAttribut (/ nom tag val sel i bloc)

(if

(and

(setq nom (getstring "\nNom du bloc: "))

(setq tag (getstring "\nEtiquette de l'attribut: "))

(setq val (getstring T "\nValeur de l'attribut: "))

(setq sel (ssget "_X" (list (cons 0 "INSERT") (cons 2 nom))))

)

(repeat (setq i (sslength sel))

(setq bloc (ssname sel (setq i (1- i))))

(setpropertyvalue bloc (strcase tag) val)

)

)

(princ)

)

 

Puis lance la commande

Changeattribut

 

selectionne le nom du bloc "CARTOUCHE"

 

renseigne l'étiquette "IND"

 

 

Et inscrit la nouvelle valeur "R0"

cela ne fonctionne pas

 

et avance ça j'utilisais

 

(defun c:ch_attribut(/ ordre blocd etiquetted nouvelle ancienne filtre selection ptr nbrmod entite pripriete actuelle k a)

 (write-line "\nTéléchargé depuis le site Internet http://www.decker-cs.com")

 (write-line "Auteur : Christian Decker")

 ;

 (write-line "Changer la valeur d'un attribut.")

 ;

 (while ;Attend la sélection d'une méthode.

(and

(/= ordre "CHA")

(/= ordre "SUB")

(/= ordre "DWG")

(/= ordre "PRE")

(/= ordre "SUF")

)

(setq ordre(strcase(getstring "Méthode (CHAnger / SUBstituer / DWGname / PREfixe / SUFfixe) : ")))

(if (> (strlen ordre) 3) ;La chaîne contient au moins quatre caractères.

(setq ordre(substr ordre 1 3)) ;Préserve uniquement les trois premiers caractères de la chaîne.

)

 )

 (if

(or

(= ordre "CHA")

(= ordre "PRE")

(= ordre "DWG")

(= ordre "SUF")

(= ordre "SUB")

)

(progn

(if (= ordre "CHA") ;Saisie des données avec l'option Changer.

(progn

(setq blocd(strcase(getstring "Nom du bloc contenant l'attribut à modifier : ")))

(setq etiquetted(strcase(getstring "Etiquette de l'attribut à modifier : " 1)))

(setq nouvelle(getstring "Nouvelle valeur : " 1))

)

)

(if (= ordre "SUB") ;Saisie des données avec l'option Substituer.

(progn

(setq blocd(strcase(getstring "Nom du bloc contenant l'attribut à modifier : ")))

(setq etiquetted(strcase(getstring "Etiquette de l'attribut à modifier : " 1)))

(setq ancienne "")

(while (= ancienne "") ;Attend une occurrence de texte non nulle.

(setq ancienne(getstring "Ancienne chaîne de caractères : " 1))

(if (= ancienne "") ;La chaîne est vide.

(write-line "L'ancienne chaîne de caractères doit être non nulle.")

)

)

(setq nouvelle(getstring "Nouvelle chaîne de caractères : " 1))

)

)

(if (= ordre "DWG") ;Saisie des données avec l'option Dwgname.

(progn

(setq blocd(strcase(getstring "Nom du bloc contenant l'attribut à modifier : ")))

(setq etiquetted(strcase(getstring "Etiquette de l'attribut à modifier : " 1)))

)

)

(if (= ordre "PRE") ;Saisie des données avec l'option Préfixe.

(progn

(setq blocd(strcase(getstring "Nom du bloc contenant l'attribut à modifier : ")))

(setq etiquetted(strcase(getstring "Etiquette de l'attribut à modifier : " 1)))

(setq nouvelle(getstring "Préfixe : " 1))

)

)

(if (= ordre "SUF") ;Saisie des données avec l'option Suffixe.

(progn

(setq blocd(strcase(getstring "Nom du bloc contenant l'attribut à modifier : ")))

(setq etiquetted(strcase(getstring "Etiquette de l'attribut à modifier : " 1)))

(setq nouvelle(getstring "Suffixe : " 1))

)

)

(if (/= (tblsearch "BLOCK" blocd) nil)  ;La définition du bloc recherché existe dans le dessin.

(progn

(setq filtre(list (cons '0 "INSERT") (cons '2 blocd)))

(setq selection(ssget "X" filtre)) ;Crée un jeu de sélection.

(if (/= selection nil) ;Au moins un bloc trouvé dans le dessin.

(progn

(setq ptr 0)

(setq nbrmod 0)

(while (< ptr (sslength selection)) ;Pour chaque bloc dans le jeu de sélection...

(setq entite(entnext(ssname selection ptr)))  ;Extraction du bloc.

(while (and (/= entite nil) (/= (cdr(assoc '0 (entget entite))) "SEQEND")) ;Pour chaque attribut du bloc...

(setq propriete(entget entite))   ;Extraction des propriétés de l'attribut.

(if (= (cdr(assoc '2 propriete)) etiquetted) ;L'attribut doit être modifié.

(progn

(if (= ordre "CHA") ;Option Changer.

(progn

(setq propriete(subst(cons '1 nouvelle) (assoc '1 propriete) propriete))

(entmod propriete)

(entupd entite)

(setq nbrmod(+ nbrmod 1))

)

)

(if (= ordre "SUB") ;Option Substituer.

(progn

(setq actuelle(cdr(assoc '1 propriete))) ;Extrait la valeur de l'attribut.

(setq k 1) ;Positionne le pointeur sur le 1er caractère de la valeur de l'attribut.

(setq a 0) ;Sera égal à 1 si l'attribut est modifié.

(while (and (<= k (strlen actuelle)) (>= (- (strlen actuelle) (- k 1)) (strlen ancienne)))

;

;Tant que k est inférieure ou égale à la longueur de la chaîne actuelle, et tant que

;(la longueur de la chaîne actuelle - (la position du pointeur - 1)) est égale ou

;supérieure à la longueur de l'occurrence du texte à rechercher.

;

(if (= (substr actuelle k (strlen ancienne)) ancienne)

(progn

;

;Le pointeur est sur le 1er caractère de l'occurrence du texte recherché.

;

;Remplace l'occurrence de texte par la nouvelle valeur :

;1) Récupère les caractères situés en amont du pointeur.

;2) Ajoute la nouvelle valeur.

;3) Récupère les caractères situés en aval de l'occurrence de texte.

;

(setq actuelle

(strcat

(substr actuelle 1 (- k 1))

nouvelle

(substr actuelle (+ k (strlen ancienne)) (- (strlen actuelle) (+ (- k 1) (strlen ancienne))))

)

)

;Ajuste la position du pointeur sur le dernier caractère de la nouvelle valeur insérée.

(setq k(+ (- k 1) (strlen nouvelle)))

(setq a 1) ;La valeur de l'attribut est modifiée.

)

)

(setq k(+ k 1)) ;Incrémente l'index du pointeur.

)

(if (= a 1)

(progn

(setq propriete(subst(cons '1 actuelle) (assoc '1 propriete) propriete))

(entmod propriete)

(entupd entite)

(setq nbrmod(+ nbrmod 1))

)

)

)

)

       (if (= ordre "DWG") ;Option Dwgname.

(progn

(setq propriete(subst(cons '1 (getvar "DWGNAME")) (assoc '1 propriete) propriete))

(entmod propriete)

(entupd entite)

(setq nbrmod(+ nbrmod 1))

)

)

(if (= ordre "PRE") ;Option Préfixe.

(progn

(setq propriete(subst(cons '1 (strcat nouvelle (cdr(assoc '1 propriete)))) (assoc '1 propriete) propriete))

(entmod propriete)

(entupd entite)

  (setq nbrmod(+ nbrmod 1))

)

)

(if (= ordre "SUF") ;Option Suffixe.

(progn

(setq propriete(subst(cons '1 (strcat (cdr(assoc '1 propriete)) nouvelle)) (assoc '1 propriete) propriete))

(entmod propriete)

(entupd entite)

(setq nbrmod(+ nbrmod 1))

)

)

)

)

(setq entite(entnext entite)) ;Sélectionne l'attribut suivant du bloc.

)

(setq ptr(+ ptr 1)) ;Incrémente l'index du jeu de sélection des blocs.

)

(write-line (strcat "Nombre de blocs trouvés : " (itoa (sslength selection))))

(write-line (strcat "Nombre d'attributs modifiés : " (itoa nbrmod)))

(princ)

)

)

)

)

)

 )

)

 

mais depuis ce matin cela ne fonctionne plus du tout

 

à la fin j'ai "nil" qui s'affiche

je ne comprends plus.

Pourriez vous m'aider s'il vous plait.

[azrael]

Désolé mais je ne peux rien faire pour t'aider ! :(