Moves a set of objects such as the selection will be at a given ortho distance from a reference point to a given point. Points can be picked in any order but one of them must be on an object in the selection.
Command:
- MOVE_ORTHO_FIX
AutoLISP code
Lisp
(princ
(strcat
"\nProgram to move objects at calculated ortho distance."
"\nMoves as such as the selection will be at the desired distance to a given point. "
"\nOptimized for any custom UCS"
"\nCommand: "
"\nMOVE_ORTHO_FIX"
"\n(c) "
(substr (rtos (getvar "CDATE") 2 0) 1 4)
" lisp-solutions.com"
)
)
(defun C:MOVE_ORTHO_FIX (/ ddist dpoint fdist mine ob1 olddist other p1 p2 sign ss
vec0 xy
)
(setq ss (cadr (SSGETFIRST)))
(if (not ss)
(setq ss (ssget))
)
(setq p1 (GETPOINT "\nInitial distance>>"))
(setq p2 (GETPOINT "\n>>" p1))
(setq ob1 (nentselp p1))
(setq ob1 (if (= 2 (length ob1))
(car ob1)
(car (last ob1)) ; if block
)
)
(if (SSMEMB ob1 ss)
(setq mine p1
other p2
)
(setq mine p2
other p1
)
)
(setq vec0 (mapcar '- p1 p2))
(setq vec0 (mapcar 'abs (list (car vec0) (cadr vec0))))
(setq xy (vl-position (apply 'max vec0) vec0)) ; x or y
(setq oldDist (abs (- (nth xy mine) (nth xy other)))) ;ortho distance
(setq sign (if (> (nth xy mine) (nth xy other))
1
-1
)
)
(setq fdist (getdist
(strcat "\nDesired distance <Actual ortho distance = "
(rtos oldDist 2 2)
">:"
)
)
)
(setq ddist (* sign (- fdist oldDist)))
(setq dpoint (if (= xy 0)
(list ddist 0)
(list 0 ddist)
)
)
(COMMAND "_MOVE" ss "" "_D" dpoint)
)