Duplique un calque et son contenu !

[stephan35]

bonjour à tous !

 

Avant de me lancer follement dans des lignes d'écritures ........ :casstet:

 

Quelqu'un aurait-il déjà developper une fonction qui duplique le nom d'un calque et son contenu sous un autre nom ?????

 

Merci !

 

A+

[Patrick_35]

Salut

Dans ce sujet, tu as un lisp (Cfo.lsp) qui permet la copie d'un folio vers un autre (en clair, d'un calque vers un autre) dont tu peux t'inspirer.

 

@+

[Bred]

Salut,

fait rapidement, à tester.

(defun c:cc (/ CONT-L L LST-SEL N-L X COUL-L)
 (setq L nil)
 (while (not L)
   (setq L (getstring T ":\n Nom du Calque  (+ contenu) à dupliquer :"))
   (if (not (tblobjname "LAYER" L))
     (setq L nil)
     )
   ) 

 (setq N-L (getstring T ":\n Nom du nouveau Calque :")
coul-L (vla-get-color (vlax-ename->vla-object (tblobjname "LAYER" L)))
cont-L (ssget "_X" (list (cons 8 L)))
lst-sel nil)

 (vla-add (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) N-L)
 (vla-put-color (vlax-ename->vla-object (tblobjname "LAYER" N-L)) coul-L)
 (repeat (setq x (sslength cont-L))
   (setq lst-sel (append lst-sel (list (vlax-ename->vla-object (ssname cont-L (setq x (1- x)))))))
   )
 
(foreach n lst-sel (vla-copy n))
(foreach n lst-sel (vla-put-layer n N-L))
(princ)
)

 

[Edité le 11/7/2007 par Bred]

[Patrick_35]

C'est bien Bred et c'est aussi l'occasion d'utiliser vla-copyobjects ;)

Cela permet une copie de plusieurs objets ou lieu de copier un par un

 

@+

[Bred]

RE,

En te copiant outrageseument ici.

(defun c:cc (/ CONT-L L LST-SEL N-L X COUL-L)
 (vl-load-com)
 (setq L nil)
 (while (not L)
   (setq L (getstring T ":\n Nom du Calque  (+ contenu) à dupliquer :"))
   (if (not (tblobjname "LAYER" L))
     (setq L nil)
     )
   ) 

 (setq N-L (getstring T ":\n Nom du nouveau Calque :")
coul-L (vla-get-color (vlax-ename->vla-object (tblobjname "LAYER" L)))
cont-L (ssget "_X" (list (cons 8 L)))
lst-sel nil)

 (vla-add (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) N-L)
 (vla-put-color (vlax-ename->vla-object (tblobjname "LAYER" N-L)) coul-L)
 
[b]
 (vla-copyobjects (vla-get-ActiveDocument (vlax-get-acad-object))
 (vlax-safearray-fill
   (vlax-make-safearray vlax-vbObject (cons 0 (1- (sslength cont-L))))
   (mapcar '(lambda(x) (vlax-ename->vla-object (cadr x))) (ssnamex cont-L))))[/b]
 
[i](repeat (setq x (sslength cont-L))
   (setq lst-sel (append lst-sel (list (vlax-ename->vla-object (ssname cont-L (setq x (1- x)))))))
   )  
(foreach n lst-sel (vla-put-layer n N-L))[/i]
(princ)
)

 

Mais pour le changement de calque, la question reste en suspend, dirait-on ....

[stephan35]

Salut BRED !

 

Merci pour tes réponses (idem pour patrick_35 ...)

 

Donc, Je trouve que la solution du :

 

 (vla-copyobjects (vla-get-ActiveDocument (vlax-get-acad-object))
(vlax-safearray-fill
(vlax-make-safearray vlax-vbObject (cons 0 (1- (sslength cont-L))))
(mapcar '(lambda(x) (vlax-ename->vla-object (cadr x))) (ssnamex cont-L))))

 

est beaucoup plus compliquée à relire que la précédente :

 

 (foreach n lst-sel (vla-copy n))
(foreach n lst-sel (vla-put-layer n N-L))

 

 

D'ailleurs, j'ai enlevé le vla-copy et ça fonctionne toujours ????? :casstet:

NONNN !!!! ok il sert à copier les entités avant de les déplacer !!! (bien sur !) :cool:

 

J'ai rajouté le vla-get-linetype pour le calque.

 

et j'arrive à ça :

 

 (defun @copy_layer ( $source $destination / coul-L line-L lst-sel x cont-L)
(setq
 coul-L (vla-get-color (vlax-ename->vla-object (tblobjname "LAYER" $source)))
 line-L (vla-get-linetype (vlax-ename->vla-object (tblobjname "LAYER" $source)))
cont-L (ssget "_X" (list (cons 8 $source)))
)
(vla-add (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) $destination)
(vla-put-color (vlax-ename->vla-object (tblobjname "LAYER" $destination)) coul-L)
(vla-put-linetype (vlax-ename->vla-object (tblobjname "LAYER" $destination)) line-L)
(repeat (setq x (sslength cont-L))
(setq lst-sel (append lst-sel (list (vlax-ename->vla-object (ssname cont-L (setq x (1- x)))))))
)
(foreach n lst-sel (vla-copy n))
(foreach n lst-sel (vla-put-layer n $destination))
(princ)
)

 

 

Mais sans mérite .... :(

 

Merci à vous !!!

 

 

 

 

[stephan35]

Une dernière petite correction

 

Plantais, si pas d'entités dans un calque . :P

 

 (defun @CopyLayer ( $source $destination / coul-L line-L lst-sel x cont-L)
(setq
 coul-L (vla-get-color (vlax-ename->vla-object (tblobjname "LAYER" $source)))
 line-L (vla-get-linetype (vlax-ename->vla-object (tblobjname "LAYER" $source)))
cont-L (ssget "_X" (list (cons 8 $source)))
)
 (vla-add (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) $destination)
 (vla-put-color (vlax-ename->vla-object (tblobjname "LAYER" $destination)) coul-L)
 (vla-put-linetype (vlax-ename->vla-object (tblobjname "LAYER" $destination)) line-L)
 (if cont-L
   (progn
     (repeat (setq x (sslength cont-L))
(setq lst-sel (append lst-sel (list (vlax-ename->vla-object (ssname cont-L (setq x (1- x)))))))
)
     (foreach n lst-sel (vla-copy n))
     (foreach n lst-sel (vla-put-layer n $destination))
     )
   )
 (princ)
)

 

 

A+

[Patrick_35]

stephan35

Le vla-copyobjects est moins facile à programmer, mais il permet de faire une copie d'une sélection et non entité par entité.

J'ai un lisp qui se sert des réacteurs et qui réagit pour chaque copie. La solution du vla-copy me fait activer un réacteur à chaque fois alors qu'avec un vla-copyobjects, le réacteur n'intervient qu'une seule fois, d'ou un gain de temps appréciable.

Maintenant, c'est comme tu veux ;)

 

De plus, en regardant ton code, tu peux simplifier tes boucles

(repeat (setq x (sslength cont-L))
(setq lst-sel (append lst-sel (list (vlax-ename->vla-object (ssname cont-L (setq x (1- x)))))))
)
(foreach n lst-sel (vla-copy n))
(foreach n lst-sel (vla-put-layer n $destination))

par

(vlax-map-collection (setq sel (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))) '(lambda (x) (vla-put-layer (vla-copy x) $destination)))
(vla-delete sel)

ou plus simple

(setq n 0)
(while (setq ent (ssname cont-L n))
(vla-put-layer (vla-copy (vlax-ename->vla-object ent)) $destination)
(setq n (1+ n))
)

 

@+

[stephan35]

Le vla-copyobjects est moins facile à programmer, mais il permet de faire une copie d'une sélection et non entité par entité.

J'ai un lisp qui se sert des réacteurs et qui réagit pour chaque copie. La solution du vla-copy me fait activer un réacteur à chaque fois alors qu'avec un vla-copyobjects, le réacteur n'intervient qu'une seule fois, d'ou un gain de temps appréciable.

 

Ok ok !

 

Je ne vais surtout pas vexé un breton !!!! ;)

 

Je vais faire ce que je dis (recherche de vitesse) donc je prends et je corrige ....

 

Je remettrai tout ça à jour demain matin ...

 

Merci et A+

 

 

 

 

[Bred]

:P Ah ben tient, depuis tout à l'heure je me disais que je pouvais simplifier ce code, je le fait, et en fait Patrick m'a devancé....

c'est la même chose, sauf que je le fait avec (repeat ....

 

;;;;;;;;;;;;;;;;;;;;
; copie objets d'un calque dans nouveau
(defun c:cc (/ CONT-L L N-L X)
 (vl-load-com)  
 (while (not L)    
   (setq L (getstring T ":\n Nom du Calque à dupliquer (avec contenu) :"))
   (if (not (tblobjname "LAYER" L))
     (setq L nil)
     )
   )
 (setq N-L (getstring T ":\n Nom du nouveau Calque :")
cont-L (ssget "_X" (list (cons 8 L))))
 
 (vla-add (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) N-L)
 (vla-put-color (vlax-ename->vla-object (tblobjname "LAYER" N-L))
   (vla-get-color (vlax-ename->vla-object (tblobjname "LAYER" L))))
 (vla-put-linetype (vlax-ename->vla-object (tblobjname "LAYER" N-L))
   (vla-get-linetype (vlax-ename->vla-object (tblobjname "LAYER" L))))
 
[b](repeat (setq x (sslength cont-L))
   (vla-put-layer
     (vla-copy (vlax-ename->vla-object (ssname cont-L (setq x (1- x))))) N-L)
   )[/b]
 (princ)
)