COPIER ATTRIBUTS D'un bloc qui est dans un bloc / xref

[PHILPHIL]

bonjour

j'utilise CATT.lsp de Gile

qui copie les attributs d'un bloc vers un autre bloc.  pour peu que ces blocs soit dans le meme fichiers *.dwg.

je cherche la solution en lisp, pour allé récupérer les attributs d'un bloc source qui est lui dans un XREF de mon fichier.

source = bloc dans l'xref de mon fichier *.dwg

destination = un bloc dans mon fichier *.dwg

 

si je remplace "ENTSEL" par "NENTSEL"  je ne récupére qu'une entité du bloc source.

mais ca permetrait de chercher a quel bloc cette entite appartient, et en récupérer les infos d'attributs. mais comment faire ?????
 

comment modifie ca en gros

(setq source (car (entsel "\nSélectionnez le bloc source: ")))

 

merci

 

Phil

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

(defun c:catt1 (/
;;;               source attlst ss attrib
               )
  (vl-load-com)
  (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 (foreach att (vlax-invoke source 'getattributes)
             (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")
  )
  (princ)
)

 

[PHILPHIL]

hello

je me répond a moi même

sélectionner une entité du bloc qui est dans l'Xref ( autre que un attribut ) pour avoir la source

 

;;; Copier des attributs d('un bloc dans un XREf vers un bloc fichier
;;;
;;; Copyright (C) (gile)

(defun c:catt_xref_bloc (/ source attlst ss attrib)
  (vl-load-com)
  (setq couleurreticule (vla-get-modelcrosshaircolor (vla-get-display (vla-get-preferences (vlax-get-acad-object)))))
  (vla-put-modelcrosshaircolor (vla-get-display (vla-get-preferences (vlax-get-acad-object))) 255)
  (if (and
;;;        (setq source (car (nentsel "\nSélectionnez le bloc source: ")))
           (setq ent1 (nentsel "\nSELECTIONNER UNE SOUS-ENTITE DU BLOC AUTRE QU'UN ATTRIBUT :"))
;;;(setq sourcebis (car(car (cdddr  ENT1))))
           (setq source (vlax-ename->vla-object (car (car (cdddr ent1)))))
           (= (vla-get-objectname source) "AcDbBlockReference")
           (= (vla-get-hasattributes source) :vlax-true)
      )
    (progn (vla-put-modelcrosshaircolor (vla-get-display (vla-get-preferences (vlax-get-acad-object)))
                                        couleurreticule
           )
           (foreach att (vlax-invoke source 'getattributes)
             (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")
  )
  (princ)
)

Phil