Transformation blocks

[Invité ingoenius]

Salut a tous

j'ai récupère un dessin avec une grosse bibliothèque de bocks, mais il sont tous en mode couleur "Du calque" existe une routine pour les convertir en mode couleur "Du Bloc", sans être obligé de le faire a la man un par un ?

 

Merci a vous ;-)

 

 

 

[Invité ingoenius]

Trouvé ;-)

Ici la routine PAR contre j'aimerai povoir apporter une modif mais je sais pas faire;-(

Je voudrai aussi pouvoir redefinir l'echelle des blocks et l'unite de mesure

 

L'echelle

dans le sens que si le block dnas le dessin est affiche avec une echelle de 2.25 retablir l'echelle a 1.0 en gardant la dimension affichees (c'est a dire exploder sur place le bloc et le reconstituer avec meme point d'insertion )

 

L'unité de mesure

chosire entreo pouces ou mm ou sans unités

 

 

 

 

 

 

 

;;published by kpblc
;;http://www.arcada.com.ua/forum/viewtopic.php?t=526
;    NORMALIZE BLOCKS

(defun c:NBL (/ adoc answer lays lock lay *error* ans0 atype cnt)
 (defun *error* (msg)
   (princ msg)
   (if	lock
     (foreach x lock (vla-put-lock x :vlax-true))
   )
   (vl-cmdf "_.Redraw")
 )
 (vl-load-com)
 (setq cnt 0)
 (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
 (setq lays (vla-get-layers adoc))
 (vla-startundomark adoc)
 (initget "LType LWeight Color All _ T W C A")
 (if (null (setq answer
	   (getkword
	     "\nIn blocks to lead to norm [LType/LWeight/Color/All]  : "
	   )
    )
     )
   (setq answer "A")
 ) ;_ end of if
 (initget "byLayer byBlock")
 (setq	atype
 (getkword
   "\nSet contents inside the block to [byLayer/byBlock] :"
 )
 )
 (initget "Yes No")
 (setq
   ans0 (getkword "\nChange entities layer's to 0? [Yes/No] :")
 )
 (vlax-for item (vla-get-blocks adoc)
   (if	(not (wcmatch (strcase (vla-get-name item) t) "*_space*"))
     (progn
(setq cnt (1+ cnt))
(grtext -1 (strcat "Modyfied " (vla-get-name item)))
(vlax-for sub_item
	  (vla-item (vla-get-blocks adoc) (vla-get-name item))
  (setq lay (vla-item lays (vla-get-layer sub_item)))
  (if (= (vla-get-lock lay) :vlax-true)
    (progn (vla-put-lock lay :vlax-false)
	   (setq lock (cons lay lock))
    )
  )
  (if (= ans0 "Yes")
    (vla-put-Layer sub_item "0")
  )
  (cond
    ((= answer "W")
     (vla-put-LineWeight
       sub_item
       (if (= atype "byLayer")
	 acLnWtByLayer
	 aclnwtbyblock
       )
     )
    )
    ((= answer "T")
     (vla-put-linetype
       sub_item
       (if (= atype "byLayer")
	 "ByLayer"
	 "ByBlock"
       )
     )
    )
    ((= answer "C")
     (vla-put-color
       sub_item
       (if (= atype "byLayer")
	 acByLayer
	 acByBlock
       )
     )
    )
    (t
     (vla-put-LineWeight
       sub_item
       (if (= atype "byLayer")
	 acLnWtByLayer
	 aclnwtbyblock
       )
     )
     (vla-put-linetype
       sub_item
       (if (= atype "byLayer")
	 "ByLayer"
	 "ByBlock"
       )
     )
     (vla-put-color
       sub_item
       (if (= atype "byLayer")
	 acByLayer
	 acByBlock
       )
     )
    )
  ) ;_ end of cond 
) ;_ end of vlax-for
     )
   ) ;_ end of if 
 ) ;_ end of vlax-for 
 (if lock
   (foreach x lock (vla-put-lock x :vlax-true))
 )
 (vla-regen adoc acallviewports)
 (vla-endundomark adoc)
 (vl-cmdf "_.Redraw")
 (princ (strcat "\nModyfied " (itoa cnt) " blocks"))
 (princ)
) ;_ end of defun

 

[Edité le 7/5/2010 par ingoenius]

[Bred]

Salut,

tu as le lisp Edit-bloc de (gile).

[Invité ingoenius]

Merci Bred (et Gile)

Je vais voir Edit_bloc

[lesourd2]

Salut

 

 

Ou encore ça de Patrick

 ;;;=================================================================
;;;
;;; RB.LSP V1.10
;;;
;;; Refait tous les blocs de la couleur dubloc et sur le calque 0
;;;
;;; Copyright (C) Patrick_35
;;;
;;;=================================================================


(defun c:rb(/ a b)
 (vl-load-com)
 (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
 (setq a (tblnext "block" t))
 (while a
   (setq b (cdr (assoc -2 a)))
   (while b
     (setq b (entget b))
     (if (cdr (assoc 6 b))
(setq b (subst (cons 6 "ByBlock") (assoc 6 b) b))
(setq b (append b (list (cons 6 "ByBlock"))))
     )
     (setq b (subst (cons 8 "0") (assoc 8 b) b))
     (if (cdr (assoc 62 b))
(setq b (subst (cons 62 0) (assoc 62 b) b))
(setq b (append b (list (cons 62 0))))
     )
     (if (cdr (assoc 370 b))
(setq b (subst (cons 370 -2) (assoc 370 b) b))
(setq b (append b (list (cons 370 -2))))
     )
     (entmod b)
     (setq b (entnext (cdr (assoc -1 b))))
   )
   (setq a (tblnext "block"))
 )
 (if (setq a (vl-remove-if-not '(lambda (x) (eq (car x) 350)) (dictsearch (namedobjdict) "ACAD_MLINESTYLE")))
   (foreach b a
     (entmod (append (vl-remove-if '(lambda (x) (eq (car x) 62)) (entget (cdr b))) (list (cons 62 0) (cons 62 0) (cons 62 0))))
   )
 )
 (if (setq a (ssget "x" (list (cons 0 "INSERT"))))
   (foreach b (mapcar 'cadr (ssnamex a))
     (if (cdr (assoc 66 (entget b)))
(progn
  (setq a (entget (entnext b)))
  (while (not (eq (cdr (assoc 0 a)) "SEQEND"))
    (entmod (subst (cons 62 0) (assoc 62 a) a))
    (setq a (entget (entnext (cdr (assoc -1 a)))))
  )
)
     )
     (entupd b)
   )
 )
 (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
 (princ)
)

(setq nom_lisp "RB")
(if (/= app nil)
 (if (= (strcase (substr app (1+ (- (strlen app) (strlen nom_lisp))) (strlen nom_lisp))) nom_lisp)
   (princ (strcat "..." nom_lisp " chargé."))
   (princ (strcat "\n" nom_lisp ".LSP Chargé.....Tapez " nom_lisp " pour l'éxecuter.")))
 (princ (strcat "\n" nom_lisp ".LSP Chargé......Tapez " nom_lisp " pour l'éxecuter.")))
(setq nom_lisp nil)
(princ)