Aller au contenu

Données étendues avec le lisp CAT de Patrick_35


JPhil

Messages recommandés

Est-il possible de copier en plus des attributs les données étendues d'un bloc à un autre, en se basant sur le programme CAT de Patrick_35 ?

Source de l'excellent programme CAT de Patrick_35 

;;;=================================================================
;;;
;;; CAT.LSP V2.01
;;;
;;; Copier des attributs
;;;
;;; Copyright (C) Patrick_35
;;;
;;;=================================================================

(defun c:cat(/ att bl doc ent s sel *errcat*)

;=========================================================================
; Gestion des erreurs
;=========================================================================

  (defun *errcat* (msg)
    (or (member (strcase msg) '("FUNCTION CANCELLED" ""QUIT / EXIT ABORT"" "FONCTION ANNULEE" "QUITTER / SORTIR ABANDON"))
      (princ (strcat "\nErreur : " msg))
    )
    (vla-endundomark doc)
    (setq *error* s)
    (princ)
  )

  (vl-load-com)
  (setq s *error*
    *error* *errcat*
    doc (vla-get-activedocument (vlax-get-acad-object))
  )
  (vla-startundomark doc)
  (and    (setq ent (entsel "\nSélectionnez le bloc d'origine : "))
    (setq ent (vlax-ename->vla-object (car ent)))
    (eq (vla-get-objectname ent) "AcDbBlockReference")
    (eq (vla-get-hasattributes ent) :vlax-true)
    (princ "\nSélectionnez les blocs destinataires")
    (ssget (list (cons 0 "insert") (cons 66 1)))
    (progn
      (setq att (vlax-invoke ent 'getattributes))
      (vlax-for bl (setq sel (vla-get-activeselectionset doc))
    (mapcar '(lambda(a b)(vla-put-textstring a (vla-get-textstring b))) (vlax-invoke bl 'getattributes) att)
      )
      (princ (strcat "\n" (itoa (vla-get-count sel)) " bloc(s) modifié(s)."))
      (vla-delete sel)
    )
  )
  (vla-endundomark doc)
  (setq *error* s)
  (princ)
)

(setq nom_lisp "CAT")
(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)

Quels sont les risques ?
Merci.

Lien vers le commentaire
Partager sur d’autres sites

Coucou,

Cela va dépendre de la manière dont tu as ajouté des données étendues...
En utilisant (regapp) et le code -3, alors tu pourras récupérer la liste en utilisant

(entget (car ent) '("*"))

puis (cf. >>Da-code<<)

(cdr (assoc -3 ...))

Si tu utilises plutôt les fonctions (vlax-ldata-*), alors tu as la fonction (vlax-ldata-list) qui te permet de récupérer la liste des données étendues définies par (vlax-ldata-put).
Je suppose qu'il existe d'autres méthodes pour stocker ces données étendues mais ne les connaissant pas, je ne saurais te dire comment les récupérer.

En terme de risque, tout dépend du type de données étendues je pense : s'il s'agit de données étendues qui sont unique alors le risque c'est que tu va perdre cette unicité mais s'il s'agit de simples infos complémentaires commune entre blocs communs, alors je doute qu'il y ait le moindre risque

Bisous,
Luna

Lien vers le commentaire
Partager sur d’autres sites

Hello

Voici une excellente routine "COPY_XD" du Grand Maitre Gilles (gile) qui copie TOUTES les XDs de UNE entite selectionnee vers N entites selectionnees

Mais cela peut s'averer dangeureux ... Encore Merci Gilles

La Sante, Bye, lecrabe

PS: Routine tiree de mon stock de 3001 routines ...

 

 
;; 
;; Copier les XDATAs (Donnees Etendues) de UN objet source vers N objets cible 
;;
;; Routine par GC vs 1.00 pour Patrice B.
;; 
;; Commande au clavier :  COPY_XD 
;;
;; Routine identique dans le principe a  COPY_OD  (pour MAP ou CIVIL) 
;;
;; Chargement par :  APPLOAD 
;; 

(vl-load-com) 

(defun c:COPY_XD (/ ss source sdata n apps ent elst cdata)
  (if
    (and
      (setq source (car (entsel "\nSelectionnez l Objet Source (avec Donnees Etendues/XDATAs) : ")))
      (setq sdata (cdr (assoc -3 (entget source '("*")))))
    )
     (progn
       (setq n	  -1
	     apps (mapcar 'car sdata)
       )
       (princ "\nSelectionnez les N Objets Cible ... ")
       (if (setq ss (ssget))
	 (while	(setq ent (ssname ss (setq n (1+ n))))
	   (setq elst  (entget ent '("*"))
		 cdata (cdr (assoc -3 elst))
		 elst  (vl-remove (assoc -3 elst) elst)
	   )
	   (entmod
	     (append elst
		     (list (cons -3
				 (append
				   (vl-remove-if
				     (function
				       (lambda (x)
					 (member (car x) apps)
				       )
				     )
				     cdata
				   )
				   sdata
				 )
			   )
		     )
	     )
	   )
	 )
       )
     )
     (princ
       "\nL Objet selectionne ne contient pas de Donnees Etendues (XDATA) ! "
     )
  )
  (princ)
)
 

 

Autodesk Expert Elite Team

Lien vers le commentaire
Partager sur d’autres sites

Créer un compte ou se connecter pour commenter

Vous devez être membre afin de pouvoir déposer un commentaire

Créer un compte

Créez un compte sur notre communauté. C’est facile !

Créer un nouveau compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant
×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité