LIsp pour epaisseur de ligne

[grandss]

Salut tout le monde,

 

Dans le but d'automatiser mes nettoyages de plans via un script, je cherche un lisp qui mettrait toutes les lignes (bloc compris) à épaisseur 0.0 mm.

J'ai bien trouvé un exemple, mais il y a un problème dedans.

;; Utilisation de la fonction SetPropertyValue
;; Modifie l'épaisseur de ligne de toutes les entités de l'espace objet
;; et de toutes les entités dans tous les blocs
;; Options
;; - Dubloc : -2
;; - DuCalque : -1
;; - l'épaisseur en centièmes de millimètres (5, 35, 70, ...)
(defun c:EPT (/ ss i bloc ent)
 ;; on initialise un indice
 (setq 1 0)
 
 ;; on sélectionne toutes les entité de l'espace objet
 (if (setq ss (ssget "_X" '((410 . "Model"))))
   
   ;; tant qu'il existe une entité dans le jeu de sélection à l'indice...
   (while (setq ent (ssname ss i))
     
     ;; ...on change la propriété "LineWeight" de l'entité
     (SetPropertyValue ent "LineWeight" 1) ; <- remplacer -1 par la valeur désirée

     ; on incrémente l'indice
     (setq i (1+ i))
   )
 )

 ;; tant qu'il y a des définitions de bloc dans la table des blocs...
 (while (setq bloc (tblnext "block" (not bloc)))

   ;; ...on parcourt toutes les entités de chaque définition de bloc
   (setq ent (cdr (assoc -2 bloc))) ; <- première entité dans le bloc

   ;; tant qu'il y a des entités...
   (while ent
     
     ;; ...on change la propriété "LineWeight" de l'entité
     (setpropertyvalue ent "LineWeight" 0) ; <- remplacer -1 par la valeur désirée

     ;; et on passe à l'entité suivante
     (setq ent (entnext ent))
   )
 )
 (princ)
)

[lecrabe]

Hello

 

Veux tu un Lisp qui mettre l epaisseur de TOUS les Objets graphiques dans les Blocs a 0.00mm ?

 

LA SANTE (Stay Safe), Bye, lecrabe "triste"

Automne 2020, la retraite

[grandss]

Salut,

 

Oui, c'est bien ça.

[lecrabe]

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)