Choix de copie d\'attributs

[lesourd2]

Salut

 

Serait-il possible de choisir certains attributs à copier d'un bloc.En effet avec le LISP de Patrick_35 (CAT)lorsqu 'on copie les attributs d'un bloc on les copie tous.

 

@+

[(gile)]

Salut,

 

Nouvelle version : interface améliorée

 

;; CATT (gile) 08/02/2008
;; Copie la valeur des attributs sélectionnés dans les attributs correspondants
;; d'une sélection de blocs.
;;
;; Les attributs peuvent être sélectionnés dans différentes références du même bloc.
;; Si différentes valeurs pour un même attribut sont sélectionnées,
;; seule la dernière est prise en compte.

(defun c:catt (/ att alst atts str dxf2 ss n bloc sub)
 (setq n 0)
 (while (setq att (car (nentsel "\nSélectionnez un attribut ou : ")))
   (if	(= (cdr (assoc 0 (setq alst (entget att)))) "ATTRIB")
     (progn
(redraw att 3)
(if (setq sub (member (assoc 2 alst) atts))
  (progn
    (redraw (cdr (caddr sub)) 4)
    (setq str "1 sélectionné (1 dupliqué), ")
  )
  (progn
    (setq n (1+ n))
    (setq str "1 sélectionné, ")
  )
)
(setq atts (cons (assoc 2 alst)
		 (cons (assoc 1 alst) (cons (assoc -1 alst) atts))
	   )
)
     )
     (setq str "Ce n'est pas un attribut, ")
   )
   (princ (strcat str (itoa n) " au total"))
   (or	dxf2
(setq dxf2 (assoc 2 (entget (cdr (assoc 330 (entget att))))))
   )
 )
 (setq n -1)
 (princ "\nSélectionnez les blocs.")
 (if (setq ss (ssget (list '(0 . "INSERT") dxf2)))
   (progn
     (command "_regen")
     (while (setq bloc (ssname ss (setq n (1+ n))))
(setq att (entnext bloc))
(while (= (cdr (assoc 0 (setq alst (entget att)))) "ATTRIB")
  (if (setq sub (member (assoc 2 alst) atts))
    (entmod (subst (cadr sub) (assoc 1 alst) alst))
  )
  (setq att (entnext att))
)
(entupd bloc)
     )
   )
 )
 (princ (strcat "\n" (itoa n) " blocs traités."))
 (princ)
) 

 

[Edité le 9/2/2008 par (gile)]

[lesourd2]

Salut gile

 

Je viens de tester : pas de possibilité de copie d'attribut !?

ça ne fonctionne pas.

 

@+

[(gile)]

Je viens de faire quelques tests, chez moi ça fonctionne :

 

L'utilisateur sélectionne les attributs à copier un par un et fait Entrer, Espace ou clic droit pour valider la sélection. Puis il sélectionne les blocs dans lesquels il veut copier les valeurs des attributs.

 

J'ai ajouté quelques retours des entrées.

 

Sélectionnez un attribut ou : 1 attribut(s) sélectionné(s).

Sélectionnez un attribut ou : 2 attribut(s) sélectionné(s).

Sélectionnez un attribut ou :

 

Sélectionnez les blocs.

Choix des objets: Spécifiez le coin opposé: 4 trouvé(s)

 

Choix des objets:

 

4 blocs traités.

[lesourd2]

Salut gile

 

OK

Evidemment ça marche nickel.

Désolé que tu perdes ton temps avec moi.

 

En tous cas merci

 

@+

 

[Edité le 8/2/2008 par lesourd2]

[(gile)]

J'ai apporté quelques améliorations à la routine.

 

Les attributs peuvent être sélectionnés dans différentes références du même bloc.

Si différentes valeurs pour même attribut sont sélectionnées (dupliqué), seule la dernière est prise en compte.

Des retours sur la ligne de commande et la mise en surbrillance des attributs indiquent l'état de la sélection d'attributs.

 

Commande: CATT

Sélectionnez un attribut ou : 1 sélectionné, 1 au total

Sélectionnez un attribut ou : Ce n'est pas un attribut, 1 au total

Sélectionnez un attribut ou : 1 sélectionné, 2 au total

Sélectionnez un attribut ou : 1 sélectionné (1 dupliqué), 2 au total

Sélectionnez un attribut ou :

Sélectionnez les blocs.

Choix des objets: Spécifiez le coin opposé: 4 trouvé(s)

Choix des objets:

4 blocs traités.

 

[Edité le 9/2/2008 par (gile)]

[Patrick_35]

Salut

 

Content que tu ais trouvé ton bonheur

C'est juste pour indiquer qu'il y a aussi le lisp MAT

 

@+

[lesourd2]

Salut

 

Content que tu ais trouvé ton bonheur

C'est juste pour indiquer qu'il y a aussi le lisp MAT

 

Oui effectivement; tres interressant aussi.Mon bonheur se retrouve donc ainsi doublé.

 

Merci à vous deux.

 

[PHILPHIL]

CATT.TXTsalut

 

copie les attributs selectionnés ou tous du bloc selecttionné

 

bon je n'avais pas vu que gile avait fait une mise a jour depuis

 

bon week end du ( 11/11/11 ) attention au bug de 11h11 ;)

 

phil

 

 

;;; Copier des attributs
;;;
;;; Copyright (C) (gile)

(defun c:catt (/ source attlst ss attrib tag attliste)
 (if (and (setq source (car (entsel "\nSélectionnez le bloc source: ")))
          (setq source (vlax-ename->vla-object source))
          (= (vla-get-objectname source) "AcDbBlockReference")
          (= (vla-get-hasattributes source) :vlax-true)
          (progn (initget "S s T")
                 (setq ans (getkword "\nVOULEZ VOUS SELECTIONNER LES ATRIBUTS OU TOUS LES RECUPERER ? (S/T):"))
                 (if (or (= ans "s") (= ans "S"))
                   (progn
                     (while (and (setq att (car (nentsel "\nSélectionnez un attribut à modifier < Terminer >: ")))
                                 (= (cdr (assoc 0 (entget att))) "ATTRIB")
                            )
                       (redraw att 3)
                           (setq attliste (cons att attliste)
                             tag      (remove_doubles (cons (cdr (assoc 2 (entget att))) tag))
                             ref      (cdr (assoc 330 (entget att)))
                             fltr     (remove_doubles (cons (assoc 2 (entget ref)) fltr))
                       )
                       (princ (strcat "\n" (itoa (length tag)) " attribut(s) sélectionné(s)."))
                     )
                   )
                   (progn (foreach att (vlax-invoke source 'getattributes)
                            (setq attlst (cons (cons (vla-get-tagstring att) (vla-get-textstring att)) attlst))
                          )
                   )
                 )
          )
     )
   (progn (foreach att (vlax-invoke source 'getattributes)
            (foreach atttag tag
              (if (= (vla-get-tagstring att) atttag)
                (setq attlst (cons (cons (vla-get-tagstring att) (vla-get-textstring att)) attlst))
              )
            )
          )
          (if (ssget '((0 . "INSERT") (66 . 1)))
            (progn (vlax-for blk (setq ss (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
                     (foreach att (vlax-invoke blk 'getattributes)
                       (if (setq attrib (assoc (vla-get-tagstring att) attlst))
                         (vla-put-textstring att (cdr attrib))
                       )
                     )
                   )
                   (vla-delete ss)
            )
          )
   )
   (princ "\nEntité non valide")
 )
 (foreach elfltr attliste (redraw elfltr 4))
 (princ)
)