Topic: Copy and rotate (kopieren und drehen)

[Hugo]

Can I make it better
Thank you

Kann man das besser machen
Danke

Code: [Select]

(defun c:copydreh ()
        (setvar "cmdecho" 0)
  (while(setq el (car (entsel)))
        (setq el1 (entget el))
        (setq p1 (cdr (assoc 10 el1)))
        (command "_copy" (ssadd el) "" p1 pause)
        (setq en (entget(entlast)))
        (princ "\nPress [Tab] to Rotate Text <Accept>: ")
       (while (= 9 (cadr (grread nil 2)));;(while (= 9 (cadr (grread nil 2)))
          (setq rt(assoc 50 en)
                en(entmod (subst (cons 50 (rem (+ (/ pi 2.) (cdr rt)) (+ pi pi))) rt en))
          )
       );while
        (setvar "cmdecho" 1)
  );while
);defun

[pBe]

Code: [Select]

(defun c:copydreh ()
        (setvar "cmdecho" 0)
  (while(setq el (car (entsel)))
        (setq el1 (entget el))
        (setq p1 (cdr (assoc 10 el1)))
        (command "_copy" (ssadd el) "" (trans p1 0 1) pause)
        ;(setq en (entget (entlast)))
    (setq en (vlax-ename->vla-object (entlast)))
        (princ "\nPress [Tab] to Rotate Text <Accept>: ")
       (while (= 9 (cadr (grread nil 2)));;(while (= 9 (cadr (grread nil 2)))
          (setq rt (vla-get-rotation en))
             ;   en
             ;(entmod (subst (cons 50 (rem (+ (/ pi 2.) (cdr rt)) (+ pi pi))) rt en))
              (vla-put-rotation en (rem (+ (/ pi 2.) rt) (+ pi pi)) )
          ;)
       );while
        (setvar "cmdecho" 1)
  );while
)
Trans <---- UCS Issues
vla-put-rotation <----More Annotative Text/Mtext Friendly 

[DEVITG]

What about  Express tool MOCORO?

[Hugo]

@ pBe

Thank you
even better would be before turning and then copy

noch besser wäre vorher drehen und dann kopieren
Danke

@Devitg

with Mocoron I'm not as fast
mit Mocoro bin ich nicht so schnell

[Tharwat]

Localizing variables and filtration of selection sets would be much more better to avoid any error or crash of codes 

[Hugo]

@Tharwat

Yes, thank you
Ja danke

[CAB]

Here is one of my old routine that may be of interest to you.

Code: [Select]

;;;  CopyRotate.lsp by Charles Alan Butler
;;;         Copyright 2008
;;;  by Precision Drafting & Design All Rights Reserved.
;;;  Contact at TheSwamp.org
;;;
;;;   Version 5.2  Sep 04, 2008
;;;
;;; DESCRIPTION
;;; User pick base point then selects object(s)
;;; Paste mode until Escape is pressed
;;; Once placed user selects rotation angle
;;;
;;; Command Line Usage
;;; Command: copyr
;;;;;  Copy objects, then paste & rotate new copy
(defun c:copyr (/ pt npt ss elast ssnew ale_lastent ale_ss-after *error*
                MoveStarted osmodetmp usrosmode)

  (princ "\nVwerion 5 CopyR lisp")
 
  ;; error function & Routine Exit
  (defun *error* (msg)
    (if
      (not
        (member
            msg
           '("console break" "Function cancelled" "quit / exit abort" "")
        )
      )
       (princ (strcat "\nError: " msg))
    ) ; endif
    (and usrosmode (setvar "osmode" usrosmode))
    (and usrormode (setvar "orthomode" usrormode))
    (if (and MoveStarted ssnew)
      (command "._erase" ssnew "")
    )
   )
  ;; Rune Wold and Michael Puckett - modified ale_lastent ale_ss-after
  (defun ale_lastent (/ entnam outval)
    (and
      (setq outval (entlast))
      (while (setq entnam (entnext outval))
        (setq outval entnam)
      )
    )
    outval
  )

  (defun ale_ss-after (entnam / entnxt selset)
    (cond
      ((not entnam) (ssget "_X"))
      ((setq entnxt (entnext entnam))
       (setq selset (ssadd entnxt))
       (while (setq entnxt (entnext entnxt))
         (if (entget entnxt)
           (ssadd entnxt selset)
         )
       )
       selset
      )
    )
  )

 
  (setq usrosmode (getvar "osmode")) ; reset when routine ends
  (setq usroRmode (getvar "orthomode")) ; reset when routine ends
  (setq osmodetmp (getvar "osmode")) ; temp setting
  (setq ormodetmp (getvar "orthomode")) ; temp setting
  (if (and (null (prompt "\nSelect objects to copy:"))
           (setq ss (ssget))
           (setq pt (getpoint "\nPick base point:"))
      )
    (progn
      (setvar "osmode" 0)
      (command "._copybase" pt ss "") ; get object(s) to copy
      (command "._undo" "_begin")
      (setq elast (ale_lastent))
      (command "._pasteclip" pt) ; Create a Copy in the drawing, then move it
      (setq ssnew (ale_ss-after elast))
      (while
        (progn
          (setq MoveStarted t)
  (setvar "osmode" 0)
  (setvar "orthomode" 0)
          (command "._move" ssnew ""  pt)
          ;;(setvar "osmode" osmodetmp)
          (command pause)
          (if (or (and (null npt) (setq npt (getvar "lastpoint")))
                  (> (distance pt (setq npt (getvar "lastpoint"))) 0.0001))
            (progn
              ;;  allow user to rotate
              (setvar "osmode" osmodetmp)
              (setvar "orthomode" 1)
              (command "._rotate" ssnew "" "_non" npt)
              (command pause)
              (setq MoveStarted nil)
              (setq osmodetmp (getvar "osmode"))
              (command "._undo" "_end")
              (command "._undo" "_begin")
              ;;  get last item in database
              (setq elast (ale_lastent))
      (setvar "osmode" 0)
              (command "._pasteclip" pt)
              ;;  get new items pasted.
              (setq ssnew (ale_ss-after elast))
              t ; stay in loop
            )
          )
        )
      ) ; while
    ) ; progn
  ) ; endif
  (*error* "")
  (command "._undo" "_end")
  (princ)
)
(princ)

[BlackBox]

This needs some updating, but here's one written a while back that uses the acet-ss-drag-move function:

Code: [Select]

(defun c:CORO () (c:CopyRotate))
(defun c:CopyRotate  (/ *error* ss p1 p2)
  (princ "\rCOPYROTATE ")

  (defun *error*  (msg)
    (if flag
      (command "._erase" ss2 ""))
    (and oldCmdecho (setvar 'cmdecho oldCmdecho))
    (and oldMenuecho (setvar 'menuecho oldMenuecho))
    (and oldNomutt (setvar 'nomutt oldNomutt))
    (cond ((not msg))                                                   ; Normal exit
          ((member msg '("Function cancelled" "quit / exit abort")))    ; <esc> or (quit)
          ((princ (strcat "\n** Error: " msg " ** "))))                 ; Fatal error, display it
    (princ))

  ((lambda (oldCmdecho oldMenuecho oldNomutt e flag ss2)
     (prompt "\nSelect object(s) to copy rotate: ")
     (if (and (setq ss (ssget "_:L"))
              (setq p1 (getpoint "\nSpecify base point: "))
              (setq p2 (acet-ss-drag-move
                         ss
                         p1
                         "\nLocate new object(s): "
                         T)))
       (progn
         (prompt "\nEnter rotation angle: ")
         (setvar 'cmdecho 0)
         (setvar 'menuecho 6)
         (setvar 'nomutt 1)
         (command "._copy" ss "" "_non" p1 "_non" p2)
         (while (/= nil (setq e (entnext e))) (ssadd e ss2))
         (command "._rotate" ss2 "" p2)
         (setq flag nil)))
     (*error* nil))
    (getvar 'cmdecho)
    (getvar 'menuecho)
    (getvar 'nomutt)
    (entlast)
    T
    (ssadd)))


[Lee Mac]

Another,

Code: [Select]

(defun c:cr ( / s )
    (if (setq s (ssget "_:L")) (command "_.rotate" s "" pause "_C" pause))
    (princ)
)

[BlackBox]

Sure, if you like to copy/rotate in place. 

Edit - more accurately, about the base point. The others allow for direct placement is all.

[BlackBox]

Streamlined version of my earlier post (removed the system variable changes, and error handling):

Code: [Select]

(defun c:CORO  (/ e ss p1 p2 ss2)
  (setq e (entlast))
  (if (and (setq ss (ssget "_:L"))
           (setq p1 (getpoint "\nSpecify base point: "))
           (setq p2 (acet-ss-drag-move
                      ss
                      p1
                      "\nLocate new object(s): "
                      T))
           (setq ss2 (ssadd)))
    (progn
      (command "._copy" ss "" "_non" p1 "_non" p2)
      (while (/= nil (setq e (entnext e))) (ssadd e ss2))
      (command "._rotate" ss2 "" p2)))
  (princ))


[Lee Mac]

Streamlined version of my earlier post (removed the system variable changes, and error handling):

Watch out for when 'entlast' is an attributed block, or 3D Polyline; and also for the setting of COPYMODE. 

As a simple command call version, I would suggest perhaps:

Code: [Select]

(defun c:cr ( / c s )
    (if (setq c (getvar 'COPYMODE)) (setvar 'COPYMODE 1))
    (if (setq s (ssget "_:L"))
        (command
            "_.copy"   s "" "_non" '(0 0 0) "_non" "@"
            "_.move"   s "" pause pause
            "_.rotate" s "" "_non" (getvar 'LASTPOINT) pause
        )
    )
    (if c (setvar 'COPYMODE c))
    (princ)
)
<< Edit, added extra "_non" >>

[BlackBox]

Watch out for when 'entlast' is an attributed block, or 3D Polyline; and also for the setting of COPYMODE. 

*Touches finger to tip of nose*

*Points finger at Lee*

[alanjt]

Code: [Select]

(defun c:CAR (/ *error* ss p1 p2 add temp lst ang)

  (vl-load-com)

  (defun *error* (msg)
    (and *AcadDoc* (vla-endundomark *AcadDoc*))
    (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))
      (princ (strcat "\nError: " msg))
    )
  )

  (vla-startundomark
    (cond (*AcadDoc*)
          ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
    )
  )

  (if (and (setq ss (ssget "_:L"))
           (setq p1 (getpoint "\nSpecify base point: "))
           (setq p2 (acet-ss-drag-move ss p1 "\nSpecify second point: " T))
           (progn (setq add (ssadd)
                        p1  (trans p1 1 0)
                        p2  (trans p2 1 0)
                  )
                  (vlax-for x (setq ss (vla-get-activeselectionset *AcadDoc*))
                    (vlax-invoke (setq temp (vla-copy x)) 'move p1 p2)
                    (ssadd (vlax-vla-object->ename temp) add)
                    (setq lst (cons temp lst))
                  )
                  (vla-delete ss)
                  T
           )
           (setq ang (acet-ss-drag-rotate add (trans p2 0 1) T))
      )
    (foreach x lst (vlax-invoke x 'rotate p2 ang))
  )

  (*error* nil)
  (princ)
)

[BlackBox]

Nice usage of acet-ss-drag-rotate, Alan. :beer:

I really need to go over the acet* functions again. LoL