Changer Ducalque en Forcé

[LUDWIG]

Bonjour à tous,

 

Je me rappelle avoir vu passer un lisp pour changer de calque les entités tous en conservant les couleur et type de ligne des calques d'origine (en les forçant).

 

 

Est-ce que quelqu'un sait où je pourrais retrouver ça ?

 

Merci d'avance !

[Arcasdk]

Coucou LUDWIG,

 

Oui j'ai vu passé ce lisp, et je crois même que c'est moi qui est à l'origine.

 

Voici le code en V-LISP

 

(defun c:5(/ doc js sel)
(vl-load-com)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark doc)
(vl-catch-all-apply 'vla-add (list (vla-get-layers doc) "[b]DESSIN[/b]"))
(and (setq js (ssget))
(progn
(vlax-for ent (setq sel (vla-get-activeselectionset doc))
(vla-put-layer ent "[b]DESSIN[/b]")
[surligneur](vla-put-color ent 256)
(vla-put-linetype ent "ByLayer")[/surligneur]
)
(vla-delete sel)
)
)
(sssetfirst nil js)
(vla-endundomark doc)
(princ)
)

 

Change les textes en gras par le nom de ton calque et ce qu'il y a en jaune si tu veux garder ton type de ligne et ta couleur.

 

Je ne suis pas encore un expert en V-LISP mais cela doit être ça...

 

N'hésite pas si tu as des questions

 

Voici le lien du post .

 

Bon courage,

 

Fred!

[LUDWIG]

Merci !

 

Le problème c'est que ton programme force la couleur des entités en Ducalque OU les laisse à la couleur d'origine.

 

Pour mon application, il faudrait que les entités prennent la couleur de leur calque d'origine. Exemples :

- une ligne de couleur Ducalque sur le calque vert TOTO devra devenir de couleur verte sur le calque 0

- une ligne de couleur cyan sur le calque TUTU restera de couleur cyan sur le calque 0

[LUDWIG]

Ces bidouilles me rappellent maintenant un lisp que j'avais fait quand je faisais du lisp

 

Une version pour "normaliser les blocs", c'est à dire placer les entités du bloc sur le calque 0 mais en conservant la couleur d'origine (ou celle du calque d'origine). Ainsi, le bloc conserve son apparence, mais n'a plus que des entités sur 0

 

(defun c:nb2 ()


 (setq echoold (getvar "cmdecho"))
 (setvar "cmdecho" 0)

 ;(command "-calque" "a" "e" "Normalise" "" "" "")

 (COMMAND "-calque" "L" "*" "AC" "*" "D" "*" "")
 (COMMAND "-calque" "E" "0" "")
 

;Normalisation des blocs dans la table des blocs
 (if (/= nil (setq	i   (tblnext "block" t)))(progn
; RECHERCHE LA PREMIERE ENTREE DANS LA TABLE DES BLOCS 
(setq tot 1)
 (while i
   (setq n (cdr (assoc -2 i)))
; SELECTIONNE LA PREMIERE ENTITE QUI COMPOSE LE BLOC
   (while n
     (setq n (entget n))

     
     (setq colorigin (cdr (assoc 62 n)))
     (if (or (= nil colorigin)(= 256 colorigin)(= "BYLAYER" colorigin))(setq colorigin (cdr(assoc 62 (tblsearch "layer" (cdr (assoc 8 n)))))))
     (if (> 0 colorigin)(setq colorigin (- 0 colorigin)))
;Récupère la couleur de l'entité d'origine (ou de son calque si la couleur est "bylayer")

     
; RECUPERE LES VALEURS DES ENTITES QUI COMPOSE LE BLOC
     (if (/= (cdr (assoc 8 n)) "0")
(progn
  (setq n (subst (cons 8 "0") (assoc 8 n) n))
;SI L'ENTITE N'EST PAS SUR 0, LA DEPLACE SUR 0
  (entmod n)
  ) ;_ Fin de progn
) ;_ Fin de if

     (if (not (assoc 62 n))
;SI L'ENTITE N'A PAS LE CODE DXF 62 (=DuCalque), LE CREE ET LUI AFFECTE LA VALEUR de son calque d'origine
(setq n (append n (list (cons 62 colorigin)))))

;CHANGE LA COULEUR EN COULEUR D4ORIGINE
  (setq n (subst (cons 62 colorigin) (assoc 62 n) n))
  

     (entmod n)
     (setq n (entnext (cdr (assoc -1 n)))) ;ENTITE SUIVANTE
     ) ;_ Fin de while
   (setq i   (tblnext "block")
  tot (1+ tot)
  ) ;BLOC SUIVANT
   ) ;_ Fin de while

;Normalisation des étiquettes d'attributs de blocs dans le dessin (car une étiquette peut avoir des valeurs de calque, couleur, etc. différentes de l'attribut)
 (setq sel (ssget "x" (list (cons 0 "INSERT"))))
 (setq j 0)
 (setq nat 0)
 (while (ssname sel j)
   (setq n (entget (ssname sel j)))
   (if	(assoc 66 n)
     (progn
(setq i (entget (entnext (cdr (assoc -1 n)))))
(while (/= (cdr (assoc 0 i)) "SEQEND")
  (setq i (subst (cons 8 "0") (assoc 8 i) i))
; mettre l'attribut sur le calque 0



(if (not (assoc 62 i))(setq i (append i (list (cons 62 0)))))
(if (/= (cdr (assoc 62 i)) 0)(setq i (subst (cons 62 0) (assoc 62 i) i)))
  

  
; mettre l'attribut en couleur dubloc





  
  (entmod i) ; modifier l'entité
  (entupd (cdr (assoc -1 i)))
; mettre à jour sur l'écran l'entité
  (setq nat (+ 1 nat))
  (setq i (entget (entnext (cdr (assoc -1 i)))))
  ) ;_ Fin de while
) ;_ Fin de progn
     ) ;_ Fin de if
   (setq j (1+ j))
   ) ;_ Fin de while

;Résultat
;-----------------------------------------------
 (princ
   (strcat "\nTraitement de "
    (itoa (+ tot nat))
    " bloc(s) ("
    (itoa tot)
    " dans la table des blocs et "
    (itoa nat)
    " étiquette(s) d'attribut(s) de bloc(s) dans le dessin)"
    ) ;_ Fin de strcat
   ) ;_ Fin de princ
 ;(command "-calque" "a" "s" "Normalise" "" "")
 (command "regen")
 (setvar "cmdecho" echoold)
 (graphscr)
 (princ)
   )
 ) 
)
(prompt
 "\nnb2 : Normaliser les blocs du dessin (calque 0 - Couleur d'ORIGINE)"
 ) ;_ Fin de prompt