Aller au contenu

COPIER UN BLOC ET CHANGER SON NOM


PHILPHIL

Messages recommandés

bonsoir

 

une question

est ce réalisable ??

 

copier un bloc nommé "A" et le renommer en "B" ?

pour avoir deux blocs identique (clone ) visuellement mais de nom different

 

( car si je fait une copie normal, et renomme le bloc en "B" ils seront tous appeler "B" meme les "A" )

 

si le bloc "B" existe dans le fichier il prend la forme de "B", sinon il reste un clone de "A"

 

apres reflexion : je peux copier sans probleme

 

le probleme est de renommer un bloc "A" en bloc "B"

 

par la suite je mets a jour les bloc "B" "C" "D" .... tous en meme temps suivant le fichier qui est dans ma biblioteque

 

sinon je suis obliger de copier le blocs "A", importer le bloc "B", remplacer "A" par "B" avec rebloc

 

 

a+

 

Phil

Autodesk Architecture 2023 sous windows 11 64

24 pouces vertical + 30 pouces horizontal + 27 pouces horizontal

Lien vers le commentaire
Partager sur d’autres sites

Coucou

 

Le plus simple est de redéfinir le bloc

À moins de tenter ce qui me vient en tête :

Copier le bloc A en utilisant Ctrl-Shift+C, le coller ailleurs en utilisant Ctrl-Shift+V

La copie devient un bloc anonyme (avec un nom barbare donné par le logiciel)

Renommer cette copie en B et tu devrais obtenir deux clones avec des noms de blocs différents

 

Amicalement

  • Upvote 1
Lien vers le commentaire
Partager sur d’autres sites

Salut,

 

Tu sélectionnes ton bloc TOTO > clic droit > puis dans l'éditeur de bloc > commande: _BSAVEAS > Tu me nommes en TITI > Fermer l'éditeur de bloc.

 

Puis tu insères ton nouveau bloc TITI.

Steven________________________________________

Pour le taf; Windows (et ses emmerdes) sinon pas d'AutoCAD.

Pour le perso Linux Mint et pas de problèmes. Mais pas d'AutoCAD.

En rêve; AutoCAD sous Linux.

Lien vers le commentaire
Partager sur d’autres sites

Salut,

 

Tu sélectionnes ton bloc TOTO > clic droit > puis dans l'éditeur de bloc > commande: _BSAVEAS > Tu le nommes en TITI > Fermer l'éditeur de bloc.

 

Puis tu insères ton nouveau bloc TITI.

 

Tu as un bloc TOTO et un bloc TITI qui sont pareil.

Steven________________________________________

Pour le taf; Windows (et ses emmerdes) sinon pas d'AutoCAD.

Pour le perso Linux Mint et pas de problèmes. Mais pas d'AutoCAD.

En rêve; AutoCAD sous Linux.

Lien vers le commentaire
Partager sur d’autres sites

Ce qui est surprenant, c'est que dans AutoCAD Architecture, on peut faire ça encore plus simplement.

Clic droite sur le bloc > Copier la définition de bloc et affecter...

Pourquoi les développeurs n'ont pas intégrer cette fonction dans AutoCAD?...

Steven________________________________________

Pour le taf; Windows (et ses emmerdes) sinon pas d'AutoCAD.

Pour le perso Linux Mint et pas de problèmes. Mais pas d'AutoCAD.

En rêve; AutoCAD sous Linux.

Lien vers le commentaire
Partager sur d’autres sites

bonsoir

 

 

je copie mes blocs "A1" "A2" "A3"

 

ils sont donc deja en place, bien inseres

 

je voudrais les renommer en "B1" "B2" "B3" un par un ca sera plus facile tout en restant des clones (pour le moment)

 

et apres je fais la mise a jour de mes blocs "B1" "B2" "B3" par rapport a ma bibliotheque.

 

je crais tjrs mes blocs comme des fichiers a part rarement dans le fichier lui meme de facon a ce que ca puisse reservir ailleurs, comme bcp je pense.

ou alors ensuite je les exportes vite fait avec "BTOWBL".

 

ca me semble compliqué , car c'est une copie de bloc en interne sans "foutre le bordel" dans la base des noms de bloc du fichier

 

sinon Didier il y a bien longtemps que ctrl-shift+c et ctrl-shift+v ne donne plus de nom barbare au nom de bloc

 

a+

 

Phil

Autodesk Architecture 2023 sous windows 11 64

24 pouces vertical + 30 pouces horizontal + 27 pouces horizontal

Lien vers le commentaire
Partager sur d’autres sites

Je confirme Ctrl + Maj + V (Coller en tant que bloc) donne un bloc avec un nom anonyme AC$XXXXXXXX.

Steven________________________________________

Pour le taf; Windows (et ses emmerdes) sinon pas d'AutoCAD.

Pour le perso Linux Mint et pas de problèmes. Mais pas d'AutoCAD.

En rêve; AutoCAD sous Linux.

Lien vers le commentaire
Partager sur d’autres sites

bonsoir

 

 

je copie mes blocs "A1" "A2" "A3"

 

ils sont donc deja en place, bien inseres

 

je voudrais les renommer en "B1" "B2" "B3" un par un ca sera plus facile tout en restant des clones (pour le moment)

 

 

Tu peux faire la manip' que j'ai expliqué plus haut puis remplacer les blocs déjà insérés avec le lisp Rbloc, par le ou les blocs fraîchement créés avec la commande _BSAVEAS .

Steven________________________________________

Pour le taf; Windows (et ses emmerdes) sinon pas d'AutoCAD.

Pour le perso Linux Mint et pas de problèmes. Mais pas d'AutoCAD.

En rêve; AutoCAD sous Linux.

Lien vers le commentaire
Partager sur d’autres sites

Salut

 

Il me semble bien avoir déjà écrit un LISP qui fait ça, en attendant que je le retrouve, tu peux déjà tester celui-ci (tout frais) :

 

(defun c:CloneBlock (/ source elst name target objects)
 (vl-load-com)
 (or *acad* (setq *acad* (vlax-get-acad-object)))
 (or *acdoc* (setq *acdoc* (vla-get-ActiveDocument *acad*)))
 (or *blocks* (setq *blocks* (vla-get-Blocks *acdoc*)))
 (and
   (or
     (setq source (car (entsel "\nSélectionnez le bloc source: ")))
     (prompt "\nAucune selection.")
   )
   (or
     (= (vla-get-ObjectName (setq source (vlax-ename->vla-object source)))
 "AcDbBlockReference"
     )
     (prompt "\nL'objet sélectionné n'est pas un bloc.")
   )
   (or
     (snvalid
(setq name (getstring "\nEntrez le nom du nouveau bloc: "))
     )
     (prompt "\nNom de bloc non valide.")
   )
   (or
     (null (tblsearch "block" name))
     (prompt (strcat "\nle bloc '" name "' existe déjà."))
   )
   (setq target (vla-add *blocks* (vlax-3d-point '(0. 0. 0.)) name))
   (vlax-for obj (vla-Item *blocks* (vla-get-EffectiveName source))
     (setq objects (cons obj objects))
   )
   (vlax-invoke *acdoc* 'CopyObjects objects target)
   (vla-InsertBlock
     (vla-get-Block (vla-get-ActiveLayout *acdoc*))
     (vla-get-InsertionPoint source)
     name
     (vla-get-XScaleFactor source)
     (vla-get-XScaleFactor source)
     (vla-get-XScaleFactor source)
     (vla-get-Rotation source)
   )
   (vla-Delete source)
 )
 (princ)
)

Gilles Chanteau - gileCAD -
Développements sur mesure pour AutoCAD
ADSK_Expert_Elite_Icon_S_Color_Blk_125.png

Lien vers le commentaire
Partager sur d’autres sites

J'ai retrouvé le LISP que j'avais écrit. Il est plus long que celui de la réponse #9 mais ça ne veut pas forcément dire qu'il marche mieux...

 

;; 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 proprié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	  'Color       'FieldLength
		'Height	     'InsertionPoint	       'Invisible
		'Layer	     'TextString  'Linetype    'LinetypeScale
		'Lineweight  'Material	  'Normal      'ObliqueAngle
		'Rotation    'ScaleFactor 'StyleName   'TextString
		'Thickness   'TrueColor	  'UpsideDown  'Visible
	       )
  (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)
)

Gilles Chanteau - gileCAD -
Développements sur mesure pour AutoCAD
ADSK_Expert_Elite_Icon_S_Color_Blk_125.png

Lien vers le commentaire
Partager sur d’autres sites

hello didier steven

 

autant pour moi c'est exact

 

j'ai confondu avec ctrl+c et ctrl+v

 

mais j'ai jamais utilisé ctrl+shift+c et/ou ctrl+shift+v

c'est quoi ce truc barbare, je comprend mieux pourquoi je me recupere des blocs avec des noms pareils dans des fichiers, le truc a proscrire.

 

a+

 

bonne nuit

 

Phil

Autodesk Architecture 2023 sous windows 11 64

24 pouces vertical + 30 pouces horizontal + 27 pouces horizontal

Lien vers le commentaire
Partager sur d’autres sites

hello Gile

 

merciii Gile

 

c:nbl fonctionne mieux car il garde les unites de dessin du blocs

 

du coup je lui ai rajouté un boite de dialogue pour le nom

 

on ne peut pas sortir de la boite tant que le nom est déja present dans la base ou qu'il soit blanc ( sans caractere )

 

bizarrement il plante si on finit le nom par un espace

 

a+

 

Phil

 

;; NBL -09/06/16- version 2.3
;; gile
;; 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 proprié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.")
 )
 (setq 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)
                )
 )
 (while (not (and (progn (setq boite "MODIFICATION DU NOM DE BLOC")
                         (setq message "NOUVEAU NOM")
                         (inputbox2 boite message old-name)
                         (snvalid (setq new-name ret))
                  )
                  (/= 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-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
                                'color          'fieldlength
                                'height         'insertionpoint
                                'invisible      'layer
                                'textstring     'linetype
                                'linetypescale  'lineweight
                                'material       'normal
                                'obliqueangle   'rotation
                                'scalefactor    'stylename
                                'textstring     'thickness
                                'truecolor      'upsidedown
                                'visible
                               )
              (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)
)

Autodesk Architecture 2023 sous windows 11 64

24 pouces vertical + 30 pouces horizontal + 27 pouces horizontal

Lien vers le commentaire
Partager sur d’autres sites

Coucou

 

À propos du message #12 :

 

Au temps pour toi,

 

Ça c'est sûr, si tu ne connais pas la différence entre Ctrl+C et Ctrl+Shift+C on ne parle pas de la même chose !

C'est pas grave en soi, c'est juste qu'on n'explique pas les choses présupposées connues avec une ceinture noire !

 

Amicalement

Lien vers le commentaire
Partager sur d’autres sites

il y a aussi le lisp CBL de giles et/ou patrick35 dont je me sert très, très souvent wink.gif

 

il faut copier le bloc et ensuite avec cette commande on le renomme sans changer les blocs d'origine

 

 

(defun c:cbl(/  act blo doc ent lst rep inputbox MsgBox nombl)

;-------------------------------------------------------------------------
; Saisir une valeur via une boite de dialogue
;-------------------------------------------------------------------------

 ;; InputBox (gile)
 ;; Ouvre une boite de dialogue pour récupérer une valeur
 ;; sous forme de chaine de caractère
 ;;
 ;; Arguments
 ;; tous les arguments sont de chaines de caractère (ou "")
 ;; box : titre de la boite de dialogue
 ;; msg : message d'invite
 ;; val : valeur par défaut
 ;;
 ;; Retour
 ;; une chaine ("" si annulation)
 ;;
 ;; Modifié par Patrick_35 pour inclure le caractère \n
 ;; comme retour chariot

 (defun InputBox (box msg val / subr temp file dcl_id ret)
   ;; Retour chariot automatique à 50 caractères
   (defun subr (str / pos)
     (cond
       ((setq pos (vl-string-search "\n" str))
         (strcat ":text_part{label=\""
                 (substr str 1 pos)
                 "\";}"
                 (subr (substr str (+ 2 pos)))
         )
       )
       ((and (< 80 (strlen str))
             (setq pos (vl-string-position 32 (substr str 1 80) nil T))
         )
         (strcat ":text_part{label=\""
                 (substr str 1 pos)
                 "\";}"
                 (subr (substr str (+ 2 pos)))
         )
       )
       (T
         (strcat ":text_part{label=\"" str "\";}")
       )
     )
   )
   ;; Créer un fichier DCL temporaire
   (setq temp (vl-filename-mktemp "Tmp.dcl")
         file (open temp "w")
         ret  ""
   )
   ;; Ecrire le fichier
   (write-line
     (strcat
       "InputBox:dialog{key=\"box\";initial_focus=\"val\";spacer;:paragraph{"
       (subr msg)
       "}spacer;:edit_box{key=\"val\";edit_width=54;allow_accept=true;}
       spacer;ok_cancel;}"
     )
     file
   )
   (close file)
   ;; Ouvrir la boite de dialogue
   (setq dcl_id (load_dialog temp))
   (if (not (new_dialog "InputBox" dcl_id))    
     (exit)
   )
   (set_tile "box" box)
   (set_tile "val" val)
   (action_tile
     "accept"
     "(setq ret (get_tile \"val\")) (done_dialog)"
   )
   (start_dialog)
   (unload_dialog dcl_id)
   ;;Supprimer le fichier
   (vl-file-delete temp)
   ret
 )

 (defun MsgBox (Titre Bouttons Message / Reponse WshShell)
   (acad-push-dbmod)
   (setq WshShell (vlax-create-object "WScript.Shell"))
   (setq Reponse (vlax-invoke WshShell 'Popup Message 0 Titre (itoa Bouttons)))
   (vlax-release-object WshShell)
   (acad-pop-dbmod)
   Reponse
 )

 (defun nombl(bl)
   (if (vlax-property-available-p bl 'effectivename)
     (vla-get-effectivename bl)
     (vla-get-name bl)
   )
 )

 (setq doc (vla-get-activedocument (vlax-get-acad-object))
       act "1.00"
 )
 (vla-startundomark doc)
 (and  (setq blo (entsel))
       (setq blo (vlax-ename->vla-object (car blo)))
       (eq (vla-get-objectname blo) "AcDbBlockReference")
       (/= (setq rep (inputbox (strcat "CBL " act) "Indiquez le nouveau nom" (nombl blo))) "")
   (progn
     (if (tblsearch "block" rep)
       (msgbox (strcat "CBL " act) 16 (strcat "Le bloc " rep " existe déjà."))
       (progn
         (vlax-for ent (vla-item (vla-get-blocks doc) (nombl blo))
           (setq lst (cons ent lst))
         )
         (vla-copyobjects doc
                          (vlax-safearray-fill
                            (vlax-make-safearray vlax-vbObject (cons 0 (1- (length lst))))
                            lst
                          )
                          (vla-add (vla-get-blocks doc) (vlax-3d-point '(0.0 0.0 0.0)) rep)
         )
         (vla-put-name blo rep)
       )
     )
   )
 )
 (vla-endundomark doc)
 (princ)
)

Raph.

Celui qui pose une question est bête 5 minutes, celui qui n'en pose pas l'est toute sa vie !

Lien vers le commentaire
Partager sur d’autres sites

Je pense que CBL est de Patrick_35 (il est des styles et des noms de variables qui sont de véritables signatures).

CBL fait la même chose que CloneBlock avec une interface plus "riche" (boites de dialogue.

NBL est plus complet (comme l'a noté PHILPHIL) dans la copie des propriétés de la référence de bloc sélectionnée : insertion en 3d, unités, propriétés des références d'attributs.

Gilles Chanteau - gileCAD -
Développements sur mesure pour AutoCAD
ADSK_Expert_Elite_Icon_S_Color_Blk_125.png

Lien vers le commentaire
Partager sur d’autres sites

mais j'ai jamais utilisé ctrl+shift+c et/ou ctrl+shift+v

Pour le second je te pardonne largement, ton commentaire et recevable, mais comment as-tu fait tant d'années sans le premier ?

;)

Bureau d'études dessin.

Spécialiste Escaliers

Développement - Formation

 

./__\.
(.°=°.)
Lien vers le commentaire
Partager sur d’autres sites

 

bizarrement il plante si on finit le nom par un espace

 

Pour supprimer tous les caractères non imprimable à gauche et à droite, fais :

(setq new-name (vl-string-trim ret))

 

ou mieux, utilise snvalid pour tester la validité du nom entré :

(snvalid (setq new-name ret))

Gilles Chanteau - gileCAD -
Développements sur mesure pour AutoCAD
ADSK_Expert_Elite_Icon_S_Color_Blk_125.png

Lien vers le commentaire
Partager sur d’autres sites

hello

 

Gile :

 

j'ai rajouté

 

(setq new-name (vl-string-trim ret))

 

a la place de

 

(setq new-name ret)

 

mais ca plante aussi, pas grave

 

je viens de voir "snvalid"

 

et la ca marche, je corrige le lisp

 

merci

 

Tramber :

 

le shift apporte quoi de plus ? d'avoir un point de base ?

 

ba sinon dans le meme fichier je fais "copier" ( la commande )

 

ou d'un fichier a l'autre , je colle puis apres je redéplace

 

a+

 

Phil

Autodesk Architecture 2023 sous windows 11 64

24 pouces vertical + 30 pouces horizontal + 27 pouces horizontal

Lien vers le commentaire
Partager sur d’autres sites

Coucou

Si tu ne travailles pas en coordonnées absolues tu peux continuer ainsi
S
avoir que ça existe est un plus.

Je reviens sur ma méthode, sans volonté de dire que c'est la meilleure, mais elle est simplissime, alors pourquoi t'obstiner à lisper.
Je ne parle pas de (gile), c'est son métier de faire des programmes, et il le fait très bien.
J
e parle de ta vie de tous les jours.
U
n copier-coller avec création de bloc anonyme qu'on renomme à la volée et le tour est joué.

Lien vers le commentaire
Partager sur d’autres sites

Bonjour à tous

 

Je pense que CBL est de Patrick_35 (il est des styles et des noms de variables qui sont de véritables signatures).

Je ne me souvenais plus de celui-ci.

Comme tu as raison (gile). Combien de fois je vois un lisp ou même un extrait de lisp et on reconnait tout de suite son auteur.

 

@+

Les Lisps de Patrick

Le but n'est pas toujours placé pour être atteint, mais pour servir de point de mire.

Joseph Joubert, 1754-1824

Lien vers le commentaire
Partager sur d’autres sites

  • 6 ans après...
Le 08/06/2016 à 23:03, (gile) a dit :

J'ai retrouvé le LISP que j'avais écrit. Il est plus long que celui de la réponse #9 mais ça ne veut pas forcément dire qu'il marche mieux...

 

 

;; 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 proprié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	  'Color       'FieldLength
		'Height	     'InsertionPoint	       'Invisible
		'Layer	     'TextString  'Linetype    'LinetypeScale
		'Lineweight  'Material	  'Normal      'ObliqueAngle
		'Rotation    'ScaleFactor 'StyleName   'TextString
		'Thickness   'TrueColor	  'UpsideDown  'Visible
	       )
  (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)
)
 

 

@(gile) j'utilise ce lisp depuis des années et le trouve très pratique...

je me suis toutefois rendu compte dernièrement que le nouveau bloc :

 - n'hérite pas des unités du bloc dont il est originaire

- le centre du bloc se trouve à un endroit indéterminé mais n'est pas non plus celui du bloc initialement cloné ( aprioir ce centre serait le SCU)

saurais tu faire un petite MAJ de ce lisp stp?

Phil

Projeteur Revit Indépendant - traitement des eaux/CVC

Lien vers le commentaire
Partager sur d’autres sites

Il y a 10 heures, philsogood a dit :

- n'hérite pas des unités du bloc dont il est originaire

Peux-tu préciser et fournir un exemple, je n'arrive pas à reproduire ça.

Il y a 10 heures, philsogood a dit :

- le centre du bloc se trouve à un endroit indéterminé mais n'est pas non plus celui du bloc initialement cloné ( aprioir ce centre serait le SCU)

Je ne sais pas ce que tu appelles "le centre du bloc". Comme précédemment, fournit un exemple et des explications plus claires.

Gilles Chanteau - gileCAD -
Développements sur mesure pour AutoCAD
ADSK_Expert_Elite_Icon_S_Color_Blk_125.png

Lien vers le commentaire
Partager sur d’autres sites

Gilles

j'ai peut être crié avant d'avoir mal ; tout bien regardé, mon lisp n'avait même pas de "versionnage", c'était sans doute une vielle version.

j'ai mis à jour le lisp plus de problème notoire, merci à toi Gilles, les 20 ans du forum c'est aussi un peu tes 20 ans à toi aussi... à quelques décennies près 😛

Phil

Projeteur Revit Indépendant - traitement des eaux/CVC

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é