; Created by Grrr: http://www.cadtutor.net/forum/showthread.php?97029-SS-Manipulator-(grread)
; SS-manipulator.lsp
; Credits: CAB, Lee Mac, Tharwat, Jef!, fixo

; original code by CAB, posted by fixo

; Works with implied selection
; Select objects to manipulate, Press [W/A/S/D] to move, [Q/E] to rotate, [TAB] to mirror by Y axis, [+/-] to scale, [O]ptions, e[X]it

; [O]ptions:
; Specify moving increment value (default 50 units)
; Specify rotating increment value (default 22,5 degrees)
; Specify scaling increment value (default 5 %)
; Specify new basepoint

(defun c:SSM (/) (c:SS-manipulator)) ; command Shortcut
(defun c:SS-manipulator (/ *error* SelectedFirst SS pt bbox MC oldcmdecho oldPDMODE temp-MC ) ; I didn't put "dist", "ang" and "scalef" as arguments on purpose

(defun *error* ( msg )
(if go (setq go nil))
(if loopFlag (setq loopFlag nil))
(if (and (= 'ename (type temp-MC)) (entget temp-MC))
(entdel temp-MC)
)
(sssetfirst nil nil)
(setvar 'CMDECHO oldcmdecho)
(setvar 'PDMODE oldPDMODE)
(if (not (member msg '("Function cancelled" "quit / exit abort")))
(princ (strcat "\nError: " msg))
)
(princ)
)

(if (setq SelectedFirst (ssget "_I"))
(sssetfirst nil nil);required
)

(setq oldcmdecho (getvar 'CMDECHO))
(setq oldPDMODE (getvar 'PDMODE))

(setq go T)

(while go
(and

(if SelectedFirst
(setq SS SelectedFirst) ; TRUE
(progn ; FALSE
(princ "\n>>> Select objects to manipulate <<<")
(setq SS (ssget "_:L"))
)
)
(setq bbox (LM:ssboundingbox ss))
(setq MC (apply 'mapcar (cons '(lambda ( a b ) (/ (+ a b) 2.0)) bbox)) ) ; basepoint
(sssetfirst nil SS) ; grip the selection to see what we've moving/rotating
);and
(progn
(setq go nil)
(defun DtR (d) ( * PI (/ d 180.0)))
(defun RtD (r) (* 180.0 (/ r PI)))
(if (not dist) (setq dist 50.0)) ; moving distance
(if (not ang) (setq ang 22.5)) ; rotation angle
(if (not scalef) (setq scalef 5.0)) ; scale factor in %
(setvar 'CMDECHO 0)
(setvar 'PDMODE 35)
; temporary entmake the base point:
(entmakex
(list
(cons 0 "POINT")
(cons 62 1)
(cons 10 MC)
)
)
(setq temp-MC (entlast))
(ssadd temp-MC SS)

(princ (strcat "\n<> | Move: " (rtos dist 2) " units | Rotate: " (rtos ang 2) " degrees | Scale: " (rtos scalef 2) " %"))
(princ (strcat "\nPress [W/A/S/D] to move, [Q/E] to rotate, [TAB] to mirror by Y axis, [+/-] to scale, [O]ptions, e[X]it"))

(setq LoopFlag T)
(while LoopFlag
(setq UserIn (grread))
(setq ReturnChar (cadr UserIn))

(cond
((= ReturnChar 97) ; A
(command "_.move" SS "" "_non" MC "_non" (setq MC (polar MC (DtR 180) dist)))
(sssetfirst nil SS) ; grip the selection to see what we've moving/rotating
(princ (strcat "\n<> | Move: " (rtos dist 2) " units | Rotate: " (rtos ang 2) " degrees | Scale: " (rtos scalef 2) " %"))
(princ (strcat "\nPress [W/A/S/D] to move, [Q/E] to rotate, [TAB] to mirror by Y axis, [+/-] to scale, [O]ptions, e[X]it"))
) ; A
((= ReturnChar 100) ; D
(command "_.move" SS "" "_non" MC "_non" (setq MC (polar MC (DtR 0) dist)))
(sssetfirst nil SS) ; grip the selection to see what we've moving/rotating
(princ (strcat "\n<> | Move: " (rtos dist 2) " units | Rotate: " (rtos ang 2) " degrees | Scale: " (rtos scalef 2) " %"))
(princ (strcat "\nPress [W/A/S/D] to move, [Q/E] to rotate, [TAB] to mirror by Y axis, [+/-] to scale, [O]ptions, e[X]it"))
) ; D
((= ReturnChar 115) ; S
(command "_.move" SS "" "_non" MC "_non" (setq MC (polar MC (DtR 270) dist)))
(sssetfirst nil SS) ; grip the selection to see what we've moving/rotating
(princ (strcat "\n<> | Move: " (rtos dist 2) " units | Rotate: " (rtos ang 2) " degrees | Scale: " (rtos scalef 2) " %"))
(princ (strcat "\nPress [W/A/S/D] to move, [Q/E] to rotate, [TAB] to mirror by Y axis, [+/-] to scale, [O]ptions, e[X]it"))
) ; S
((= ReturnChar 119) ; W
(command "_.move" SS "" "_non" MC "_non" (setq MC (polar MC (DtR 90) dist)))
(sssetfirst nil SS) ; grip the selection to see what we've moving/rotating
(princ (strcat "\n<> | Move: " (rtos dist 2) " units | Rotate: " (rtos ang 2) " degrees | Scale: " (rtos scalef 2) " %"))
(princ (strcat "\nPress [W/A/S/D] to move, [Q/E] to rotate, [TAB] to mirror by Y axis, [+/-] to scale, [O]ptions, e[X]it"))
) ; W
((= ReturnChar 113) ; Q
(command "_.rotate" SS "" "_non" MC ang)
(sssetfirst nil SS) ; grip the selection to see what we've moving/rotating
(princ (strcat "\n<> | Move: " (rtos dist 2) " units | Rotate: " (rtos ang 2) " degrees | Scale: " (rtos scalef 2) " %"))
(princ (strcat "\nPress [W/A/S/D] to move, [Q/E] to rotate, [TAB] to mirror by Y axis, [+/-] to scale, [O]ptions, e[X]it"))
) ; Q
((= ReturnChar 101) ; E
(command "_.rotate" SS "" "_non" MC (* ang -1))
(sssetfirst nil SS) ; grip the selection to see what we've moving/rotating
(princ (strcat "\n<> | Move: " (rtos dist 2) " units | Rotate: " (rtos ang 2) " degrees | Scale: " (rtos scalef 2) " %"))
(princ (strcat "\nPress [W/A/S/D] to move, [Q/E] to rotate, [TAB] to mirror by Y axis, [+/-] to scale, [O]ptions, e[X]it"))
) ; E
((= ReturnChar 9) ; TAB
(command "_.mirror" SS "" "_non" MC "_non" (polar MC (DtR 90.0) dist) "_Y")
(sssetfirst nil SS) ; grip the selection to see what we've moving/rotating
(princ (strcat "\n<> | Move: " (rtos dist 2) " units | Rotate: " (rtos ang 2) " degrees | Scale: " (rtos scalef 2) " %"))
(princ (strcat "\nPress [W/A/S/D] to move, [Q/E] to rotate, [TAB] to mirror by Y axis, [+/-] to scale, [O]ptions, e[X]it"))
) ; TAB
((= ReturnChar 45) ; -
(command "_.scale" SS "" "_non" MC "R" 100.0 (- 100 (/ scalef 1.0))) ; %
(sssetfirst nil SS) ; grip the selection to see what we've moving/rotating
(princ (strcat "\n<> | Move: " (rtos dist 2) " units | Rotate: " (rtos ang 2) " degrees | Scale: " (rtos scalef 2) " %"))
(princ (strcat "\nPress [W/A/S/D] to move, [Q/E] to rotate, [TAB] to mirror by Y axis, [+/-] to scale, [O]ptions, e[X]it"))
) ; -
((= ReturnChar 43) ; +
(command "_.scale" SS "" "_non" MC "R" 100.0 (+ (/ scalef 1.0) 100)) ; %
(sssetfirst nil SS) ; grip the selection to see what we've moving/rotating
(princ (strcat "\n<> | Move: " (rtos dist 2) " units | Rotate: " (rtos ang 2) " degrees | Scale: " (rtos scalef 2) " %"))
(princ (strcat "\nPress [W/A/S/D] to move, [Q/E] to rotate, [TAB] to mirror by Y axis, [+/-] to scale, [O]ptions, e[X]it"))
) ; +
((= ReturnChar 111) ; O
(if (not keyw) (setq keyw "BasePoint"))
(initget "Moving Rotating Scaling BasePoint M R S BP")
(setq keyw (cond ((getkword (strcat "\nSpecify increment to change [Moving/Rotating/Scaling/BasePoint] : "))) ( keyw )))
(cond
( (or (= keyw "Moving") (= keyw "moving") (= keyw "MOVING") (= keyw "M") (= keyw "m") )
(initget (+ 2 4))
(if
(or
(setq dist (cond ((getreal (strcat "\nSpecify moving distance increment : "))) ( dist )))
(if (not dist) (setq dist 50.0))
)
(progn
(princ (strcat "\n<> | Move: " (rtos dist 2) " units | Rotate: " (rtos ang 2) " degrees | Scale: " (rtos scalef 2) " %"))
(princ (strcat "\nPress [W/A/S/D] to move, [Q/E] to rotate, [TAB] to mirror by Y axis, [+/-] to scale, [O]ptions, e[X]it"))
)
)
)
( (or (= keyw "Rotating") (= keyw "rotating") (= keyw "ROTATING") (= keyw "R") (= keyw "r") )
(initget (+ 2 4))
(if
(or
(setq ang (cond ((getreal (strcat "\nSpecify rotation angle increment : "))) ( ang )))
(if (not ang) (setq ang 22.5))
)
(progn
(princ (strcat "\n<> | Move: " (rtos dist 2) " units | Rotate: " (rtos ang 2) " degrees | Scale: " (rtos scalef 2) " %"))
(princ (strcat "\nPress [W/A/S/D] to move, [Q/E] to rotate, [TAB] to mirror by Y axis, [+/-] to scale, [O]ptions, e[X]it"))
)
)
)
( (or (= keyw "Scaling") (= keyw "scaling") (= keyw "SCALING") (= keyw "S") (= keyw "s") (= keyw "SC") (= keyw "sc") )
(initget (+ 2 4))
(if
(or
(setq scalef (cond ((getreal (strcat "\nSpecify scaling factor increment : "))) ( scalef )))
(if (not scalef) (setq scalef 5.0))
)
(progn
(princ (strcat "\n<> | Move: " (rtos dist 2) " units | Rotate: " (rtos ang 2) " degrees | Scale: " (rtos scalef 2) " %"))
(princ (strcat "\nPress [W/A/S/D] to move, [Q/E] to rotate, [TAB] to mirror by Y axis, [+/-] to scale, [O]ptions, e[X]it"))
)
)
)
( (or (= keyw "Basepoint") (= keyw "BasePoint") (= keyw "basepoint") (= keyw "BASEPOINT") (= keyw "B") (= keyw "b") (= keyw "BP") (= keyw "bp") )
(if
(setq MC (getpoint "\nSpecify new basepoint: "))
(progn
(if (and (= 'ename (type temp-MC)) (entget temp-MC))
(entdel temp-MC)
)
(entmakex
(list
(cons 0 "POINT")
(cons 62 1)
(cons 10 MC)
)
)
(setq temp-MC (entlast))
(ssadd temp-MC SS)
)
)
)
(T nil)
);cond
) ; O
(T nil)
)
(if (= ReturnChar 120) ; X key to exit, and prompt for new SS
(progn
(setq go T)
(setq loopFlag nil)
(princ "\nX key is pressed, command interrupted by user")
(if (and (= 'ename (type temp-MC)) (entget temp-MC))
(entdel temp-MC)
)
(sssetfirst nil nil)
(setvar 'CMDECHO oldcmdecho)
(setvar 'PDMODE oldPDMODE)
)
);if

); while Loopflag
);progn
); while go
(princ)
);defun

;; Selection Set Bounding Box - Lee Mac
;; Returns a list of the lower-left and upper-right WCS coordinates of a
;; rectangular frame bounding all objects in a supplied selection set.
;; s - [sel] Selection set for which to return bounding box

(defun LM:ssboundingbox ( s / a b i m n o )
(repeat (setq i (sslength s))
(if
(and
(setq o (vlax-ename->vla-object (ssname s (setq i (1- i)))))
(vlax-method-applicable-p o 'getboundingbox)
(not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list o 'a 'b))))
)
(setq m (cons (vlax-safearray->list a) m)
n (cons (vlax-safearray->list b) n)
)
)
)
(if (and m n)
(mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list m n))
)
)
(c:ssm)

Advertisements