(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
(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
)
;;; 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)
(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)))
(defun c:cr ( / s )
(if (setq s (ssget "_:L")) (command "_.rotate" s "" pause "_C" pause))
(princ)
)
(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))
Streamlined version of my earlier post (removed the system variable changes, and error handling):
(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)
)
Watch out for when 'entlast' is an attributed block, or 3D Polyline; and also for the setting of COPYMODE. :wink:
(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)
)
Nice usage of acet-ss-drag-rotate, Alan. :beer::)
I really need to go over the acet* functions again. LoL
(acet-ss-drag-move ss pt [prompt] [highlight [cursor]])
Drag a selection set to change location.
Arguments
ss: The selection set to drag.
pt: The base point.
prompt: A message to display before dragging is started.
highlight: If given, causes a rubber-band line to be drawn from pt to the current cursor position while dragging; this parameter can be nil to draw a rubber-band line in the inverse of the screen color, or non-nil to draw a highlighted line.
cursor: The cursor form to display while dragging (0=crosshairs, 1=no cursor, 2=target).
Return Values
Normally returns the selected point, but will honor initget settings and can return arbitrary text or keywords. Returns nil if the dragging operation is aborted.
Note:
The acet-ss-drag-move function does not move the selection set, but allows selection of a new position while showing how the result will appear.
(acet-ss-drag-rotate ss pt [prompt] [highlight [cursor]])
Drag a selection set to change rotation.
Arguments
ss: The selection set to drag.
pt: The base point.
prompt: A message to display before dragging is started.
highlight: If given, causes a rubber-band line to be drawn from pt to the current cursor position while dragging; this parameter can be nil to draw a rubber-band line in the inverse of the screen color, or non-nil to draw a highlighted line.
cursor: Gives the cursor form to display while dragging (0=crosshairs, 1=no cursor, 2=target).
Return Values
The selected rotation value, or nil if dragging is aborted.
Note:
The acet-ss-drag-rotate function does not rotate the selection set, but allows selection of a rotation value while showing how the result will appear.
(acet-ss-drag-scale ss pt [prompt] [highlight [cursor]])
Drag a selection set to change scale.
Arguments
ss: The selection set to drag.
pt: The base point.
prompt: A message to display before dragging is started.
highlight: If given, causes a rubber-band line to be drawn from pt to the current cursor position while dragging; this parameter can be nil to draw a rubber-band line in the inverse of the screen color, or non-nil to draw a highlighted line.
cursor: Gives the cursor form to display while dragging (0=crosshairs, 1=no cursor, 2=target).
Return Values
The selected scale factor, or nil if dragging is aborted.
Note:
The acet-ss-drag-scale function does not scale the selection set, but allows selection of a scaling factor while showing how the result will appear.
(http://www.theswamp.org/lilly_pond/alanjt/cough.gif)
Oops.(http://www.theswamp.org/lilly_pond/alanjt/cough.gif)
LoL - That's where I got those from, silly. :lol:
Edit - I wasn't sure if you'd mind my sharing the doc, so I posted the discussed functions only.
:lmao:Oops.(http://www.theswamp.org/lilly_pond/alanjt/cough.gif)
LoL - That's where I got those from, silly. :lol:
Edit - I wasn't sure if you'd mind my sharing the doc, so I posted the discussed functions only.
I didn't write the doc - found online when I started LISP'n.
(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
"_.move" s "" (getvar 'LASTPOINT)
)
)
(if c (setvar 'COPYMODE c))
(princ)
)
(defun c:cr ( / *error* c s )
(defun *error* (msg)
(if c (setvar 'COPYMODE c))
(if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))
(princ (strcat "\nError: " msg))
)
)
(if (setq c (getvar 'COPYMODE)) (setvar 'COPYMODE 1))
(defun cr nil
(if (not (eq s nil))
(progn
(command
"_.copy" s "" "_non" '(0 0 0) "_non" "@"
"_.move" s "" pause pause
"_.rotate" s "" "_non" (getvar 'LASTPOINT) pause
"_.move" s "" (getvar 'LASTPOINT) pause
)
(cr)
)
(progn
(setq s (ssget "_:L"))
(command
"_.copy" s "" "_non" '(0 0 0) "_non" "@"
"_.move" s "" pause pause
"_.rotate" s "" "_non" (getvar 'LASTPOINT) pause
"_.move" s "" (getvar 'LASTPOINT) pause
)
(cr)
)
)
)
(cr)
(*error* nil)
(princ)
)
(defun c:mr ( / s )
(defun mr nil
(if (not (eq s nil))
(progn
(command
"_.move" s "" pause pause
"_.rotate" s "" "_non" (getvar 'LASTPOINT) pause
)
(mr)
)
(progn
(setq s (ssget "_:L"))
(command
"_.move" s "" pause pause
"_.rotate" s "" "_non" (getvar 'LASTPOINT) pause
)
(mr)
)
)
)
(mr)
(princ)
)
(setq s (car(entsel)));;(ssget "_:L"))
(setq p (cdr(assoc 10 (entget s))));;(getpoint "\nPick base point : "))
super Thanks
I can really use
super Danke
kann ich gut gebrauchen
Thank ribarm.
Why I click Right mouse for rotation is no active, but if (eq (car gr) 11)) is OK
Thank ribarm.
Why I click Right mouse for rotation is no active, but if (eq (car gr) 11)) is OK
Here, I've updated code once more and finally - it should operate OK and with your case - value 11 of (car (grread)) for right mouse click... I've also included angles more than 180 degree in rotate-array with mouse input - had to add one more mouse click choice...Thank verry much ribarm
Regards, M.R.
:-)