Toutes les entités couleurs Ducalque sauf les hachures

[zara]

Bonjour,

 

Après plusieurs essais infructueux je n'arrive pas à modifier ce code.

 

Objectif tout mettre dans la couleur ducalque sauf les hachures.

 

Je ne sait pas ou placer cette ligne" (if (/= (vla-get-ObjectName subent) "AcDbHatch")"

 

Cela doit demander une bonne connaissance du langage lisp que je n'ai pas...

 

Merci par avance pour votre aide.

Cordialement

Zara

 

(defun c:test (/ doc ods)
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 ;;fix all dimstyles
 (setq ods (getvar "dimstyle"))
 (vlax-for d (vla-get-dimstyles doc)
   (vla-put-activedimstyle doc d)
   (foreach n '("dimclrt" "dimclrd" "dimclre")
     (setvar n 256)
   )
   (vla-copyfrom d doc)
 )
 ;;need more code to fix mleader styles, and table styles.  Consider stripmtext by others.
                                       ;.........
 ;;fix all objects (does not include mtext color encoding)
 (vlax-for b (vla-get-blocks doc)
   (if (= (vla-get-isxref B) :vlax-false)
     (vlax-for n b
       (if (wcmatch (vla-get-objectname n) "*Dim*")
         (vla-put-stylename n (vla-get-stylename n))
         (vl-catch-all-apply 'vla-put-color (list n 256))
       ))))
 (setvar "dimstyle" ods)
 (vla-regen doc acallviewports)
)

[lecrabe]

Hello

 

A mon avis, tu es "mal barre" avec ce programme Lisp (qui tripatouille les Cotations) !?

Mais bon je suis au niveau 0.3 en Lisp ...

 

Tu trouveras ci-apres une Routine qui fait le boulot !

Elle n'est pas de moi, j'ai juste fait une Micro-Adaptation ...

 

RAPPEL: cette routine ne touche pas aux Types de ligne NI aux Epaisseurs !

 

Bon WE, Bye, lecrabe

 

PS: comme d'habitude, j'ai puise dans le stock de 2000 routines !

 

 

;;
;; http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/block-lisp-to-change-color/m-p/6470434#M343449
;; 
;; Routine: BlockColorByLayer_except_Hatch by jdiala
;;
;; Set Color = ByLayer inside Block for ALL entities
;; 
;; (if (/= (vla-get-ObjectName subent) "AcDbHatch") 
;;
;; Routine de jdiala adaptee avec une Micro-Modif par Patrice
;; 

(vl-load-com) 

(defun C:BlockColorByLayer_except_Hatch (/ ss e blk doc)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(if
 (setq ss (ssget ":L" '((0 . "INSERT"))))
 (repeat (setq i (sslength ss))
    (setq e (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
    (setq blk (vla-item (vla-get-blocks doc) (vla-get-Effectivename e)))
    (vlax-for x blk 

;;; Ligne ci-dessous pour Exclusion des entites HATCH
(if (/= (vla-get-ObjectName x) "AcDbHatch") 

;;; Mettre en Couleur DuCalque TOUTES les Entites
      (vla-put-color x 256) 

) 
;;; Ligne ci-dessus qui va avec le IF de l'Exclusion 

    )
 )
)
(vla-regen doc acAllViewports)
(princ)
)

[(gile)]

Bien voilà le crabe.

Tu vois quand tu veux... ;)

[lecrabe]

Hello Gilles

 

Franchement c tres gentil !

 

Mais souvent je bricole une Micro-Adaptation qui marche sans bien tout comprendre !?

 

Bon WE, Bye, lecrabe

 

PS: A propos je viens de m'apercevoir qu'il manque un vla-qqchose (vla-EndUndoMark)

pour faire une marque ANNULER (Debut-Fin de routine) ?

[zara]

Hello,

 

Merci beaucoup le crabe pour cette réponse.

Mais ton lisp ne transforme que les entités à l’intérieur des blocs et mon souhait serai de passer toutes les entités sauf "l'intérieur" des blocs (j'ai déjà un lisp qui les passe en dubloc) et les hachures.

 

Tout en ducalque sauf "l’intérieur" des blocs et les hachures.

Je ne sait pas si je suis clair...

 

Merci encore pour ta réponse

 

Bye Zara

[Olivier Eckmann]

Bonjour,

 

il suffit de faire un bouton

^C^CCHPROP;(ssget"x");s;(ssget "x" (list (cons 0 "HATCH")));;CO;DUCALQUE;;

Olivier

[zara]

Bonjour Olivier,

 

C'est parfait ça fonctionne impeccable. :D

 

Merci beaucoup

bonne journée

 

Zara

[VDH-Bruno]

Bonjour,

 

Ceci devrait également convenir:

(command "CHPROP" (ssget "X" '((0 . "~HATCH"))) "" "CO"  "DUCALQUE" "")

 

A+