Renommer un bloc (A$C3056...) par un nom plus explicite.

[Arcasdk]

Bonjour j'ai essayé de développer une petite macro qui me permet, comme le titre l'indique, de renommer un bloc.

 

J'ai déjà récupérer tous ce qu'il me faut. Maintenant faut juste lancer l'execution.

 

Voici mon bout de code

 

(defun c:cnbloc ()
      (while (or
	(not (setq bloc (car (entsel "\nSélectionner un bloc :"))))
	(/= (cdr (assoc 0 (entget bloc))) "INSERT") 
	)
 )
 (setq noma (cdr (assoc 2 (entget bloc))))
 (princ "\nVoici le nom actuel:")(print noma)
 (setq clef (strcat
       "(2. "
       (getstring "\nIndiquez le nouveau nom :")
       ")"
       )
)
 (subst clef (assoc 2 (entget bloc)) (entget bloc))
 ) 

 

La substitution fonctionne mais celà n'a rien changé dans le bloc...!!!!

 

Quelle est l'astuce?? :casstet:

 

[Edité le 31/1/2008 par Arcasdk]

[(gile)]

Salut,

 

C'est un bon début début, mais il manque une chose essentielle : entmod

La valeur de variable clef est du type chaîne, elle devrait être une paire pointée (regarde la fonction cons

C'est mieux si tu déclares les variables : (defun c:cnbloc (/ bloc noma clef) ...)

[lovecraft]

bonsoir,

 

voila ma reponse mais je bloque sur la fin ? j'ai dû râter une étape

 

 (defun c:teste (/ jsbloc ed nvnombloc)
(setq jsbloc (car (entsel "\nselectionne un bloc :")))
(setq ed (entget jsbloc))
(setq nvnombloc (getstring "\nIndiquez le nouveau nom :"))
(setq ed (subst (cons 2 nvnombloc) (assoc 2 ed) ed))
(entmod ed)
)

 

merci de l'aide

 

@plus

[(gile)]

Salut lovecraft et Arcasdk,

 

Vous essayez tous les deux de changer le nom d'une référence de bloc, c'est sur la définition du bloc qu'il faut agir.

 

D'autre part, j'ai répondu un peu vite la dernière fois (sans faire de tests) et il semble que entmod ne fonctionne pas pour changer le nom d'une définition de bloc. Il va donc falloir utiliser (command "-rename" ...) ou les fonctions vla-*.

 

Il serait prudent de vérifier si le nouveau nom n'est pas déjà présent dans la collection.

 

 

[vinz34]

Salut,

 

J'ai eu beau cherché en vl, je n'y arrive pas.

 

Une proposition en autolisp :

 

(defun c:br (/ b blist bname bnewname)
 (while (not b)
   (setq b (car (entsel "\nChoix du bloc à renommer")))
   )
 (setq blist (entget (cdr (assoc 330 (cdr (entget 
(tblobjname "block" (cdr (assoc 2 (entget b)))))))))
bname (cdr (assoc 2 blist))
bnewname (getstring (strcat "\nNouveau nom pour le bloc \"" bname "\" :")))
 (entmod (subst (cons 2 bnewname) (assoc 2 blist) blist))   
 )

 

Je pense qu'on peut faire plus court pour blist.

[Arcasdk]

Bon j'ai la première partie qui fonctionne.

C'est à dire renommer le bloc (Avec (Command "-renommer"

 

 (defun c:cnbloc	(/ bloc anciennom nouveaunom)
 (while (or
   (not (setq bloc (car (entsel "\nSélectionner un bloc :"))))
   (/= (cdr (assoc 0 (entget bloc))) "INSERT")
 )
 )
 (setq anciennom (cdr (assoc 2 (entget bloc))))
 (princ "\nVoici le nom actuel:")
 (print anciennom)
 (setq nouveaunom (getstring "\nIndiquez le nouveau nom :"))
 (command "-renommer" "bl" anciennom nouveaunom "")
)

 

Maintenant je cherche pour vérifier que le nouveau nom n'existe déjà pas.

et là ca donne un truc dans le genre (MAIS CA NE FONCTIONNE PAS)(....encore)

 

 (defun c:cnbloc	(/ bloc anciennom nouveaunom)
 (while (or
   (not (setq bloc (car (entsel "\nSélectionner un bloc :"))))
   (/= (cdr (assoc 0 (entget bloc))) "INSERT")
 )
 )
 (setq anciennom (cdr (assoc 2 (entget bloc))))
 (princ "\nVoici le nom actuel:")
 (print anciennom)
 (setq nouveaunom (getstring "\nIndiquez le nouveau nom :"))


				;VERIFICATION DU NOUVEAU NOM

 (setq js (ssget "X" '((0 . "INSERT"))))
 (sslength js)
 (setq x 0)
 (while (/= x (sslength js))
   (setq nom_ent (ssname js x))
   (setq ent (entget nom_ent))
   (setq name (cdr (assoc '2 ent)))
   (princ "\nBloc :")
   (print name)
   (if
     (= name nouveaunom)
      (progn
 (while
   (/= name nouveaunom)
    (alert "Ce nom de bloc existe déjà")
    (setq nouveaunom (getstring "\nIndiquez le nouveau nom :"))
 )
      )
   )
   (setq x (+ x 1))
 )
 (command "-renommer" "bl" anciennom nouveaunom "")
)

 

je continue de chercher.....

 

(quelques minutes plus tard...)

 

......Et voilà

 

(defun c:cnbloc	(/ bloc anciennom nouveaunom js x nom_ent ent name)
 (while (or
   (not (setq bloc (car (entsel "\nSélectionner un bloc :"))))
   (/= (cdr (assoc 0 (entget bloc))) "INSERT")
 )
 )
 (setq anciennom (cdr (assoc 2 (entget bloc))))
 (princ "\nVoici le nom actuel:")
 (print anciennom)
 (setq nouveaunom (getstring "\nIndiquez le nouveau nom :"))


				;VERIFICATION DU NOUVEAU NOM

 (setq js (ssget "X" '((0 . "INSERT"))))
 (sslength js)
 (setq x 0)
 (while (/= x (sslength js))
   (setq nom_ent (ssname js x))
   (setq ent (entget nom_ent))
   (setq name (cdr (assoc '2 ent)))
   (if
     (= name nouveaunom)
      (progn
 (while
   (= name nouveaunom)
    (alert "Ce nom de bloc existe déjà")
    (setq nouveaunom (getstring "\nIndiquez le nouveau nom :"))
 )
      )
   )
   (setq x (+ x 1))
 )
 (command "-renommer" "bl" anciennom nouveaunom "")
)

 

Reste à rendre plus lisible, et celà sera bon... Merci à tous

 

[Edité le 31/1/2008 par Arcasdk]

[vinz34]

J'avais oublié le test sans command ça peut être ça :

 

(defun c:br (/ b blist bname bnewname)
 (while (not b)
   (setq b (car (entsel "\nChoix du bloc à renommer")))
 )
 (setq	blist	 (entget (cdr (assoc 330 (cdr (entget
	(tblobjname "block" (cdr (assoc 2 (entget b))))  
	      ))))) 			  
bname	 (cdr (assoc 2 blist))
)
 (while (not bnewname)
   (setq
     bnewname (getstring
	 (strcat "\nNouveau nom pour le bloc \"" bname "\" :")
       )
   )
   (if	(tblsearch "block" bnewname)
     (progn
(print "ce nom de bloc existe déjà")
(setq bnewname nil)
     )
   )
 )
 (entmod (subst (cons 2 bnewname) (assoc 2 blist) blist))
)

[Arcasdk]

Coucou Vinz, je n'ai pas testé ton programme mais à première vue si un bloc porte le même nom que le nouveau ton programme s'arête... (Dis moi si je me trompe)

 

Tu devrais mettre une boucle qui ne continue pas le programme tant que le nouveau nom ne change pas.....

 

Sinon ton programme à l'air bcp plus court et donc surement plus rapide que le mien..... Bravo

[(gile)]

Salut,

 

Bravo vinz34, si entmod ne fonctionne pas avec la liste dxf de la définition du bloc, ça marche avec celle de son "block_record".

 

Une autre façon , en vlisp avec une boucle tant que le nouveau nom est déjà présent dans la collection.

 

(defun c:test (/ b l n)
 (vl-load-com)
 (while (not (and
	(setq b (car (entsel)))
	(= (cdr (assoc 0 (entget b))) "INSERT")
      )
 )
 )
 (setq	o (cdr (assoc 2 (entget b)))
n ""
 )
 (while (or (= n "")
     (tblsearch "BLOCK" n)
 )
   (setq n (getstring (strcat "\nAncien nom : \""
		       o
		       "\"\tNouveau nom: "
	       )
    )
   )
 )
 (vla-put-Name
   (vla-item
     (vla-get-Blocks
(vla-get-ActiveDocument
  (vlax-get-acad-object
  )
)
     )
     o
   )
   n
 )
 (princ)
) 

[vinz34]

Salut Arcasdk,

 

Tu devrais mettre une boucle qui ne continue pas le programme tant que le nouveau nom ne change pas

 

Si tu regardes bien, tu verras que la boucle existe bien.

Elle commence ici :

(while (not bnewname)

et se termine là :

(setq bnewname nil))))

.

 

Pour la longueur du code, je ne pense pas qu'elle influe sur le temps d'éxecution vu le niveau où en sont nos machines aujourd'hui. je cherchais seulement à éviter le "command"

 

En revanche après l'avoir testé un peu plus, il s'avère qu'il ne gère pas les blocs dynamiques et surtout qu'il ne vérifie pas si l'entité sélectionnée est un bloc.

J'aurais un peu plus detemps pour regarder demain matin.

 

------------------------------------------------------------------------------------------

 

Maintenant si tu le permets, je peux apporter une correction à ta version.

 

Quand tu écris :

 

(setq nouveaunom (getstring "\nIndiquez le nouveau nom :"))

;VERIFICATION DU NOUVEAU NOM

(setq js (ssget "X" '((0 . "INSERT"))))
(sslength js)
(setq x 0)
(while (/= x (sslength js))
(setq nom_ent (ssname js x))
(setq ent (entget nom_ent))
(setq name (cdr (assoc '2 ent)))
(if
(= name nouveaunom)
(progn
(while
(= name nouveaunom)
(alert "Ce nom de bloc existe déjà")
(setq nouveaunom (getstring "\nIndiquez le nouveau nom :")))))
(setq x (+ x 1))
)

 

Tu ne vérifies que les blocs insérés dans le dessin, et non tous les blocs du dessin.

Pour être certain que ton nouveau nom n'est pas déjà utilisé par un bloc, il faut aller vérifier dans la table des blocs, ce qui revient à écrire la boucle dont je parlais plus haut:

 

(while (not nouveaunom)
(setq nouveaunom (getstring "\nIndiquez le nouveau nom :"))
(if (tblsearch "block" nouveaunom)
(progn
(alert "Ce nom de bloc existe déjà")
(setq bnewname nil))))

 

Voilà qui simplifie et complète ton code. Tu peux remplacer ton extrait par le mien, j'ai conservé tes variables.

 

A Présent ton code est opérationnel et plus efficace que le mien.

 

 

----------------------------------------------------------------------------------------------

 

Edit : Merci Gile, pour ma part le vlisp n'est pas ma langue natale, j'essaie de m'y mettre mais je ne comprends jamais d'où sortent des combinaisons comme celle que tu as donné qui enchaine vla-name, vla-item,...

J'essaierais de comprendre demain.

 

[Edité le 31/1/2008 par vinz34]

[(gile)]

mais je ne comprends jamais d'où sortent des combinaisons comme celle que tu as donné qui enchaine vla-name, vla-item,...

 

(vla-put-Name
 (vla-item
   (vla-get-Blocks
     (vla-get-ActiveDocument
(vlax-get-acad-object
)
     )
   )
   o
 )
 n
) 

 

est une imbrcation de fonction pour éviter de faire trop de (setq ...), j'aurais pu écrire de manière plus explicite :

 

(setq AutoCAD (vlax-get-acad-object)) ; pointeur vers l'application AutoCAD
(setq acdoc (vla-get-ActiveDocument AutoCAD)) ; pointeur vers le document actif
(setq blocks (vla-get-Blocks acdoc)) ; collection des blocs du dessin courant
(setq def (vla-item blocks o)) ; définition du bloc (vla-object)
(vla-put-Name def n) ; changement de la propriété "Name"

[Arcasdk]

Navré d'avoir parlé si vite.... Je suis confus....

 

Vous savez ce que c'est l'euphorie de la victoire... Ca fesait quand même pas loin de cinq heures que je bossé la dessus :o

 

Enfin bon, pas besoin de récompense y avait rien de terrible..(Mais quand même ;))

 

Merci vinz de t'être permis d'optimiser mes lignes de code, celà me permettra d'étendre mon vocabulaire et ma façon de l'écrire.

 

En revanche tu as laissé dans le code la variable "bnewname " Je dois la laisser ou la changer...voir la delete?

 

 (while (not nouveaunom)
(setq nouveaunom (getstring "\nIndiquez le nouveau nom :"))
(if (tblsearch "block" nouveaunom)
(progn
(alert "Ce nom de bloc existe déjà")
(setq  [surligneur]bnewname [/surligneur]  nil))))

[vinz34]

Salut,

 

 

En revanche tu as laissé dans le code la variable "bnewname " Je dois la laisser ou la changer...voir la delete?

 

Excuse moi je commencais à fatiguer hier soir, il faut la remplacer par :

 

(setq nouveaunom nil))))

 

Merci Gile je comprends mieux.

 

[Edité le 1/2/2008 par vinz34]

[Arcasdk]

:casstet: Ben à part les parenthèse c'est la même chose......:casstet:

 

ps: C'est normal que tu arrives à poster à 12h05 alors qu'il n'est même pas 11h45....:casstet:

 

ouhhh là faut que j'arrête le thé

 

[Edité le 4/2/2008 par Arcasdk]

[vinz34]

 

 

 

Désolé, c'est corrigé

[Patrick_35]

Salut

 

Je viens de remarquer une erreur ;)

 

(setq [surligneur]AutoCAD[/surligneur] (vlax-get-acad-object)) ; pointeur vers l'application AutoCAD
(setq acdoc  (vla-get-ActiveDocument [surligneur]acad[/surligneur])) ; pointeur vers le document actif
(setq blocks (vla-get-Blocks acdoc)) ; collection des blocs du dessin courant
(setq def (vla-item blocks o)) ; définition du bloc (vla-object)
(vla-put-Name def n) ; changement de la propriété "Name"

 

@+

[Arcasdk]

Eh ben, après tout ce temps....

 

Comment se fait il que tu sois tombé dessus????

 

Bravo pour la correction en tout cas!!

[Patrick_35]

J'ai remarqué que tu faisais le grand nettoyage de printemps ;)

 

Le sujet était indiqué comme résolu et le titre m'a donné envie d'y jeter un oeil.

 

@+

[Arcasdk]

et oui j'essaie de tenir tout ça au propre..... ;)