Bloc "dubloc"

[GEGEMATIC]

Salut a toutes et à tous,

je m’aperçois que ma vieille routine "blocdubloc", qui place toute la définition d'un bloc avec les propriété "dubloc" par pointage,

a un problème, et je n'ai pas réussi à le reproduire.

Parfois elle ne s'arrête pas, et parcours tous les blocs, mais pas toujours ... enfin ça m'emmerde.

ça a certainement été fait en mieux par qq d'autre, donc si une bonne âme à ça sous la main ...

a+

Gégé

[(gile)]

Salut,

Edit_Bloc sur cette page.

[lecrabe]

Hello

J adore la routine "RB_Zero_ByBlock" de notre regrette Patrick_35 !

Bon WE, La Sante, Bye, lecrabe

 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
;; 
;; Routine :  RB_Zero_ByBlock
;; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
;;; 
;;; 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
;;;
;;;=================================================================

  (vl-load-com) 

;; (defun c:RB( / *errrb* bl ent js lst nombl doc s sel)  

(defun c:RB_Zero_ByBlock ( / *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)
    )
  )

  (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
   	(vla-put-color ent 0)

	;;;--- Forcer le type de ligne sur Dubloc / ByBlock
   	(vla-put-linetype ent "ByBlock")

	;;;--- Forcer l'epaisseur de ligne sur Dubloc / ByBlock
   	(vla-put-lineweight ent -2)  

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

      )
    )
  )



;;; ------ Avec un REGEN ------ 
  (vla-regen doc acAllViewports)

  (vla-endundomark doc)
  (setq *error* s)
  (princ)
)

;; (setq nom_lisp "RB") 
   (setq nom_lisp "RB_Zero_ByBlock") 

(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) 

 

[lecrabe]

Hello

Et pour la variante "RB_Zero_ByLayer", tu fais qq Modifs ...

Bon WE, La Sante, Bye, lecrabe

 

;;;--- Forcer la couleur sur Dubloc / ByBlock
;;       (vla-put-color ent 0   )  ;; ByBlock
         (vla-put-color ent 256 )  ;; ByLayer

;;;--- Forcer le type de ligne sur Dubloc / ByBlock
;;       (vla-put-linetype ent "ByBlock")  ;; ByBlock
         (vla-put-linetype ent "ByLayer")  ;; ByLayer

;;;--- Forcer l'epaisseur de ligne sur Dubloc / ByBlock
;;       (vla-put-lineweight ent -2)  ;; ByBlock
         (vla-put-lineweight ent -1)  ;; ByLayer

 

 

[GEGEMATIC]

Salut,

merci a tous les deux !

a+

Gégé