Copier Attribut(s) de Bloc1 vers Bloc2

[lecrabe]

Bonjour

 

SVP je recherche une routine Lisp/VLisp pour automatiser un transfert/copie du contenu de N attr du Bloc 1 vers le Bloc 2 (memes nom d'attributs) avec les Blocs 2 inseres au meme point que le Bloc 1

 

La routine CAT de Patrick_35 m'oblige a travailler 1 Bloc par 1 Bloc donc c LONG !

 

Voila comment je vois le truc ...

 

Dans la routine "COPY_ATTR_BL1_BL2" on pose d'abord 2 questions :

 

Nom du Bloc Source ? - par exemple: DEPART

Nom du Bloc Destination ? - par exemple: ARRIVEE

 

Puis Nom(s) du/des attributs a traiter - par exemple: NUMERO , ALTITUDE , DATE , etc

Sous entendu, on a les memes attributs sur les 2 Blocs !

 

SVP verifier que les N attributs fournis existe dans le Bloc Source !

Sinon STOP !!

 

Question sur le rayon de recherche (Fuzz parametre) ? - Defaut = 0.1

Si jamais les Blocs ne sont pas tout a fait inseres sur le meme point XY

 

NOTE: on ne teste pas le Z !

Ce qui permettra de transferer depuis un Bloc Z=0 vers un Bloc Z=xxxx.yy

 

Ensuite une selection AutoCAD classique pour traiter TOUT ou une partie du DWG ...

 

... Execution ...

 

ATTENTION: il peut y avoir d'autres attributs dans le Bloc Destination !

SVP on ne touche pas SURTOUT PAS aux attributs qui ne correspondent pas !!

 

Si possible SVP traiter le fait que l'on n'a pas forcement TOUS les memes attributs sur le Bloc Destination !

par exemple N Attributs fournis par l'operateur pour le Bloc Source

MAIS dans certains Blocs Destination :

- on a N attributs dont 1/2/3/N qui correspondent !!

- si ZERO attribut qui corresponde on continue

 

Si possible, 1 compteur en sortie sur le nombre de Blocs Destination reellement traites

et 1 compteur sur le nombre de Blocs Source ...

Ainsi on detectera le cas "- si ZERO attribut qui corresponde on continue" ...

 

Merci d'avance, Bye, lecrabe

[Patrick_35]

Salut

 

Tu sélectionnes tous tes blocs, et ensuite, dans les propriétés (ctrl+1), tu fais ce que tu veux avec les attributs.

 

ps : Cat est en v2.01

 

@+

[lecrabe]

Hello Patrick

 

Desole mais je ne te suis pas du tout ! ... MAIS je me suis peut etre mal exprime !?

 

Sur un dessin j'ai par exemple 100 Blocs B1 avec les Attributs:

NUMERO , ALT , DATE , FOURNISSEUR , INFOS

 

J'ai aussi (en principe) aux memes Coords XY (on se fout du Z) 100/99/98/N Blocs B2 avec les attributs:

NUMERO , ALT , DIV1 , DIV2

 

Je ne vois pas du tout comment je peux transferer le contenu des attributs NUMERO et ALT

avec une selection soit de TOUS les Blocs B1 (ou une partie seulement: zone Nord du DWG par exemple)

vers les Blocs B2 (en principe) aux memes Coords XY

 

Bien entendu on ne touche surtout pas aux attributs non concernes !!

 

Bye, lecrabe

[Patrick_35]

Tu sélectionnes tous les blocs que tu veux modifier (et pas forcément avec le même nom).

 

Selon ton exemple, NUMERO est en 1ère position et ALT en 2em

Dans la palette des propriétés, dans la section Attributs, tu modifies à la mano le 1er et 2em.

 

C'est déjà une 1ère approche.

 

@+

[lecrabe]

Hello

 

OUI c une 1ere approche comme tu dis ! ... CAT est aussi une 1ere approche !

 

Par contre j'ai vu que l'ordre des attributs pouvait poser un GRAVE probleme aux differentes routines Lisp/VLisp trouvees (qui ne correspondent pas a mon besoin MAIS me permettent eventuellement de traiter UN par UN)

 

Pourquoi ??

 

Car je peux avoir B1 avec les Attributs dans cet ordre :

ALPHA , NUMERO , ALT , DATE , FOURNISSEUR , INFOS

 

Et B2 avec les attributs dans cet ordre :

WHISKEY , ALT , YANKEE , ZOULOU , DELTA , NUMERO , DIV1 , DATE , DIV2

 

Dans CET exemple, je ne veux transferer QUE : NUMERO et ALT

 

Merci, Bye, lecrabe

[Olivier Eckmann]

Bonjour,

 

A partir du moment où 2 blocs n'ont pas le même nom, même s'ils ont exactement les mêmes attributs, dans la palette de propriété, si je les sélectionne tous les 2, je n'ai plus accès aux attributs. Je m'arrête à la section "Divers". Cela vient peut-être du fait que j'utilise AutoCAD MAP 3D et pas AutoCAD seul.

 

Olivier

[Olivier Eckmann]

Salut,

 

essaie avec ça, j'ai "piqué" un peu de code chez nos cadors (Gilles et LeeMac)

(vl-load-com)

;; str2lst (gile)
;; Transforme un chaine avec séparateur en liste de chaines
;;
;; Arguments
;; str : la chaine à transformer en liste
;; sep : le séparateur
;;
;; Exemples
;; (str2lst "a b c" " ") -> ("a" "b" "c")
;; (str2lst "1,2,3" ",") -> ("1" "2" "3")
;; (mapcar 'read (str2lst "1,2,3" ",")) -> (1 2 3)

(defun str2lst (str sep / pos)
 (if (setq pos (vl-string-search sep str))
   (cons (substr str 1 pos)
         (str2lst (substr str (+ (strlen sep) pos 1)) sep)
   )
   (list str)
 )
)


;; Get Attribute Value  -  Lee Mac
;; Returns the value held by the specified tag within the supplied block, if present.
;; blk - [vla] VLA Block Reference Object
;; tag - [str] Attribute TagString
;; Returns: [str] Attribute value, else nil if tag is not found.

(defun LM:vl-getattributevalue ( blk tag )
   (setq tag (strcase tag))
   (vl-some '(lambda ( att ) (if (= tag (strcase (vla-get-tagstring att))) (vla-get-textstring att))) (vlax-invoke blk 'getattributes))
)


;; Set Attribute Value  -  Lee Mac
;; Sets the value of the first attribute with the given tag found within the block, if present.
;; blk - [vla] VLA Block Reference Object
;; tag - [str] Attribute TagString
;; val - [str] Attribute Value
;; Returns: [str] Attribute value if successful, else nil.

(defun LM:vl-setattributevalue ( blk tag val )
   (setq tag (strcase tag))
   (vl-some
  	'(lambda ( att )
           (if (= tag (strcase (vla-get-tagstring att)))
               (progn (vla-put-textstring att val) val)
           )
       )
       (vlax-invoke blk 'getattributes)
   )
)

(defun Point2D (PT)
 (list (car PT) (cadr PT) 0.0)
)

(defun C:COPY_ATTR_BL1_BL2 ( / sBlNameSrc sBlNameDst sAttName lsAttName dDistMax JEU I lsSrc lsDst PT1 PT2 oBlkSrc oBlcDst)
 (if (and (setq sBlNameSrc (getstring "\nNom du bloc source : "))
      (tblsearch "BLOCK" sBlNameSrc)
      (setq sBlNameDst (getstring "\nNom du bloc destination : "))
      (tblsearch "BLOCK" sBlNameDst)
      (setq sAttName (getstring "\nNoms des attributs à recopier (séparés par des virgules si plusieurs) : "))
      (setq lsAttName (str2lst sAttName ","))
      (setq dDistMax (max 0.0 (getdist "\nDistance de recherche maxi entre bloc : ")))
      (setq JEU (ssget (list (cons 0 "INSERT") (cons 2 (strcat sBlNameSrc "," sBlNameDst)))))
     )
   (progn
     (setq I 0  lsSrc nil lsDst nil)
     (repeat (sslength JEU)
(setq oBloc (ssname JEU I))
(setq I (1+ I))
(if (= sBlNameSrc (cdr (assoc 2 (entget oBloc))))
     (setq lsSrc (append lsSrc (list (list (vlax-ename->vla-object oBloc) (Point2D (cdr (assoc 10 (entget oBloc))))))))
 	(setq lsDst (append lsDst (list (list (vlax-ename->vla-object oBloc) (Point2D (cdr (assoc 10 (entget oBloc))))))))
)  	
     )
     (foreach oBlkDst lsDst
(setq PT1 (cadr oBlkDst))
(foreach oBlkSrc lsSrc
 	(setq PT2 (cadr oBlkSrc))
 	(if (<= (distance PT1 PT2) dDistMax)
   	(foreach sAttName lsAttName
     	(if (setq sValATt (LM:vl-getattributevalue (car oBlkSrc) sAttName))
	(LM:vl-setattributevalue (car oBlkDst) sAttName sValAtt)
     	)
   	)
 	)
)
     )
   )
 )
)

 

 

Olivier

[Patrick_35]

Salut

 

Une autre manière de procéder

(defun c:dat(/ att doc ent ele lst tag toa tob)
 (setq doc (vla-get-activedocument(vlax-get-acad-object))
toa 0
tob 0
 )
 (vla-startundomark doc)
 (while (setq ent (nentsel "\nSélectionnez des attributs : "))
   (and (setq att (vlax-ename->vla-object (car ent)))
 (eq (vla-get-objectname att) "AcDbAttribute")
 (not (assoc (vla-get-tagstring att) lst))
     (setq lst (cons (list (vla-get-tagstring att) (vla-get-textstring att) att) lst))
     (redraw (vlax-vla-object->ename att) 3)
   )
 )
 (mapcar '(lambda(x)(redraw (vlax-vla-object->ename (caddr x)) 4)) lst)
 (and lst
      (ssget (list (cons 0 "insert") (cons 66 1)))
   (progn
     (vlax-for ent (setq sel (vla-get-activeselectionset doc))
(setq tag nil)
(foreach att (vlax-invoke ent 'getattributes)
  (and (setq ele (assoc (vla-get-tagstring att) lst))
       (not (equal att (caddr ele)))
    (setq toa (1+ toa)
	  tag T
    )
    (vla-put-textstring att (cadr ele))
  )
)
(and tag (setq tob (1+ tob)))
     )
     (vla-delete sel)
   )
 )
 (vla-endundomark doc)
 (princ (strcat "\nModification de " (itoa tob) " bloc(s) et de " (itoa toa) " attribut(s)."))
 (princ)
)

 

@+

[lecrabe]

Hello Patrick

 

Ta routine est OK mais ne fonctionne que pour un seul "couple" de Bloc A LA FOIS !

 

Il n'est pas question que le Bloc Source avec les attributs choisis aille ecraser les N Blocs Destination choisis !

 

POUR TOUS les Blocs Destination, il faut retrouver "au meme endroit" le Bloc Source, l'analyser, retrouver les Attributs choisis au debut, et copie les Contenus dans le Bloc Destination ...

 

En resume: La routine de Patrick ne fait pas exactement ce que je veux !

 

Mais elle s'avere interessante aussi pour un travail en manuel

depuis UN Bloc Source vers N Blocs Destination !

(en ecrasant les Attributs correspondants dans les N Blocs selectionnes)

 

DONC SVP ne pas bouger !

 

MERCI, Bye, lecrabe

[lecrabe]

Hello Olivier

 

Ca marche SUPER !

 

SAUF que j'ai cherche pourquoi cela ne fonctionnait pas,

avant de decouvrir que la Saisie des NOMs devait etre EXACTE

(Bien respecter Majuscules / Minuscules)

 

MERCI, Bye, lecrabe

[Patrick_35]

Ta routine est OK mais ne fonctionne que pour un seul "couple" de Bloc A LA FOIS !

Non, l'idée est de récupérer le nom de l'étiquette, même sur des blocs différents et de propager ces valeurs vers d'autres blocs qui ont la même étiquette.

Tu n'as pas de limites pour la sélection des attributs, ni de blocs pour recopier les valeurs.

 

@+