Creation de calques avec couleur

[fabcad]

Bonjour Amis développeurs,

 

Je souhaiterais envoyer des objets qui ont une couleur forcée dans des calques du nom de la couleur.

 

Exemple :

 

Objets de couleur 1 dans calque 1

Objets de couleur 2 dans calque 2

Objets de couleur 3 dans calque 3

Objets de couleur 4 dans calque 4

Objets de couleur 5 dans calque 5

Objets de couleur 6 dans calque 6

Objets de couleur 7 dans calque 7

Objets de couleur 8 dans calque 8

Objets de couleur 9 dans calque 9

Objets de couleur 10 dans calque 10

Objets de couleur 11 dans calque 11

etc.

 

Merci pour vos suggestions.

 

[Bred]

Salut,

restons simple... (pourquoi en visual ?...)

(defun c:ent-lay-col (/ sel)
 (setq sel (car (entsel "\n Choix de l'objet :")))
 (if (assoc 62 (entget sel))
   (entmod
     (subst (cons 8 (strcat "Calque " (rtos (cdr (assoc 62 (entget sel))))))
     (assoc 8 (entget sel))
     (entget sel)))
   (princ "\n Couleur DuCalque")
   )
 )

 

[Edité le 18/9/2007 par Bred]

[fabcad]

merci pour ta réponse,

Je maitrise l'autolisp et je suis novice en visual lisp.

 

Je voulais voir la différence de langage.

[(gile)]

Salut,

 

Et pourquoi pas en visual ? ;)

 

Comme c'est le forum Visual LISP, je suppose que fabcad veut se familiariser avec ce langage.

En l'état, le LISP place les objets de couleur 1 sur le "Calque1", de couleur 2 sur le "Calque2" etc... si les noms de calques sont d'un autre type, modifier la ligne surlignée.

Si un objet avait une couleur dont il n'existe pas de calque équivalent le calque est créé

Cette version devrait fonction sur les versions d'AutoCAD de 2002 à 2007 au moins. La gestion des couleurs ayant changé en 2004 avec l'arrivée des couleurs vraies la propriété Color devrait disparaître au profit de TrueColor dans une version future (2008 ?).

Pour la gestion des 'TrueColor' voir ce sujet

 

(defun c:col2lay (/)
 (setq	acdoc  (vla-get-ActiveDocument (vlax-get-acad-object))
layers (vla-get-Layers acdoc)
 )
 (if (ssget)
   (vlax-for obj (vla-get-ActiveSelectionSet acdoc)
				; parcourrir le jeu de sélection
     (setq col (vla-get-Color obj))	;couleur de l'objet
     (if (and
    (/= col 256)		; couleur DuCalque
    (/= col 0)			; couleur DuBloc
  )
(progn
  ;; si le calque du numéro de la couleur n'existe pas...
  (if (vl-catch-all-error-p
	(vl-catch-all-apply
	  'vla-item
	  (list	layers
		[surligneur](setq lay (strcat "Calque" (itoa col))) ; à adapter[/surligneur] 
	  )
	)
      )
    ;; ... le créer
    (vla-put-color
      (vla-add (vla-get-Layers acdoc) lay)
      col
    )
  )
  (vla-put-Layer obj lay) ; mettre l'objet sur le calque
  (vla-put-color obj 256) ; mettre la couleur de l'objet en DuCalque
)
     )
   )
 )
 (princ)
) 

[Bred]

Et pourquoi pas en visual ?

... parceque je trouve que lorsqu'il faut créer de nouveaux calque, rien n'est plus performant que les entmake/entmode....

 

et puis il y a la longueur du code.... :cool:

 

mais, bon, il est vrais que je passe tous en vl maintenant...

 

par exemple je me suis crées des routines en vl pour les calques :

 

;;;; 	Routine Test Existence ou créés Calque
(defun test_exist_calque (nom Couleur)
 (if (not (tblobjname "LAYER" nom))
   (vla-add (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) nom))
 (vla-put-Color (vlax-ename->vla-object (tblobjname "LAYER" nom)) Couleur)
)

;;;	 Routine changement calque de l'objet				;
(defun chang_Calque (Ob Calq) 
 (if (not (tblobjname "LAYER" Calq))
   (vla-add (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) Calq))
 (vla-put-Lock (vlax-ename->vla-object (tblobjname "LAYER" Calq)) :vlax-false) ;déverouille calque
 (vla-put-layer (vlax-ename->vla-object Ob) Calq)  
)

 

... ce que fait entmake et entmod tous seul !..

 

[Edité le 18/9/2007 par Bred]

[(gile)]

C'était une boutade Bred.

 

Pour moi, tout est bon : ent... vla... ou command* du moment que c'est du LISP !!!

 

*les dernières routines que j'ai publiées ici utilisent largement command qui est parfois beaucoup plus commode.

[Bred]

C'était une boutade Bred.

Je l'avais pris comme ça !

Mon explication était surtout pour fabcad.

 

D'ailleur, au vu des routines vl que j'ai mis ci-dessus, je me demande si te proposition, (gile) ne planterais pas si le calque existe, mais est verrouillé...

[fabcad]

Merci pour vos lignes de code,

 

Je dois maintenant les analyser...

 

A+

[(gile)]

je me demande si te proposition, (gile) ne planterais pas si le calque existe, mais est verrouillé...

 

tout à fait exact Bred.

 

Déverrouiller tous les calques et stocker les objets calques initialemant verrouillés dans une listedans une liste, à ajouter après (setq layers (vla-get-Layers acdoc))

(vlax-for Layers
   (if	(= :vlax-true
   (vla-get-lock c)
)
     (progn
(vla-put-lock c :vlax-false)
(setq l_lst (cons c l_lst))
     )
   )
 ) 

 

pour restaurer lauers états initiaux, à la fin de la routine :

 

(if l_lst
   (mapcar '(lambda (x)
       (vla-put-lock x :vlax-true)
     )
    l_lst
   )
 ) 

[Patrick_35]

Et pourquoi pas en visual ? ;)

Pour être plus rapide ;)

 

@+

[(gile)]

Pour être plus rapide

 

Si par rapport à command, il n'y a pas photo, il semblerait que par rapport à entmake ou entmod ce soit moins évident au vu de quelques tests que j'ai fait et de discussion lues sur des forums anglo saxons.

 

Deux exemples contradictoires.

 

Créer une polyligne :

 

(setq pts '((0.0 0.0) (1.0 0.0) (1.0 1.0) (0.0 1.0)))

(defun test1 (pts)
 (setq	pl
 (entmakex
   (append
     (list '(0 . "LWPOLYLINE")
	   '(100 . "AcDbEntity")
	   '(100 . "AcDbPolyline")
	   '(90 . 4)
     )
     (mapcar '(lambda (pt) (cons 10 pt)) pts)
   )
 )
 )
 (entdel pl)
)

(defun test2 (pts / pl)
 (vl-load-com)
 (setq	pl
 (vlax-invoke
   (vla-get-ModelSpace
     (vla-get-ActiveDocument
       (vlax-get-acad-object)
     )
   )
   'addLightWeightPolyline
   (apply 'append pts)
 )
 )
 (vla-delete pl)
) 

 

(benchmark '((test1 pts) (test2 pts)))

Benchmarking ................Elapsed milliseconds / relative speed for 8192 iteration(s):

 

(TEST1 PTS).....1109 / 1.94

(TEST2 PTS).....2157 / 1.00

 

Changer un objet de calque (les calques "Calque1" et "Calque2" existent dans le dessin), l'objet sélectionné est sur le calque1.

 

(setq ent (car (entsel))
     obj (vlax-ename->vla-object ent)
)


(defun test3 (ent / elst)
 (setq elst (entget ent))
 (entmod (subst '(8 . "Calque2") (assoc 8 elst) elst))
 (entmod (subst '(8 . "Calque1") (assoc 8 elst) elst))
)

(defun test4 (obj)
 (vla-put-Layer obj "Calque2")
 (vla-put-Layer obj "Calque1")
) 

 

(benchmark '((test3 ent) (test4 obj)))

Benchmarking .................Elapsed milliseconds / relative speed for 16384 iteration(s):

 

(TEST4 OBJ).....1891 / 2.26

(TEST3 ENT).....4265 / 1.00

 

[Edité le 18/9/2007 par (gile)]