Classement

Hello ET voici le Lisp MAGIQUE ! ... J ai modifie le Lisp RB_Zero de P35 ... Encore MERCI a notre regrette Patrick_35 !! ATTENTION : cette routine remet EN PLUS TOUS les objets des blocs selectionnes sur le calque ZERO ! SI cela t embete, SVP tu commentes la ligne 109 ... LA SANTE (Stay Safe), Bye, lecrabe "triste" Automne 2020, la retraite ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; Routine : RB_Zero ;; ;; Vers US/English Minimum par Patrice B ;; ;; Micro-Modif pour grandss ;; ;; ---- Version qui met TOUT sur le calque ZERO !! ---- ;; ---- ET ;; ---- Version qui met la Proprietes LineWidth = 0.00 mm ---- ;; ---- ET ne touche pas aux 2 autres proprietes : Couleur / Type de Ligne ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Version SPECIALE de "RB/RB_Calque" avec RETOUR sur le Calque ZERO ;;; ;;; ET on "touche" aux Couleurs, Types de Lignes, Epaisseurs ---> <DuBloc> ;;; ;;; MLINE et Attribut --> <DuBloc> ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Remise en Mode <DuBloc> et sur le Calque ZERO de TOUS les Blocs/Symboles (insert) ;;; ou bien d'une Selection classique de Blocs/Symboles ;;; ;;; Mise en EVIDENCE des 4 "Forcages" : ;; Calque 0 , Couleur , Type de Ligne , Epaisseur ;;; pour commentaire EVENTUEL si on desire ne FORCER que 1/2/3 propriete(s) ... ;;; ;;;================================================================= ;;; ;;; RB.LSP v2.02 ;;; Refait les Blocs de la Couleur <DuBloc> (+ Type de Ligne + Epaisseur ) ;;; et "retour" sur le Calque 0 de TOUTES les entites ;;; Copyright (C) Patrick_35 ;;; ;;;================================================================= ;; (defun c:RB( / *errrb* bl ent js lst nombl doc s sel) (defun c:RB_Zero ( / *errrb* bl ent js lst nombl doc s sel) (defun *errrb* (msg) (or (member (strcase msg) '("FUNCTION CANCELLED" ""QUIT / EXIT ABORT"" "FONCTION ANNULEE" "QUITTER / SORTIR ABANDON")) (princ (strcat "\nErreur : " msg)) ) (vla-endundomark doc) (setq *error* s) (princ) ) (defun nombl(bl) (if (vlax-property-available-p bl 'effectivename) (vla-get-effectivename bl) (vla-get-name bl) ) ) (vl-load-com) (setq doc (vla-get-activedocument (vlax-get-acad-object))) (vla-startundomark doc) (setq s *error* *error* *errrb* ) ;; (princ "\nSelectionnez les blocs <Tout les blocs> : ") (princ "\nSelect Blocks <Tout/all Blocks> : ") (if (setq sel (ssget (list (cons 0 "insert")))) (progn (vlax-for bl (setq sel (vla-get-activeselectionset doc)) (or (member (setq nom (nombl bl)) lst) (setq lst (cons nom lst)) ) ) ; (foreach nom lst ; (if js ; (setq js (strcat js "," nom)) ; (setq js nom) ; ) ; ) (vla-delete sel) ) (setq js "*") ) ; ---------------------------------------------------------------- ; Modifications dans la table des blocs ; ---------------------------------------------------------------- (vlax-for bl (vla-get-blocks doc) (and (eq (vla-get-islayout bl) :vlax-false) (or (eq js "*") (member (vla-get-name bl) lst) ) (vlax-for ent bl ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;--- Forcer sur calque / Layer 0 (vla-put-layer ent "0") ;;;--- Forcer la couleur sur Dubloc / ByBlock = 0 ;; (vla-put-color ent 0 ) ;; (vla-put-color ent 256 ) ;; ByLayer ;;;--- Forcer le type de ligne sur Dubloc / ByBlock = ByBlock ;; (vla-put-linetype ent "ByBlock" ) ;; (vla-put-linetype ent "ByLayer" ) ;;;--- Forcer l'epaisseur de ligne sur Dubloc / ByBlock = -2 ;; (vla-put-lineweight ent -2) ;; (vla-put-lineweight ent -1) ;; ByLayer (vla-put-lineweight ent 0 ) ;; = 0.00 mm ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ) ) ) ;;; ------ Avec un REGEN ------ (vla-regen doc acAllViewports) (vla-endundomark doc) (setq *error* s) (princ) ) ;; (setq nom_lisp "RB") (setq nom_lisp "RB_Zero") (if (/= app nil) (if (= (strcase (substr app (1+ (- (strlen app) (strlen nom_lisp))) (strlen nom_lisp))) nom_lisp) (princ (strcat "..." nom_lisp " loaded/charge ")) (princ (strcat "\n" nom_lisp ".LSP Loaded/Charge... " nom_lisp " to run/pour l executer. "))) (princ (strcat "\n" nom_lisp ".LSP Loaded/Charge... " nom_lisp " to run/pour l executer. "))) (setq nom_lisp nil) (princ)