Renommer une copie de bloc !

[Circus]

Bonjour,

 

Je ne sais pas si mon titre est clair.

 

Je connais la fonction renommer mais je souhaite conserver mon ancien bloc avec son nom d'origine.

 

En attend je vais le copier dans un autre fichier , le renommer le réimporté...

 

Merci d'avance !

[lili2006]

Bonjour à tous,

 

Sinon il y a aussi ce lisp (que son auteur me pardonne, je ne le retrouve pas dans mon cafarneum!!).Ce lisp permet de créer un nouveau nom et caractéristiques d'un bloc déjà inséré dans un dessin, sans modifier les autres insertions de ce bloc. Ca à l'air de répondre à ton problème, non ?

 

Tapes en ligne de commande : NBL =>

 

 defun c:nbl (/ old name AcDoc Space zdir ins rot nor obj new ref)
(vl-load-com)
(while (not
(and
(setq old (car (entsel "\nSélectionner le bloc à re-créer: ")))
(= "INSERT" (cdr (assoc 0 (entget old))))
)
)
(princ "\nObjet incorrect.")
)
(while
(not
(and
(setq
name (getstring T "\nEntrez le nouveau nom pour le bloc: ")
)
(/= name "")
(null (tblsearch "BLOCK" name))
)
)
(princ "\nNom incorrect.")
)
(setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object))
Space (if (= (getvar "CVPORT") 1)
(vla-get-PaperSpace AcDoc)
(vla-get-ModelSpace AcDoc)
)
zdir (trans '(0 0 1) 1 0 T)
old (vlax-ename->vla-object old)
ins (vlax-get old 'InsertionPoint)
rot (vla-get-Rotation old)
nor (vlax-get old 'Normal)
obj (vlax-invoke old 'Explode)
new (vla-add (vla-get-Blocks AcDoc)
(vlax-3d-point (trans ins 0 nor))
name
)
)
(foreach n obj
(vla-rotate3d
n
(vlax-3d-point ins)
(vlax-3d-point (mapcar '+ ins nor))
(- rot)
)
(vla-transformby
n
(vlax-tmatrix
(append
(mapcar
'(lambda (vec org)
(append (trans vec nor 0 T) (list org))
)
(list '(1 0 0) '(0 1 0) '(0 0 1))
(trans '(0 0 0) 0 nor)
)
(list '(0 0 0 1))
)
)
)
)
(vlax-invoke acDoc 'CopyObjects obj new)
(mapcar 'vla-delete (cons old obj))
(setq ref
(vla-insertblock
Space
(vlax-3d-point '(0 0 0))
name
1
1
1
0
)
)
(vla-transformby
ref
(vlax-tmatrix
(append
(mapcar
'(lambda (vec org)
(append vec (list org))
)
(mxm
(mapcar '(lambda (x) (trans x 0 nor T))
'((1 0 0) (0 1 0) (0 0 1))
)
(mapcar '(lambda (x) (trans x zdir 0 T))
'((1 0 0) (0 1 0) (0 0 1))
)
)
ins
)
(list '(0 0 0 1))
)
)
)
(vla-rotate3d
ref
(vlax-3d-point ins)
(vlax-3d-point (mapcar '+ ins nor))
rot
)
(princ (strcat "Le bloc \"" name "\" a été créé."))
(princ)
)

;; Multiply two matrices by Vladimir Nesterovsky
(defun mxm (m q)
(mapcar '(lambda (r)
(mapcar '(lambda (l) (apply '+ (mapcar '* l r)))
(apply 'mapcar (cons 'list q))
)
)
m
)
) 

[(gile)]

salut,

 

Il me semblait bien qu'il y avait eu un sujet similaire, lili2006 a retrouvé la routine avant moi, le sujet original est ici

[lili2006]

Re,

 

Je pensais bien que ce lisp était de toi (Gile) mais il n'est pas répertorié sur ta page cadxp, ni même sur ta page perso, c'est dommage, car tous ces outils sont trés pratique. Je me doute que c'est un travail énorme, mais il serait bien que chaques lispeurs de ce forum puisse regrouper leur travaux de façon globale. Comme je le dis plus haut, il est difficile pour des utilisateurs comme moi de retrouver systématiquement les auteurs. Mais je pense que tu ne m'en veux pas, car l'esprit que vous donnez (je pense essentiellement à ceux qui apportent plus que l'utilisation des outils intégrés par AutoCAD, et ils se reconnaitront) à ce forum est le partage des savoirs et savoir faire et c'est cela qui est super sur ce site. Merci encore.

 

@+,

[Circus]

Merci bien,

 

Je copie colle ca ! Dommage que ce ne soi pas une fonction de base !

 

Merci encore.

 

A+

[(gile)]

Je viens de remarquer que j'avais oublié de prendre en compte les échelles X, Y et Z de la référence sélectionnée (ce qui peut faire échouer la routine si ces échelles ne sont pas uniformes).

 

Voilà une version corrigée, en attendant que je me penche plus sérieusement sur la question pour faire quelque chose de mieux abouti (que j'ajouterais alors à mes LISP en téléchargement puisqu'il y a la demande).

 

(defun c:nbl (/ old name AcDoc Space zdir ins rot nor obj new ref)
 (vl-load-com)
 (while (not
   (and
     (setq old (car (entsel "\nSélectionner le bloc à re-créer: ")))
     (= "INSERT" (cdr (assoc 0 (entget old))))
   )
 )
   (princ "\nObjet incorrect.")
 )
 (while
   (not
     (and
(setq
  name (getstring T "\nEntrez le nouveau nom pour le bloc: ")
)
(/= name "")
(null (tblsearch "BLOCK" name))
     )
   )
    (princ "\nNom incorrect.")
 )
 (setq	acDoc (vla-get-ActiveDocument (vlax-get-acad-object))
Space (if (= (getvar "CVPORT") 1)
	(vla-get-PaperSpace AcDoc)
	(vla-get-ModelSpace AcDoc)
      )
zdir  (trans '(0 0 1) 1 0 T)
old   (vlax-ename->vla-object old)
ins   (vlax-get old 'InsertionPoint)
rot   (vla-get-Rotation old)
nor   (vlax-get old 'Normal)
xsc   (vla-get-XScaleFactor old)
ysc   (vla-get-YScaleFactor old)
zsc   (vla-get-ZScaleFactor old)
 )
 (or (vl-every '(lambda (sc) (= sc 1.0)) (list xsc ysc zsc))
     (progn
(vla-put-XScaleFactor old 1.0)
(vla-put-YScaleFactor old 1.0)
(vla-put-ZScaleFactor old 1.0)
     )
 )
 (setq	obj (vlax-invoke old 'Explode)
new (vla-add (vla-get-Blocks AcDoc)
	     (vlax-3d-point (trans ins 0 nor))
	     name
    )
 )
 (foreach n obj
   (vla-rotate3d
     n
     (vlax-3d-point ins)
     (vlax-3d-point (mapcar '+ ins nor))
     (- rot)
   )
   (vla-transformby
     n
     (vlax-tmatrix
(append
  (mapcar
    '(lambda (vec org)
       (append (trans vec nor 0 T) (list org))
     )
    (list '(1 0 0) '(0 1 0) '(0 0 1))
    (trans '(0 0 0) 0 nor)
  )
  (list '(0 0 0 1))
)
     )
   )
 )
 (vlax-invoke acDoc 'CopyObjects obj new)
 (mapcar 'vla-delete (cons old obj))
 (setq	ref
 (vla-insertblock
   Space
   (vlax-3d-point '(0 0 0))
   name
   xsc
   ysc
   zsc
   0
 )
 )
 (vla-transformby
   ref
   (vlax-tmatrix
     (append
(mapcar
  '(lambda (vec org)
     (append vec (list org))
   )
  (mxm
    (mapcar '(lambda (x) (trans x 0 nor T))
	    '((1 0 0) (0 1 0) (0 0 1))
    )
    (mapcar '(lambda (x) (trans x zdir 0 T))
	    '((1 0 0) (0 1 0) (0 0 1))
    )
  )
  ins
)
(list '(0 0 0 1))
     )
   )
 )
 (vla-rotate3d
   ref
   (vlax-3d-point ins)
   (vlax-3d-point (mapcar '+ ins nor))
   rot
 )
 (princ (strcat "Le bloc \"" name "\" a été créé."))
 (princ)
)

;; Multiply two matrices by Vladimir Nesterovsky
(defun mxm (m q)
 (mapcar '(lambda (r)
     (mapcar '(lambda (l) (apply '+ (mapcar '* l r)))
	     (apply 'mapcar (cons 'list q))
     )
   )
  m
 )
) 

[LUDWIG]

terrible ! merci (gile) ça me servira aussi.

[Pieroka]

Plus simple peut être :

Ouvrir le bloc dans l'éditeur de blocs et dans la barre d'outils en haut :

choisir "enregistrer le bloc sous" le 3eme bouton en partant de la gauche.

 

http://shup.com/Shup/745/copiblocvq3.png

 

 

[(gile)]

Tu as raison, Pieroka !!!

C'est plus simple, et de plus, si je comprends l'intérêt de créer une nouvelle définition de bloc identique à celle de la référence sélectionnée, c'est pour la modifier, donc, depuis l'éditeur c'est tout à fait adapté !

 

Je donne quand même une nouvelle version plus concise et plus "rationnelle" pour ceux qui n'ont pas d'éditeur de bloc (versions antérieures à 2006) et pour ceux qui ne voudraient pas passer par là (et surtout parcque je viens de l'écrire)

 

;; NBL -03/08/07- version 2.2
;; Crée un nouvelle définition de bloc semblable à celle de la référence sélectionnée.
;; La référence sélectionnée est remplacée par une référence de la nouvelle définition
;; qui conserve ses proprétés.

(defun c:nbl (/	old-ref	new-name AcDoc Space Blocks old-name old-block new-block
      obj new-ref)
 (vl-load-com)
 (while (not
   (and
     (setq old-ref (car (entsel "\nSélectionner le bloc à re-créer: ")))
     (= "INSERT" (cdr (assoc 0 (entget old-ref))))
   )
 )
   (princ "\nObjet incorrect.")
 )
 (while
   (not
     (and
(setq
  new-name (getstring T "\nEntrez le nouveau nom pour le bloc: ")
)
(/= new-name "")
(null (tblsearch "BLOCK" new-name))
     )
   )
    (princ "\nNom incorrect.")
 )
 (setq	AcDoc	  (vla-get-ActiveDocument (vlax-get-acad-object))
Space	  (if (= (getvar "CVPORT") 1)
	    (vla-get-PaperSpace AcDoc)
	    (vla-get-ModelSpace AcDoc)
	  )
Blocks	  (vla-get-Blocks acDoc)
old-ref	  (vlax-ename->vla-object old-ref)
old-name  (if (vlax-property-available-p old-ref 'EffectiveName)
	    (vla-get-EffectiveName old-ref)
	    (vla-get-name old-ref)
	  )
old-block (vla-item Blocks old-name)
new-block (vla-add Blocks
		   (vlax-3d-point '(0 0 0))
		   new-name
	  )

 )
 (vlax-for o old-block
   (setq obj (cons o obj))
 )
 (vlax-invoke AcDoc 'CopyObjects obj new-block)
 (and (vlax-property-available-p old-block 'Units)
      (vla-put-Units new-block (vla-get-Units old-block))
 )
 (setq	new-ref
 (vla-insertblock
   Space
   (vlax-3d-point '(0 0 0))
   new-name
   (vla-get-XScaleFactor old-ref)
   (vla-get-YScaleFactor old-ref)
   (vla-get-ZScaleFactor old-ref)
   (vla-get-Rotation old-ref)
 )
 )
 (vla-put-Normal new-ref (vla-get-Normal old-ref))
 (vla-put-InsertionPoint
   new-ref
   (vla-get-InsertionPoint old-ref)
 )
 (if (= (vla-get-HasAttributes old-ref) :vlax-true)
   (progn
     (setq old-att (mapcar '(lambda (att) (cons (vla-get-TagString att) att))
		    (vlax-invoke old-ref 'getAttributes)
	    )
    new-att (mapcar '(lambda (att) (cons (vla-get-TagString att) att))
		    (vlax-invoke new-ref 'getAttributes)
	    )
     )
     (foreach att new-att
(foreach prop (list
		'Alignment  'Backward	'Height	    'InsertionPoint
		'Invisible  'TextString	'ObliqueAngle
		'StyleName  'UpsideDown
	       )
  (if (vlax-property-available-p
	(cdr (assoc (car att) old-att))
	prop
      )
    (vlax-put (cdr att)
	      prop
	      (vlax-get (cdr (assoc (car att) old-att)) prop)
    )
  )
)
     )
   )
 )
 (vla-delete old-ref)
 (princ (strcat "Le bloc \"" new-name "\" a été créé."))
 (princ)
) 

[Edité le 2/8/2007 par (gile)]

 

[Edité le 3/8/2007 par (gile)]

[speedy]

Bonjour à tous

 

j'ai essayé ce lisp nbl 2.0, il fonctionne mais dans mon cas il efface les infos inscrites dans les attributs.

 

sur plusieurs dessins j'ai des blocs identiques mais leurs noms a changé avec des suffixes nomdubloc-flat-1flat-1 , jaimerais tous les renommer mais le nom du bloc d'origine existe dans le dessin et ne peut le renommer ??

 

y a t'il une idée ?????

 

ps: j'ai remarqué quand on fait mesurer d'un bloc sur une ligne le nom de bloc n'est plus considéré comme bloc ??

 

merci

 

Michel a

[(gile)]

il efface les infos inscrites dans les attributs

 

Exact j'avais ommis le traitement des attributs, il récupèrent désormais leurs valeurs de l'ancienne référence (version 2.1)

[Circus]

Ahah Excellent !!

 

Bien vu Pieroka !!

 

Merci.

[LUDWIG]

J'ai testé cette version 2.1 sur un bloc cartouche avec une bonne quantité d'attributs. Le nouveau bloc récupère les informations, mais les place complètement dans le désordre dans le nouveau cartouche.

[(gile)]

Effectivement, suivant les blocs l'ordre des attributs change.

Donc, une nouvelle version (2.2) qui traite les attributs suivant leurs étiquettes et récupère d'autres propriétés de formatage du "texte" (certaines semblaient se perdre aussi).

 

Merci pour les tests ;)

[LUDWIG]

NBL marche super, mais les blocs dynamiques deviennent statiques. Y-a-t'il possibilité de modifier cela ? Merci d'avance !