Modifier des blocs

(gile) · le 8 mai 2006

Une petite boite de dialogue pour modifier/redéfinir des blocs.

http://img245.imageshack.us/img245/1112/bloc8vm.png

On peut choisir entre modifier toue la collection de blocs du dessin courant, tous les blocs insérés dans le dessins (sur des calques dévérouillés) ou de sélectionner les blocs à l'écran.

On peut modifier l'échelle globale des blocs (quand on récupère des blocs créés dans une unité différente de celle avec laquelle on travaille) et mettre toutes les entités composants les blocs sur le calque 0, à la couleur DuBloc, dans le style de ligne Dubloc.

Toutes les critiques et suggestions d'amélioration sont les bienvenues.

* VERSION 1.9 * (25/05/06)

http://img408.imageshack.us/img408/3360/bloc39tg.png

Le fichier dcl à enregistrer sous Edit_bloc.dcl dans un dossier du chemin de recherche des fichiers de support :

edit_bloc:dialog{
 label="Redéfinition de blocs";
 :boxed_row{
   label="Choix des blocs";
   :radio_column{
     :radio_button{
       label="Toute la collection";
       key="tbl";
       fixed_width=true;
       allow_accept=true;
     }
     :radio_button{
       label="Tous les blocs insérés";
       key="all";
       fixed_width=true;
       allow_accept=true;
     }
     :radio_button{
       label="Sélection";
       key="sel";
       value="1";
       fixed_width=true;
     }
   }
   :button{
     label="       key="ss";
     fixed_width=true;
     alignment=bottom;
     allow_accept=true;
   }
 }
 :boxed_column{
   label="Propriétés à modifier";
   :edit_box{
     label= "Échelle globale";
     key="fact";
     edit_width=8;
     value="1";
     allow_accept=true;
   }
   :popup_list{
     label="Unités ";
     key="unt";
     edit_width=16;
   }
   spacer;
   :toggle{
     label="Calque 0";
     key="lay";
     fixed_width=true;
     allow_accept=true;
   }
   :toggle{
     label="Couleur DuBloc";
     key="col";
     fixed_width=true;
     allow_accept=true;
   }
   :toggle{
     label="Type de ligne DuBloc";
     key="tl";
     fixed_width=true;
     allow_accept=true;
   }
   :toggle{
     label="Épaisseur de ligne DuBloc";
     key="el";
     fixed_width=true;
     allow_accept=true;
   }
 }
 ok_cancel;
}

Le LISP :

;;; Edit_bloc - Gilles Chanteau - version 1.9 - 25/05/06
;;;
;;; Redéfinit les blocs après modification des propriétés des entités constituant
;;; ces blocs, de l'échelle globale et de l'unité d'insertion (version > 2005).

(vl-load-com)

(defun c:edit_bloc (/
	    ;; Fonctions
	    e_b_err  edit_prop	       att_upd	sub_upd
	    edit_bl
	    ;; Variables
	    AcDoc    dcl_id   loop     u_lst	lay
	    col	     tl	      el       fact	unt
	    ss
	   )

;;;************************************************************************ ;;;

 ;; Redéfinition de *error*

 (defun e_b_err (msg)
   (if	(or
  (= msg "Fonction annulée")
  (= msg "quitter / sortir abandon")
)
     (princ)
     (princ (strcat "\nErreur: " msg))
   )
   (vla-endundomark
     (vla-get-ActiveDocument (vlax-get-acad-object))
   )
   (setq *error* m:err
  m:err	nil
   )
   (princ)
 )

;;;************************************************************************ ;;;

 ;; Modification des propriétés des entités

 (defun edit_prop (e)
   (if	(= lay "Oui")
     (vla-put-Layer e "0")
   )
   (if	(= col "Oui")
     (vla-put-Color e acByBlock)
   )
   (if	(= tl "Oui")
     (vla-put-LineType e "ByBlock")
   )
   (if	(= el "Oui")
     (vla-put-LineWeight e acLnWtByBlock)
   )
 )

;;;************************************************************************ ;;;

 ;; Mise à jour des attributs

 (defun att_upd (obj)
   (if	(= :vlax-true (vla-get-HasAttributes obj))
     (progn
(if
  (listp (setq att_lst
		(vl-catch-all-apply
		  'vlax-safearray->list
		  (list	(vlax-variant-value
			  (vla-getAttributes obj)
			)
		  )
		)
	 )
  )
   (mapcar
     '(lambda (x)
	(if (/= fact 1.0)
	  (vla-ScaleEntity
	    x
	    (vla-get-InsertionPoint obj)
	    fact
	  )
	)
	(edit_prop x)
      )
     att_lst
   )
)
     )
   )
 )

;;;************************************************************************ ;;;

 ;; Mise à jour des blocs imbriqués

 (defun sub_upd (ob bl / org ins)
   (if	(/= fact 1.0)
     (progn
(setq org (vlax-get bl 'origin)
      ins (vlax-get (vla-item bl n) 'InsertionPoint)
)
(vla-put-InsertionPoint
  ob
  (vlax-3d-point
    (mapcar '+
	    org
	    (mapcar '(lambda (x)
		       (* x fact)
		     )
		    (mapcar '- ins org)
	    )
    )
  )
)
     )
   )
   (edit_prop ob)
   (att_upd ob)
 )

;;;************************************************************************ ;;;

 ;; Modification des blocs

 (defun edit_bl (/ n obj lst n_lst name bloc i_unt nb)
   ;; Liste des blocs à modifier
   (if	ss
     ;; Sélection ou tous les blocs insérés
     (progn
(repeat	(setq n (sslength ss))
  (setq
    obj	(vlax-ename->vla-object (ssname ss (setq n (1- n))))
  )
  (if
    (and
      (not (member (vla-get-name obj) lst))
      (= :vlax-false
	 (vla-get-isXref
	   (vla-item (vla-get-Blocks AcDoc) (vla-get-Name obj))
	 )
      )
    )
     (setq lst
	    (cons
	      (vla-get-name obj)
	      lst
	    )
     )
  )
)
;; Ajout des blocs imbriqués à la liste
(setq n_lst 0)
(while (setq name (nth n_lst lst))
  (setq bloc (vla-item (vla-get-blocks acDoc) name))
  (repeat (setq n (vla-get-count bloc))
    (setq ent (vla-item bloc (setq n (1- n))))
    (if	(and (= (vla-get-ObjectName ent) "AcDbBlockReference")
	     (not (member (vla-get-name ent) lst))
	)
      (setq
	lst (reverse (cons (vla-get-Name ent) (reverse lst)))
      )
    )
  )
  (setq n_lst (1+ n_lst))
)
     )
     ;; Toute la collection
     (vlax-for	bl (vla-get-blocks AcDoc)
(if (and (= :vlax-false (vla-get-isLayout bl))
	 (= :vlax-false (vla-get-isXref bl))
    )
  (setq lst (cons (vla-get-name bl) lst))
)
     )
   )
   ;; Modification des blocs
   (mapcar
     '(lambda (name)
 (setq bloc (vla-item (vla-get-blocks AcDoc) name))
 (repeat (setq n (vla-get-count bloc))
   (setq ent (vla-item bloc (setq n (1- n))))
   (if (/= (vla-get-ObjectName ent) "AcDbBlockReference")
     (progn
       (if (/= fact 1.0) ;_ Echelle
	 (vla-ScaleEntity ent (vla-get-origin bloc) fact)
       )
       (edit_prop ent)
     )
     (sub_upd ent bloc)
   )
 )
 ;; Unités
 (if (	   (if (/= (setq i_unt (vla-get-units bloc)) unt)
     (vla-put-Units bloc unt)
   )
 )
 ;; Mise à jour des blocs insérés (attributs et unités)
 (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 name))))
 (if ss
   (repeat (setq n (sslength ss))
     (setq obj (vlax-ename->vla-object
		 (ssname ss (setq n (1- n)))
	       )
     )
     (att_upd obj)
     (if (and unt
	      (/= i_unt unt)
	      (/= i_unt 0)
	 )
       (vla-ScaleEntity
	 obj
	 (vla-get-InsertionPoint obj)
	 (cvunit 1
		 (nth unt u_lst)
		 (nth i_unt u_lst)
	 )
       )
     )
   )
 )
      )
     lst
   )
   ;; Mise à jour des blocs imbriqués dans les blocs insérés
   (setq ss (ssget "_X" '((0 . "INSERT"))))
   (repeat (setq nb (sslength ss))
     (setq obj	 (vlax-ename->vla-object (ssname ss (setq nb (1- nb))))
    name (vla-get-Name obj)
    bloc (vla-item (vla-get-blocks AcDoc) name)
     )
     (if (not (member name lst))
(repeat	(setq n (vla-get-count bloc))
  (setq ent (vla-item bloc (setq n (1- n))))
  (if (and (= (vla-get-ObjectName ent) "AcDbBlockReference")
	   (member (vla-get-Name ent) lst)
      )
    (progn
      (edit_prop ent)
      (sub_upd ent bloc)
    )
  )
)
     )
   )
   (vla-Regen AcDoc acAllViewports)
 )

;;;************************************************************************ ;;;

 (setq	AcDoc	(vla-get-ActiveDocument (vlax-get-acad-object))
m:err	*error*
*error*	e_b_err
 )
 (vla-StartUndoMark AcDoc)
 (setq	dcl_id (load_dialog "Edit_bloc.dcl")
loop   2
u_lst  (list "Sans unités"     "Pouces"
	     "Pieds"	       "Miles"
	     "Millimètres"     "Centimètres"
	     "Mètres"	       "Kilomètres"
	     "Micropouces"     "Milles"
	     "Yards"	       "Angströms"
	     "Nanomètres"      "Microns"
	     "Décimètres"      "Décamètres"
	     "Hectomètres"     "Gigamètres"
	     "Unités astronomiques"
	     "Parsecs"
	    )
 )
 (while (    (if	(not (new_dialog "edit_bloc" dcl_id))
     (exit)
   )
   (start_list "unt")
   (mapcar 'add_list u_lst)
   (end_list)
   (cond
     ((       (mode_tile "unt" 0)
      (if (not unt)
 (setq unt (getvar "INSUNITS"))
      )
     )
     (T
      (mode_tile "unt" 1)
      (setq unt nil)
     )

   )
   (if	unt
     (set_tile "unt" (itoa unt))
     (set_tile "unt" (itoa (getvar "INSUNITS")))
   )
   (if	(not ss)
     (mode_tile "accept" 1)
   )
   (if	fact
     (set_tile "fact" (rtos fact))
     (setq fact 1.0)
   )
   (if	(= lay "Oui")
     (set_tile "lay" "1")
   )
   (if	(= col "Oui")
     (set_tile "col" "1")
   )
   (if	(= tl "Oui")
     (set_tile "tl" "1")
   )
   (if	(= el "Oui")
     (set_tile "el" "1")
   )
   (action_tile
     "tbl"
     (strcat
"(if (= \"1\" $value)"
"(progn (setq ss nil)"
"(mode_tile \"ss\" 1)"
"(mode_tile \"accept\" 0)))"
     )
   )
   (action_tile
     "all"
     (strcat
"(if (= \"1\" $value)"
"(progn"
"(setq ss (ssget \"_X\" '((0 . \"INSERT\"))))"
"(mode_tile \"ss\" 1)"
"(mode_tile \"accept\" 0)))"
      )
   )
   (action_tile
     "sel"
     (strcat
"(if (= \"1\" $value)"
"(progn (mode_tile \"ss\" 0)"
"(mode_tile \"ss\" 2)"
"(mode_tile \"accept\" 1))"
"(mode_tile \"accept\" 0))"
      )
   )
   (action_tile
     "ss"
     "(progn (done_dialog 3) (mode_tile \"accept\" 0))"
   )
   (action_tile
     "fact"
     (strcat
"(if (	"(setq fact (atof $value))"
"(progn (alert \"Entrée non valide\")"
"(mode_tile \"fact\" 2)))"
     )
   )
   (action_tile "unt" "(setq unt (atoi $value))")
   (action_tile
     "lay"
     (strcat
"(if (= \"1\" $value)"
"(setq lay \"Oui\")"
"(setq lay \"Non\"))"
     )
   )
   (action_tile
     "col"
     (strcat
"(if (= \"1\" $value)"
"(setq col \"Oui\")"
"(setq col \"Non\"))"
     )
   )
   (action_tile
     "tl"
     (strcat
"(if (= \"1\" $value)"
"(setq tl \"Oui\")"
"(setq tl \"Non\"))"
     )
   )
   (action_tile
     "el"
     (strcat
"(if (= \"1\" $value)"
"(setq el \"Oui\")"
"(setq el \"Non\"))"
     )
   )
   (action_tile "accept" "(done_dialog 1)")
   (setq loop (start_dialog))
   (cond
     ((= loop 3)
      (setq ss (ssget '((0 . "INSERT"))))
     )
     ((= loop 1)
      (edit_bl)
     )
   )
 )
 (unload_dialog dcl_id)
 (vla-endundomark AcDoc)
 (setq	*error*	m:err
m:err nil
 )
 (princ)
)

[Edité le 8/5/2006 par (gile)][Edité le 10/5/2006 par (gile)][Edité le 11/5/2006 par (gile)][Edité le 11/5/2006 par (gile)][Edité le 11/5/2006 par (gile)][Edité le 15/5/2006 par (gile)][Edité le 16/5/2006 par (gile)][Edité le 18/5/2006 par (gile)][Edité le 23/5/2006 par (gile)][Edité le 24/5/2006 par (gile)][Edité le 25/5/2006 par (gile)][Edité le 25/5/2006 par (gile)]

[Edité le 26/5/2006 par (gile)]

Patrick_35 · le 8 mai 2006

Salut (gile)

Ce que tu viens de faire est très bien et viendrait admirablement compléter le lisp rbloc dans ce sujet

ps : un entmod dans les tables des blocs fonctionne ;)

@+

(gile) · le 8 mai 2006

Merci Patrick_35,

ps : un entmod dans les tables des blocs fonctionne

J'avais commencé commme çà, mais comme pour la mise à l'échelle c'était en VisualLISP, j'ai préféré tout traiter de la même façon (et comme çà, j'apprends ...).

J'ai un peu modifié le LISP ci dessus.

Il y avait un petit dysfonctionnement avec la mise à l'échelle des attributs constants, le problème semble réparé.

La mise à l'échelle des blocs dynamiques, n'est pas encore tout à fait au point. Elle se fait, mais la section "personnalisé" de la fenêtre de propriétés ne suit pas, l'emplacement des paramètres non plus.

Tramber · le 9 mai 2006

Salut à tous, salut Gile,

je te conseille l'ajout de routine inspirée de NESTED sur cette page :

http://www.hyperpics.com/customization/autolisp/autolisp_downloads.htm

cela permettra une modification rapide plus en profondeur,...dans les sous-blocs, le cas échéant. Inutilie si tu choisis l'option "toute la collection",...mais bon.

lecrabe · le 9 mai 2006

Bonjour (gile) Oh Grand Maître de la programmation

J'ai testé ton progr sur AutoCAD 2004 et AutoCAD 2006 ...

( dans le SCG et aussi dans un SCU )

Ca me semble Nickel-Chrome-Vanadium-etc ... :) :D :cool:

Je te propose 1/2 améliorations :

Dans le DCL, ajout de la case à cocher "Epaisseur Ligne"

pour remettre en mode DUBLOC la propriété d'Epaisseur !

C'est important car beaucoup de gens ont "forcé" l'Epaisseur dans leurs blocs !!! :o

On peut envisager la même chose pour la propriété "Style de tracé" ...

Sinon il faut signaler que ce programme exige un AutoCAD ou MAP ou Autodesk Architectural Desktop (non testé)

version 2004 ou plus ... :P

Le Decapode admiratif mais "testeur / emmerdeur"

Patrick_35 · le 9 mai 2006

Et une autre amélioration.

Plutôt que cocher Echelle, on peut avoir en clair directement la valeur 1. On la change ou pas. ca évite un clic

@+

Tramber · le 9 mai 2006

Oui, et puis juste un sucre dans mon café, STP.

(gile) · le 9 mai 2006

Merci à vous tous pour les tests et les suggestions, je vois tout çà plus en détail ce soir.

lecrabe · le 9 mai 2006

ReBonjour

Une autre suggestion pour utilisation "sans surprise" des blocs/symboles

dans AutoCAD 2006/2007 ...

Proposer éventuellement de mettre une UNITE spécifique sur la/les bloc(s) sélectionné(s)

ou TOUS :

- Sans Unité

- MM

- CM

- M

et je pense que ce sera bien suffisant ! :P

Pour Tramber, certains préfèrent le thé ... ;)

Le Decapode "pointilleux"

Patrick_35 · le 9 mai 2006

Oui, et puis juste un sucre dans mon café, STP.

et les croissants ????

@+

(gile) · le 9 mai 2006

J'ai un peu avancé ce soir :

- Une case pour l'épaisseur des lignes

- L'échelle en accès direct

- Le traitement des blocs imbriqués dans les blocs sélectionnés

- Une amélioration de la mise à jour des attributs des blocs insérés

Mais ni café, ni thé, ni croissant ;)

Je modifie les codes ci-dessus

http://img288.imageshack.us/img288/1492/bloc22hn.png

[Edité le 10/5/2006 par (gile)]

sergeluc · le 9 mai 2006

bonsoir ou bonjour Gile

Je viens de découvrir ton programme alors je vais oser te suggérer un supplément :

le traitement des blocs d'un repertoire quelconque en se servant d'un dessin vierge .

(d'une bibliothèque de blocs en quelque sorte ).

Ce n'est peut-etre pas l'objet de ta routine ,j'ai bricolé quelque-chose dans ce sens

à l'époque si ça t'intéresse.

à plus..............

lecrabe · le 10 mai 2006

Bonjour (gile)

You are a good guy :) :D :cool:

Mais SVP n'oublie pas ma petite demande sur l'Unité

ou Echelle d'Insertion du bloc: Sans Unite, MM, CM, M ;)

A propos, je désire l'option CHOUQUETTES !!! :P

Le Decapode "impressionné"

sergeluc · le 10 mai 2006

Bonjour Gile

je viens de trouver dans l'aide d'autocad 3 variables pour controler l'échelle d'insertion des blocs (elles servent aussi au DesignCenter)

INSUNITS (pour les unités)

INSUNITSDEFSOURCE

INSUNITSDEFTARGET

à plus.................

kallain · le 10 mai 2006

Alors là, chapeau bas Monsieur (gile) ;)

Cà marche même sur les blocs anonymes

BRAVO et MERCI :D :D

(gile) · le 10 mai 2006

Voilà la Version 1.2 avec la possibilité de spécifier une unité (Aucune, millimètres, centimètres, mètres). La valeur par défaut est celle de la variable INSUNITS (c'est celle qui est affichée à l'ouverture de la boite).

http://img141.imageshack.us/img141/483/bloc38fr.png

Je crois qu'il ne me reste plus qu'à honorer les requètes en boissons chaudes et viennoiseries, ce que je ferais très volontiers lors de rencontres moins virtuelles ;)

Merci encore à vous tous pour ces suggestions d'améliorations (çà permet d'apprendre énormément) et merci par avance pour vos remarques si vous notiez des dysfonctionnements.

PS : Lecrabe a écrit :

Sinon il faut signaler que ce programme exige un AutoCAD ou MAP ou Autodesk Architectural Desktop (non testé)
version 2004 ou plus ...

Est-ce parceque j'avais oublie (vl-load-com) dans la première version ?

PPS : Lecrabe a écrit (encore !) :

Une autre suggestion pour utilisation "sans surprise" des blocs/symboles
dans AutoCAD 2006/2007 ...

Est-ce que cela veut dire qu'il faut limiter l'accès à l'option "Unités" aux versions postérieures à 2005 ?

Dans ce cas il suffirait d'ajouter :

(if	(      (mode_tile "unt" 0)
     (mode_tile "unt" 1)
   )

après le (end_list) par exemple.

[Edité le 11/5/2006 par (gile)]

Tramber · le 10 mai 2006

Je crois qu'il ne me reste plus qu'à honorer les requètes en boissons chaudes et viennoiseries, ce que je ferais très volontiers lors de rencontres moins virtuelles ;)

Il y en a déjà eu quelques unes. Je connais personnellement une dizaine de memebres en chair et en os.

Mais je rêve d'une ou 2 journées de conférences et de petits cours organisé par nous en un lieu.

Dis-donc, à la lecture et sans l'essayer, je me demande si ton lisp traite les sous-sous-blocs, comme je le suggérais en évoquant la routine NESTED .?

(gile) · le 11 mai 2006

je me demande si ton lisp traite les sous-sous-blocs

Oui, les blocs imbriqués sont traités.

lecrabe · le 11 mai 2006

Bonjour Oh Suprème Lispeur / V-Lispeur

Ta routine me semble "parfaite", sachant qu'elle peut tourner sur un AutoCAD 2004 (ou plus), il n'y a rien à ajouter (A mon avis). Même avec un AutoCAD 2004, il peut être intéressant de changer l'Unité donc pour moi, c OK ! :) :D :cool:

Le Decapode "bouffeur / décortiqueur de viennoiseries"

sergeluc · le 11 mai 2006

Bonjour Gile

je viens d'essayer ton programme sur une version 2000 et j'ai ce massage d'erreur :

"Erreur: no function definition: VLA-PUT-UNITS"

sur une 2006 pas de problème .

[Edité le 11/5/2006 par sergeluc]

lecrabe · le 11 mai 2006

Bonjour Serge

Ce programme exige une version 2004 (ou supérieure) !

Le Decapode

(gile) · le 11 mai 2006

Ce programme exige une version 2004 (ou supérieure) !

Est-ce seulement la fonction (vla-get-Units ... ou y a t'il d'autres fonctions qui ne marchent pas avec les versions antérieures à 2004 (je n'ai que 2007 pour tester).

Je peux désactiver certaines fonctions ou faire une boite d'alerte en fonction des versions utilisées.

Tramber · le 11 mai 2006

UNITS ne marche pas sur 2004 !

(gile) · le 11 mai 2006

Merci Tramber,

Je modifie le LISP en conséquence (2004 c'est bien R16.0 ?)

Patrick_35 · le 11 mai 2006

(vla-get-units ...) ne fonctionne pas sur une 2000, il suffit pour que le prog puisse fonctionner sur toutes les versions de "griser" les unités pour les versions < 2004

@+

Connexion

Modifier des blocs

Messages recommandés

(gile)

Patrick_35

(gile)

Tramber

lecrabe

Patrick_35

Tramber

(gile)

lecrabe

Patrick_35

(gile)

sergeluc

lecrabe

sergeluc

kallain

(gile)

Tramber

(gile)

lecrabe

sergeluc

lecrabe

(gile)

Tramber

(gile)

Patrick_35

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante