TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: ELOQUINTET on August 11, 2004, 01:10:55 AM
-
i have this routine for copy rotate combined but there's a problem. when it copies the new copy has 2 duplicates one on top of another. i just want one copy of the original i can rotate. does this make sense, try it and see what i mean. or does anyone have something else that does what i want. thanks
(defun c:cr ()
(princ "\nCopy & Rotate:\n")
(setq ss (ssget))
(command "copy" ss "" "0" "0")(command "move" ss "" pause pause)(command "rotate" ss "" "@" pause))
-
Perhaps something like this < modified a little > :
(defun c:cr (/ ss)
(princ "\nCopy & Rotate:\n")
(setq ss (ssget))
;;;;(command "copy" ss "" "0" "0") ;; superfluous command
(princ "Select From and To points :")
(command "move" "_Prev" "" pause pause)
(princ "Select Rotation Angle :")
(command "rotate" "_Prev" "" "@" pause)
(princ)
)
-
Perhaps something like this < modified a little > :
(defun c:cr (/ ss)
(princ "\nCopy & Rotate:\n")
(setq ss (ssget))
;;;;(command "copy" ss "" "0" "0") ;; superfluous command
(princ "Select From and To points :")
(command "move" "_Prev" "" pause pause)
(princ "Select Rotation Angle :")
(command "rotate" "_Prev" "" "@" pause)
(princ)
)
Looks like a MOVE & rotate to me, what am I missing?
-
i have this routine for copy rotate combined but there's a problem. when it copies the new copy has 2 duplicates one on top of another. i just want one copy of the original i can rotate. does this make sense, try it and see what i mean. or does anyone have something else that does what i want. thanks
(defun c:cr ()
(princ "\nCopy & Rotate:\n")
(setq ss (ssget))
(command "copy" ss "" "0" "0")(command "move" ss "" pause pause)(command "rotate" ss "" "@" pause))
When I do it, there is only the original and the one new copy. Try MOCORO out of Express Tools (MOVE COPY ROTATE)
-
Looks like a MOVE & rotate to me, what am I missing?
Just seeing who is awake ...
-
well i copied it from my home computer last night so it maybe a move. see the original was a copy and i modified to make a move as well. it seems that only sometimes it duplicates what is being copied if that's possible. i think it is this lisp that is doing it, been trying to isolate the problem for a little while now. anyway i'll give yours a shot kerry and see how it goes. thanks alot
-
It is my understanding that vla-copy works differently than command copy. If you use copy "m" and try to copy objects at a set distance like every 4 feet, you have to type 4' 8' 16', whereas if you use copym from express tools you can achieve the same thing by typing 4' 4' 4' or 4' repeat, etc. This is achieved through vla-copy and vla-move. It sounds like that is what you're after.
As I reread, maybe not, but it should give you something to think about.
-
Here are my (stolen) CR and MR (Copy Rotate & Move Rotate) if anyone's interested...
Copy & Rotate
;;CR is a command to allow you to copy an object and then do
;;a rotate right after it. Once loaded just type in CR to activate
;;the command.
(defun newgroups (/ GRPS OD GRP1 CHCKR GRPS GNAME)
(setq OD (namedobjdict))
(setq GRPS (dictnext OD "acad_group"))
(while (/= CHCKR 3)
(setq GRP1 (car GRPS))
(setq GRPS (cdr GRPS))
(setq chckr (car GRP1))
(if (= chckr 3)
(progn
(setq NGROUPS (list (cdr GRP1)))
)
)
)
(while (/= GRPS nil)
(setq GRP1 (car GRPS))
(setq GRPS (cdr GRPS))
(setq chckr (car GRP1))
(if (= chckr 3)
(progn
(setq GNAME (cdr GRP1))
(setq NGROUPS (cons GNAME NGROUPS))
)
)
)
(setq EXGNAME (car NGROUPS))
)
;;Error Tile
(defun MYERROR (S)
(if (/= S "\nFunction cancelled" )
(princ "\nEnding Copy Rotate..." ))
(command "-group" "e" "copier")
(command "undo" "end")
(command "u" "u")
(setvar "CMDECHO" CMD)
(setq *ERROR* OLDERR )
(princ)
)
;; Main section of Copy Rotate
(defun c:CR (/ SS1 PT1 PT2)
(setq SS1 nil)
(setq CMD (getvar "CMDECHO"))
(setq OLDERR *ERROR*)
(setq *ERROR* MYERROR)
(command "undo" "begin")
(setvar "CMDECHO" 0)
(prompt "\nSelect Objects to Copy and Rotate: ")
(setq SS1 (ssget))
(command "-group" "" "copier" "" SS1 "")
(setq PT1 (getpoint "\nFirst Point of displacement: "))
(prompt "\Second Point of Displacment: ")
(command "._copy" "g" "copier" "" PT1 pause)
(setq PT2 (getvar "LASTPOINT"))
(prompt "\nSelect Angle of Rotation: ")
(command "._rotate" "last" "" PT2 pause)
(command "-group" "e" "copier")
(newgroups)
(command "-group" "e" EXGNAME)
(command "undo" "end")
(setvar "CMDECHO" CMD)
(redraw)
(prompt "\nCopy Rotate complete....")
(princ)
) ;; End of Copy Rotate
Move & Rotate
;;MR.LSP
;;MR is a command that allows you to MOVE an object(s) and then
;;perform a ROTATE right after it. Once loaded just type in MR to activate
;;the command.
(defun c:MR (/ SS1)
;;Error Tile
(defun MYERROR (S) ;;error trap program
(if (/= S "\nFunction canceled")
(princ "\nEnding Rotate-Move...")
)
(command "undo" "end")
(command "u")
(setvar "CMDECHO" CMD)
(setq *ERROR* OLDERR )
(princ)
)
(setq CMD (getvar "cmdecho"))
(setq OLDERR *ERROR*)
(setq *ERROR* MYERROR)
(setvar "cmdecho" 0)
(command "undo" "begin")
(prompt "\nSelect objects to Rotate and then Move: ")
(setq SS1 (ssget))
(prompt "\nEnter First Point of Displacement: ")
(command "move" SS1 "" PAUSE PAUSE)
(prompt "\nEnter Angle of Rotation: ")
(setq PT1 (getpoint "\nEnter First Point of Displacement: "))
(command "rotate" SS1 "" PT1 PAUSE)
(command "undo" "end")
(setq *ERROR* OLDERR )
(setvar "cmdecho" CMD)
(princ)
)
-
yeah i know about the express but i don't really care for how it functions. i prefer commands that do one specific thing instead of having to tell it which option i want. anyway i'll try your too mdub thanks
-
Mike....
Tried your "CR" routine....it moves the object....doesn't leave the original.....the rotate part works super, though....
?????
-
Mike....
Tried your "CR" routine....it moves the object....doesn't leave the original.....the rotate part works super, though....
?????
I dunno...It works fine on my machine...I'll have a look.
-
Dan, they were just examples of how vla-copy and command copy work differently. I wasn't saying to use copym to solve your problem, just that vla-copy might be another road to take. There's a lot more to copym in express tools than vla-copy.
-
Mike....
Tried your "CR" routine....it moves the object....doesn't leave the original.....the rotate part works super, though....
?????
Leaves the original in place on mine TBear. :?
-
why not create our own ?
this should get us started :roll: it might need a little more error trapping.
;;; copy then rotate 1.1
;;; point selection method
(defun get-point (util_obj st_pt msg / pt)
(cond ((and st_pt msg)
(setq pt
(vl-catch-all-apply
'vlax-invoke-method
(list util_obj 'GetPoint st_pt msg)
)
))
((and st_pt (not msg))
(setq pt
(vl-catch-all-apply
'vlax-invoke-method
(list util_obj 'GetPoint st_pt)
)
))
((and msg (not st_pt))
(setq pt
(vl-catch-all-apply
'vlax-invoke-method
(list util_obj 'GetPoint nil msg)
)
))
(T (setq pt
(vl-catch-all-apply
'vlax-invoke-method
(list util_obj 'GetPoint)
)
))
); cond
(if (not (vl-catch-all-error-p pt))
pt nil)
)
(defun release-obj (obj)
(if
(= (type obj) 'VLA-OBJECT)
(if (not (vlax-object-released-p obj))
(vlax-release-object obj)
)
)
)
(defun get-angle (util_obj pt msg / ang)
(setq ang
(vl-catch-all-apply
'vlax-invoke-method
(list util_obj 'GetAngle pt (vlax-make-variant msg))
)
)
(if (not (vl-catch-all-error-p ang))
ang nil)
)
(defun c:cp-rt (/ active_doc util_obj get_ent obj
pt p1 p2 cp_obj ang)
(vl-load-com)
(setq active_doc (vla-get-activedocument (vlax-get-acad-object))
util_obj (vla-get-utility active_doc)
)
(setq get_ent
(vl-catch-all-apply
'vlax-invoke-method
(list util_obj 'GetEntity 'obj 'pt)
)
)
(if (not (vl-catch-all-error-p get_ent))
(if (setq p1 (get-point util_obj nil "\nSelect copy base point: "))
(if (setq p2 (get-point util_obj p1 "\nTo point: "))
(vla-move (setq cp_obj (vla-copy obj)) p1 p2)
)
)
)
(if cp_obj
(progn
(if (setq p1 (get-point util_obj nil "\nSelect rotation base point: "))
(if (setq ang (get-angle util_obj p1 "\nRotation angle: "))
(vla-rotate cp_obj p1 ang)
)
)
(release-obj cp_obj)
)
)
(mapcar 'release-obj (list active_doc util_obj))
(princ)
); defun cp-rt
-
Mike....
Well that's wierd! I deleted the routine, reloaded it and dropped it into my startup suite....works OK now.....go figure.
Thanks, amigo.
-
Cheers!
I'm glad I posted it.
-
Mark, that looks like a nice routine. I like the way you released your objects.
-
Thanks Daron but it has some limitations
-
thanks guys mdub you are the winner works great for me presh
-
Hey, I didn't write it...I just posted it. ;)
-
yeah i know ya thief :P
-
Isn't Copy and Rotate another way to say Array Polar :o :lol:
-
yeah the same as hurricane too
-
I am afraid that a hurricane is only Move/rotate, it does not create duplicates :twisted:
-
all great things have duplicates, tropical storms are always tryin to be hurricanes
-
Here is another version of Copy/Rotate:
;;; CopyRotate.lsp by Charles Alan Butler
;;; by Precision Drafting & Design All Rights Reserved.
;;; Contact at ab2draft[at]TampaBay.rr.com
;;;
;;; Version 4.0 Beta Feb 07,2005
;;;
;;; DESCRIPTION
;;; User pick base point then selects object(s)
;;; Paste mode until Escape is pressed
;;; Once pasted user selects rotation angle
;;;
;;; Command Line Usage
;;; Command: copyr
;; Copy objects, then paste & rotate new copy
;; does not show the objects during paste
(defun c:copyr (/ pt ss elast 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
)
)
)
(if (and (setq pt (getpoint "\nPick base point of object to copy:"))
(null (prompt "\nSelect objects to copy:"))
(setq ss (ssget))
)
(progn
(command "._copybase" pt ss "")
(while (setq pt (getpoint "\nPick insertion point."))
;; get last item in database
(setq elast (ale_lastent))
(command "._pasteclip" pt)
;; get new items pasted.
(setq ssnew (ale_ss-after elast))
;; allow user to rotate
(command "._rotate" ssnew "" pt pause)
) ; while
) ; progn
) ; endif
(princ)
)
(princ)
<edit: code updated>
-
I'm using my own code:
(defun c:movrot () (b-cmr "M")(princ))
(defun c:coprot () (b-cmr "C")(princ))
;***************************************************************************
; File : mcr.lsp
; Date : 20-9-03
; Function : (B-CMR <MODE>)
; Purpose : Copy+Rotate or Move+Rotate
; Arguments : <MODE> = "C" -> Copy-rotate
; = "M" -> Move-rotate
; Written by : J.J.Damstra
;***************************************************************************
(defun b-cmr (typ / ss1 temp p0 p1)
(setq ss1 (ssget "I"))
(command ".undo" "begin")
(setq temp (getvar "CMDECHO"))(setvar "CMDECHO" 0)
(if (not ss1)(setq ss1 (ssget)))
(if ss1
(progn
(initget 1)
(setq p0 (getpoint "\nBasepoint : "))
(if (= typ "C")
(progn
(setq p1 (getpoint "\nTranslation or <ENTER>: " p0))
(if (not p1)(setq p1 p0))
(command ".copy" ss1 "" "0,0" "0,0")
)
(while (not p1)(setq p1 (getpoint "\nTranslation : " p0)))
)
(command ".move" ss1 "" p0 p1)
(command ".rotate" ss1 "" p1 pause)
)
(princ "\nMsg> Nothing selected! ")
)
(command ".undo" "end")
(setvar "CMDECHO" temp)
(princ)
)
All examples in this topic have a minor bug: The translation is performed with the selected objects, but the selected objects shouldn't be moved!
If you now use PREVIOUS to make a selection in the next command you don't get what expect, but the 'new' objects.
In my example after the COPY-command you should make a new selection with the new objects.
-
Thanks a lot for posting that one, Crack.
I think I'm going to replace the routines I was using with this one.
Welcome to TheSwamp!
-
yeah i like that one better too the other one made a group of the copied entities which took forever to regen and not what i want. anyway thanks crack