Aller au contenu

Bloc "dubloc"


GEGEMATIC

Messages recommandés

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é

----------------------------------------------------------------------

Site: https://www.g-eaux.fr

Blog: http://g-eaux.over-blog.com

Lien vers le commentaire
Partager sur d’autres sites

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) 

 

Autodesk Expert Elite Team

Lien vers le commentaire
Partager sur d’autres sites

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

 

 

Autodesk Expert Elite Team

Lien vers le commentaire
Partager sur d’autres sites

Créer un compte ou se connecter pour commenter

Vous devez être membre afin de pouvoir déposer un commentaire

Créer un compte

Créez un compte sur notre communauté. C’est facile !

Créer un nouveau compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant
×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité