Copier et aligner

[kclement]

Bonjour à tous,

 

Il y a quelques temps j'avais trouvé sur ce forum un Lisp qui permettait de copier et de pivoter des objets dans la même commande :

 

 ;     C:COPYROT8.LSP by STEVE SMITH, COMPUSERVE ID:72611,2544

(defun C:CR ()
(setq theset nil thelist nil mflag 0 rflag nil)
(setq startent (entlast)); obtain last entity in database
(prompt "Pick Objects to Copy: ")
(setq sset (ssget)); object selection
(initget 1 "Multiple")
(setq bpt (getpoint "\nBasepoint/Multiple: ")); basepoint or m for multiple
(if (= (type bpt) 'STR)
   (progn 
   (setq mflag 1)
   (initget 1 "Fixed")
   (setq bpt (getpoint "\nBasepoint (mult. copies)/Fixed angle:")); base point or f for fixed rotation angle
      (if (= (type bpt) 'STR)
          (progn
          (setq rflag 1)
          (setq bpt (getpoint "\nBasepoint (mult. copies and fixed angle): "))
          (setq fang (getangle bpt "\nFixed Angle:"));fixed angle for rotation
          );progn
      );if
   );progn
);if
; loop until mflag becomes nil
(while mflag
  (progn
    (setq startent (entlast))
    (setq npt (getpoint bpt "Newpoint: ")) 
    (command "_copy" sset "" bpt npt)
    (setq thelist (list (cdr (assoc 5 (entget startent)))))
    (setq nextone startent)
      (while nextone
        (progn
          (setq nextone (entnext nextone))
            (if nextone (setq thelist (cons (cdr (assoc 5 (entget nextone))) thelist)))
        );progn
      );while
    (setq thelist (cdr (reverse thelist))); list of entity handles for copied group
    (ssmake thelist)
    (if rflag
       (command "_rotate" theset "" npt (rtd fang))
       (command "_rotate" theset "" npt pause)
    );if
    (setq theset nil thelist nil); reset list and selection set
    (if (= mflag 0) (setq mflag nil)); drop out of while if not multiple
  );progn
);while
(if (equal npt bpt) (redraw)); if @ was used for newpoint redraw old object
(setq theset nil thelist nil);try to clean up after one's self
);defun

;turn list of ehandles to selection set
(defun ssmake(sslist)
      (setq theset (ssadd))
      (foreach ent sslist (ssadd (handent ent) theset))
)
;

 

Ca marche très bien, et j'aurais aimé avoir la même routine mais avec la fonction align à la place de rotate. Etant une bille en programmation, je me tourne vers vous, voir si vous pouvez quelque chose pour moi.

 

Merci d'avance

[(gile)]

Salut,

 

(defun c:copy_align ()
 (if (vl-cmdf "_.copy" pause "" "" "")
   (command "_.align" "_p" "")
 )
 (princ)
)

 

Ta routine CR pourrait être écrite de manière plus concise en utilisant l'option "Copier" de la commande ROTATION :

 

(defun c:copy_rotate ()
 (command "_.rotate" pause "" pause "_copy")
 (princ)
) 

 

PS : CR est l'alias de la commande CALCRAPIDE

[lecrabe]

 

Hello

 

J'utilise aussi ces 2 routines dans le meme genre :

 

;; Routines EC & RC

 

;; Echelle avec Copie des objets selectionnes

;; Commande: EC - Version 2.1 avec _P et non pas _L

 

(defun c:ec (/ echo)

(vl-load-com)

(setq echo (getvar "CMDECHO"))

(and

(setvar "CMDECHO" 1)

(vl-cmdf "_.copy" (ssget) "" "" "")

(vl-cmdf "_.scale" "_p" "")

(if (not

(while (/= 0 (getvar "cmdactive"))

(vl-cmdf pause)

)

)

(vl-cmdf "_.erase" "_p" "")

)

)

(setvar "CMDECHO" echo)

(princ)

)

 

;; Rotation avec Copie des objets selectionnes

;; Commande: RC - Version 2.1 avec _P et non pas _L

 

(defun c:rc (/ echo)

(vl-load-com)

(setq echo (getvar "CMDECHO"))

(and

(setvar "CMDECHO" 1)

(vl-cmdf "_.copy" (ssget) "" "" "")

(vl-cmdf "_.rotate" "_P" "")

(if (not

(while (/= 0 (getvar "cmdactive"))

(vl-cmdf pause)

)

)

(vl-cmdf "_.erase" "_P" "")

)

)

(setvar "CMDECHO" echo)

(princ)

)

 

 

Je crois que c'est toi qui les avait fourni !?

 

Le Decapode

 

[kclement]

Bonjour,

 

Merci (gile) je vais tester ça tout de suite !

 

PS : CR est l'alias de la commande CALCRAPIDE

 

C'est vrai, j'avais changé le nom pour que ce soit plus rapide à taper car il faut dire que j'utilise ce lisp plusieurs dizaines de fois par jour!

 

 

Merci aussi lecrabe, je vais les essayer également, qui sait peut-être que je vais gagner encore plus de temps !

 

A bientôt...

 

 

[kclement]

Alors, j'ai testé :

 

1) copy_align fonctionne parfaitement, c'est exactement ça que je voulais !

 

2) la version light de copy_rotate : ça marche, mais celle que je'ai mise dans mon premier post, me permet de mettre la copie où je veux, et evntuellement d'avoir des copies multiples d'un seul coup... Mais merci quand même (gile) !

 

A + !

[lili2006]

Bonjour à toutes et tous,

 

Sinon il y a aussi ce post à consulter,...

[kclement]

Bon, je vais faire l'exigeante, mais ce serait-il possible que la routine copy_align permette de sélectionner plusieurs objets ???

 

Merci... ;)

[(gile)]

Salut,

 

Voilà :

(defun c:copy_align (/ ss)
 (if (setq ss (ssget))
   (command "_.copy" ss "" "" "" "_.align" ss "")
 )
 (princ)
)