Edit_bloc version 3

[(gile)]

Comme la demande a été exprimée quelques fois de mettre tous les composants de blocs en couleur DuCalque, j'ai ajouté cette possibilité dans Edit_bloc.

La nouvelle version propose donc, pour la couleur, le type de ligne, l'épaisseur de ligne et le style de tracé (STB uniquement), le choix entre DuBloc et DuCalque.

 

Je poste ici les codes et attends quelques temps afin que chacun puisse le tester avant de demander à notre cher Patrick de bien vouloir remplacer le précédent par celui-ci dans les Téléchargements proposés par les membres.

 

http://xs113.xs.to/xs113/07134/Edit_bloc.png

 

Le code DCL à enregistrer sous Edit_bloc_3.0.dcl dans un dossier cu chemin de recherche des fichiers de support.

 

// Boite de dialogue du LISP EDIT_BLOC version 3.0
edit_bloc_3: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;
   }
   spacer;
   :popup_list{
     label="Unités ";
     key="unt";
     edit_width=16;
   }
   spacer;
   :toggle{
     label="Calque 0";
     key="lay";
     fixed_width=true;
     allow_accept=true;
   }
   spacer;
   :row{
     :column{
       :toggle{
         label="Couleur";
         key="col";
         fixed_width=true;
         allow_accept=true;
       }
       :toggle{
         label="Type de ligne";
         key="tl";
         fixed_width=true;
         allow_accept=true;
       } 
       :toggle{
         label="Epaisseur de ligne";
         key="el";
         fixed_width=true;
         allow_accept=true;
       } 
       :toggle{
         label="Style de tracé";
         key="plt";
         fixed_width=true;
         allow_accept=true;
       }
     }
     :column{
       :radio_row{
         key="col_r";
         :radio_button{
           label="DuBloc";
           key="col_db";
           value="1";
         }
         :radio_button{
           label="DuCalque";
           key="col_dc";
         }
       }
       :radio_row{
         key="tl_r";
         :radio_button{
           label="DuBloc";
           key="tl_db";
           value="1";
         }
         :radio_button{
           label="DuCalque";
           key="tl_dc";
         }
       }
       :radio_row{
         key="el_r";
         :radio_button{
           label="DuBloc";
           key="el_db";
           value="1";
         }
         :radio_button{
           label="DuCalque";
           key="el_dc";
         }
       }
       :radio_row{
         key="plt_r";
         :radio_button{
           label="DuBloc";
           key="plt_db";
           value="1";
         }
         :radio_button{
           label="DuCalque";
           key="plt_dc";
         }
       }
     }
   }
 }
 ok_cancel;
}

// Boite de dialogue Echelle des blocs dynamiques
alert_bloc:dialog{
 label="Échelle des blocs dynamiques";
 :paragraph{
   :text_part{
     value="Le changement d'échelle n'affecte pas";
   }
   :text_part{
     value="les paramètres des blocs dynamiques.";
   }
 }
 spacer;
 :boxed_column{
   label="Modifier l'échelle du bloc";
   :text{ 
     key="txt";
   }
   :radio_row{
     :radio_button{
       label="Oui";
       mnemonic="O";
       key="mod";
     }
     :radio_button{
       label="Non";
       mnemonic="N";
       key="anl";
       value="1";
     }
   }
 }
 ok_only;
} 

 

Le LISP, taper edit_bloc pour lancer la commande.

 

;;; Edit_bloc - Gilles Chanteau - version 3.0 - 29/03/07
;;;
;;; Redéfinit les blocs après modification des propriétés de leurs composants.
;;;
;;; Les modification affectent :
;;; - soit tous les blocs de la collection (insérés ou non)
;;; - soit tous les blocs insérés
;;; - soit une sélection de blocs faite dans le dessin.
;;;
;;; Il est possible de :
;;; - modifier l'échelle globale
;;; - changer l'unité d'insertion (versions postérieures à 2005)
;;; - mettre les objets composant les blocs sur le calque 0
;;; - changer la couleur, le type de ligne, l'épaisseur de ligne et le
;;;   style de tracé (STB uniquement) des composants en DuBloc ou DuCalque.
;;;
;;; Les blocs composant les blocs imbriqués sont traités.
;;; Les blocs insérés dans le dessin sont mis à jour en fonction
;;; des modifications effectuées.
;;;
;;; Les paramètres et propriétés des blocs dynamiques n'étant pas pris
;;; en compte par les changements d'échelle, une boite de dialogue demande
;;; confirmation ou infirmation pour les changements d'échelle du bloc.

(vl-load-com)

(defun c:edit_bloc (/
	       ;; Fonctions
	       e_b_err	edit_prop	  scl_upd  att_upd
	       sub_upd	edit_bl
	       ;; Variables
	       AcDoc	dcl_id	 loop	  u_lst	   lay
	       col	col_n	 tl	  tl_n	   el
	       el_n	plt	 plt_n	  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)
 )

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

 (defun alert_bloc (name / dcl_id)
   (setq dcl_id (load_dialog "Edit_bloc_3.0.dcl"))
   (if	(not (new_dialog "alert_bloc" dcl_id))
     (exit)
   )
   (set_tile "txt" name)
   (action_tile
     "mod"
     (strcat
"(if (= \"1\" $value)"
"(setq e_scl T)"
"(setq e_scl nil))"
     )
   )
   (action_tile
     "anl"
     (strcat
"(if (= \"1\" $value)"
"(setq e_scl nil)"
"(setq e_scl T))"
     )
   )
   (action_tile "accept" "(done_dialog)")
   (start_dialog)
   (unload_dialog dcl_id)
 )

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

 ;; Modification des propriétés des entités composant le bloc

 (defun edit_prop (ent)
   (if	(= lay "Oui")
     (vla-put-Layer ent "0")
   )
   (if	col
     (if (= 1 col_n)
(vla-put-Color ent acByBlock)
(vla-put-Color ent acByLayer)
     )
   )
   (if	tl
     (if (= 1 tl_n)
(vla-put-LineType ent "ByBlock")
(vla-put-LineType ent "ByLayer")
     )
   )
   (if	el
     (if (= 1 el_n)
(vla-put-LineWeight ent acLnWtByBlock)
(vla-put-LineWeight ent acLnWtByLayer)
     )
   )
   (if	plt
     (if (= 1 plt_n)
(vla-put-PlotStyleName ent "ByBlock")
(vla-put-PlotStyleName ent "ByLayer")
     )
   )
 )

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

 ;; Mise à jour des attributs

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


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

 ;; Mise à jour de l'échelle en cas de changement d'unité

 (defun scl_upd (obj)
   (if	(and unt
     (/= unt 0)
     (/= i_unt unt)
     (/= i_unt 0)
)
     (vla-ScaleEntity
obj
(vla-get-InsertionPoint obj)
(cvunit	1
	(nth unt u_lst)
	(nth i_unt u_lst)
)
     )
   )
 )

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

 ;; Mise à jour des blocs composant les blocs imbriqués

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

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

 ;; Modification des blocs

 (defun edit_bl (/ n obj lst n_lst name bloc e_scl i_unt nb)
   ;; Dévérouillage de tous les calques
   (vlax-for clq (vla-get-Layers AcDoc)
     (if (= :vlax-true
     (vla-get-lock clq)
  )
(progn
  (vla-put-lock clq :vlax-false)
  (setq clq_lst (cons clq clq_lst))
)
     )
   )
   ;; Création de la liste des blocs à modifier
   (if	ss
     ;; Si "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 (vlax-property-available-p obj 'EffectiveName)
    (setq name (vla-get-EffectiveName obj))
    (setq name (vla-get-Name obj))
  )
  (if
    (and
      (not (member name lst))
      (= :vlax-false
	 (vla-get-isXref
	   (vla-item (vla-get-Blocks AcDoc) name)
	 )
      )
    )
     (setq lst (cons name lst))
  )
)
;; Ajout des blocs composant les 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))
  (vlax-for ent	bloc
    (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))
)
     )
     ;; Si "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))
 (if (and (		  (= (vla-get-IsDynamicBlock bloc) :vlax-true)
	  (/= fact 1.0)
     )
   (progn
     (setq e_scl nil)
     (alert_bloc name)
   )
   (setq e_scl T)
 )
 (vlax-for ent bloc
   (if (/= (vla-get-ObjectName ent) "AcDbZombieEntity")
     (if (/= (vla-get-ObjectName ent) "AcDbBlockReference")
       (progn
	 (if (and (/= fact 1.0) e_scl) ;_ Echelle
	   (vla-ScaleEntity ent (vla-get-origin bloc) fact)
	 )
	 (edit_prop ent)
       )
       (sub_upd ent bloc)
     )
   )
 )
 (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)
     (scl_upd obj)
   )
 )
      )
     lst
   )
   ;; Mise à jour des blocs composant les blocs imbriqués insérés non sélectionnés
   (setq ss
   (ssget "_X"
	  (cons	'(0 . "INSERT")
		(mapcar '(lambda (x) (cons 2 (strcat "~" x))) lst)
	  )
   )
   )
   (if	ss
     (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)
)
(vlax-for ent bloc
  (if (and (= (vla-get-ObjectName ent) "AcDbBlockReference")
	   (member (vla-get-Name ent) lst)
      )
    (progn
      (sub_upd ent bloc)
      (scl_upd ent)
    )
  )
)
     )
   )
   ;; Revérouillage des calques vérouillés
   (if	clq_lst
     (mapcar '(lambda (x)
	 (vla-put-lock x :vlax-true)
       )
      clq_lst
     )
   )
   (vla-Regen AcDoc acAllViewports)
 )

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

 ;; Boite de dialogue

 (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_3.0.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_3" 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	(zerop (getvar "PSTYLEMODE"))
     (mode_tile "plt" 0)
     (progn
(mode_tile "plt" 1)
(mode_tile "plt_db" 1)
(mode_tile "plt_dc" 1)
(setq plt nil)
     )
   )
   (if	fact
     (set_tile "fact" (rtos fact))
     (setq fact 1.0)
   )
   (if	(= lay "Oui")
     (set_tile "lay" "1")
   )
   (foreach prop '("col" "tl" "el" "plt")
     (if (eval (read prop))
(progn
  (set_tile prop "1")
  (mode_tile (strcat prop "_db") 0)
  (mode_tile (strcat prop "_dc") 0)
  (if (= (eval (read prop)) "db")
    (set_tile (strcat prop "_db") "1")
    (set_tile (strcat prop "_dc") "1")
  )
)
(progn
  (mode_tile (strcat prop "_db") 1)
  (mode_tile (strcat prop "_dc") 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)"
"(progn"
"(setq col T)"
"(setq col_n (atoi (get_tile \"col_db\")))"
"(mode_tile \"col_r\" 0))"
"(progn (setq col nil)"
"(mode_tile \"col_r\" 1)))"
     )
   )
   (action_tile
     "tl"
     (strcat
"(if (= \"1\" $value)"
"(progn"
"(setq tl T)"
"(setq tl_n (atoi (get_tile \"tl_db\")))"
"(mode_tile \"tl_r\" 0))"
"(progn (setq tl nil)"
"(mode_tile \"tl_r\" 1)))"
     )
   )
   (action_tile
     "el"
     (strcat
"(if (= \"1\" $value)"
"(progn"
"(setq el T)"
"(setq el_n (atoi (get_tile \"el_db\")))"
"(mode_tile \"el_r\" 0))"
"(progn (setq el nil)"
"(mode_tile \"el_r\" 1)))"
     )
   )
   (action_tile
     "plt"
     (strcat
"(if (= \"1\" $value)"
"(progn"
"(setq plt T)"
"(setq plt_n (atoi (get_tile \"plt_db\")))"
"(mode_tile \"plt_r\" 0))"
"(progn (setq plt nil)"
"(mode_tile \"plt_r\" 1))"
     )
   )
   (action_tile
     "col_r"
     "(setq col_n (atoi (get_tile \"col_db\")))"
   )
   (action_tile
     "tl_r"
     "(setq tl_n (atoi (get_tile \"tl_db\")))"
   )
   (action_tile
     "el_r"
     "(setq el_n (atoi (get_tile \"el_db\")))"
   )
   (action_tile
     "plt_r"
     "(setq plt_n (atoi (get_tile \"plt_db\")))"
   )
   (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)
) 

[Joffoon]

Bonjour (gile),

 

C'est un outil interessant que tu proposes mais je n'arrive pas à le faire fonctionner... :(

 

Autocad me dit "Erreur dans le fichier de boîte de dialogue, suivi du chemin ou se trouve le fichier support avec, ligne1:caractère incorrect. Symbole "un carré", suivi du meme message, avec Erreur syntaxe et à la place du carré c'est un "à".

 

Pourtant j'ai copier coller dans word puis changer l'extension en .dcl, de meme pour le lisp...

 

Je ne sais pas ce qui cloche, peut-être une mauvaise manip. de ma part mais je l'ai fait plusieurs fois sans succer..

 

Merci,

 

Joff

[Bred]

ça fonctionne chez moi....

je met le .dcl dans un répertoire déclaré en support.

[(gile)]

Joffoon,

 

Pourtant j'ai copier coller dans word

C'est peut être Word qui ajoute des caractères de mise en page qui ne sont en suite pas reconnus.

Pour les codes, il vaut mieux utiliser des éditeurs de texte plus simple le bloc note marche très bien.

[Joffoon]

Bred : C'est pourtant ce que je fais mais c'est sans résultat :mad: ... :(

 

(gile) : Je vais essayer tout de suite en espérant que sa marche..

 

 

Merci..

 

 

 

[Edité le 3/4/2007 par Joffoon]

[Joffoon]

Cool :thumbup: , C'est bon sa fonctionne..

 

Merci beaucoup, maintenant j'utiliserai le bloc note..

 

A+, et bonne continuation c'est un outil génial..

 

Joff

[philsogood]

hello (gile)

je me permet de te relancer sur ton lisp on ne peut plus fameux edit_bloc

comment faire en sorte que tous les blocs se trouvent systématiquement sur 0 et sur dubloc. je passe mon temps à cocher tous les paramètres sur dubloc quand j'utilise ton lisp...

merci

Phil

 

[Edité le 10/2/2011 par philsogood]

[Bortch59]

Bonjour (gile),

 

aprés test rapide, je me demandais quelle était la différence entre "toute la collection" et "tous les blocs insérés"?

 

Merci.

[Fraid]

Bonjour,

 

Si tu n'as pas purger ton plan, tu peux avoir des blocs dans ta collection qui ne sont pas insérer dans ton dessin. (notamment après en avoir supprimé manuellement).