Topic: Moving objects along their direction WITHOUT UCS command

[saunambon654]

In order to move objects along their direction, I write the code below.
To get direction of any objects, I used (command ".ucs" "ob") and select object. It works well in almost case.
 Only in Block Editor, the UCS command is not allowed.
So, could you please help me to solve it.
Thank you!

https://prnt.sc/puQIgqMUrw8Y

Code: [Select]

;MOVED - Moving objects along their direction
(defun c:MOVED(/ ss ent $orthomode)
  (princ "\nMOVED - Moving objects along their direction. Select objects: ")
  (and (setq ss (ssget))
      (sssetfirst ss ss)
       (setq ent (entsel "\nSelect object for direction:"))
       (progn
  (command ".ucs" "ob" ent)
  (setq $orthomode (getvar "orthomode"))
  (setvar "orthomode" 1)
  (command ".move" ss ""
   (progn
     (initget 1)
     (getpoint "\nMove from: "))
   (progn
     (princ "\nto point: ")
     pause))
(command ".ucs" "p")
(setvar "orthomode" $orthomode)
)
       ) 
  (princ)
  )
 

[dwaschnia]

Not sure why you would need a lisp for that, when you could just use object snaps.

[saunambon654]

Not sure why you would need a lisp for that, when you could just use object snaps.

Thank you dwaschnia,
Could you give some more explanations, I am yet to understand your idea.
Do you mean there is other way (no use UCS command) to:
- Get direction of any object, and
- Move objects with drag mode?

[danAllen]

Have you looked at SNAPANG? This allows setting ortho to a different angle, though it won't work for entering X&Y coordinates.

[saunambon654]

Have you looked at SNAPANG? This allows setting ortho to a different angle, though it won't work for entering X&Y coordinates.

I know that SNAPANG can rotate cross hair and after that, I can move objects along cross hair X or Y direction.
But I do not know how to get the direction of any object. Could you please help?

[saunambon654]

I found the Cursor Rotate from Lee Mac already. It is thing which I am looking for.
http://www.lee-mac.com/cursorrotate.html
From that, I found the way to change cross hair for any object:

Code: [Select]

(while
  (and (setq u (getpoint "\nPick point on object for snap angle: "))
     (setq l (nentselp u))
     (setq e (car l))
     (setq o (vlax-ename->vla-object e))
     (vlax-property-available-p o 'rotation)
     (setq a (vla-get-rotation o))
     (setvar "snapang" a)))But the function (nentselp [msg] [pt]) does not allow to select object. Can I select object instead pick point?

[Lee Mac]

Use nentsel or entsel to obtain the entity in place of getpoint/nentselp.

[danAllen]

I know that SNAPANG can rotate cross hair and after that, I can move objects along cross hair X or Y direction.
But I do not know how to get the direction of any object. Could you please help?

I use this simple code to pick two points and set the snap angle. It also turns off the snapping to grid which is turned on by the command.

Code: [Select]

;;;Set snap angle
(defun c:SSA  ()
  (princ "\nSet snap angle: ")
  (COMMAND "SNAP" "ROTATE" PAUSE PAUSE "SNAP" "OFF")
  (PRINc)
)

This command selects an entity and the last turns off snap rotaton

Code: [Select]

;;; set axis by picking entity
(defun c:SRE (/ ent sp ed)
       (setq ent (entget(car(entsel "\nSelect line: ")))
             sp  (trans (cdr (assoc 10 ent)) 0 1)
             ed  (trans (cdr (assoc 11 ent)) 0 1)
       )
          (COMMAND "SNAP" "ROTATE" SP ED "SNAP" "OFF")
       (princ)
)

;;;Turn off snap angle (set to 0)
(defun c:SRO ()
  (COMMAND "SNAP" "ROTATE" "0,0" "0" "SNAP" "OFF")
  (princ "\nSnap angle turned off (set to 0)")
  (PRINc)
)


[saunambon654]

Use nentsel or entsel to obtain the entity in place of getpoint/nentselp.

Thank Lee,
I have made your code become sub-function with input data by a point. It is really good.

Code: [Select]

;MoD - Moving objects along their direction
(defun c:MoD(/ ss ent $snapang $orthomode)
 
; Sub - Funtion---------------------------------------------------------------------
(defun Sub-CursorRotate(u / a e f l o v x z ) 
  ;u = point

;http://www.lee-mac.com/cursorrotate.html
;;-------------------------=={ Cursor Rotate }==------------------------;;
;;                                                                      ;;
;;  This program allows the user to rotate the AutoCAD crosshairs       ;;
;;  (that is, modifying the SNAPANG system variable) to align with an   ;;
;;  object residing at a selected point, to a fixed angle, or a fixed   ;;
;;  percentage representing a slope or incline grade.                   ;;
;;----------------------------------------------------------------------;;
;;  Author:  Lee Mac, Copyright © 2015  -  www.lee-mac.com              ;;
;;----------------------------------------------------------------------;;
;;  Version 1.0    -    2015-09-25                                      ;;
;;                                                                      ;;
;;  First release.                                                      ;;
;;----------------------------------------------------------------------;;

  (setq z (trans '(0 0 1) 1 0 t)
x (angle '(0 0) (trans (getvar 'ucsxdir) 0 z t))
l (nentselp u))
  (if (or (and (setq e (car l)
     o (vlax-ename->vla-object e))
       (vlax-property-available-p o 'rotation)
       (setq a (vla-get-rotation o)))
  (and (not (vl-catch-all-error-p (setq u (vl-catch-all-apply 'vlax-curve-getclosestpointto (list e (trans u 1 0))))))
       (setq a (angle '(0 0) (trans (vlax-curve-getfirstderiv e (vlax-curve-getparamatpoint e u)) 0 z)))))
    (if (caddr l)
      (setq f (lambda ( x ) (reverse (cdr (reverse x))))
    v (list (cos a) (sin a) 0.0)
    v (mapcar '(lambda ( x ) (apply '+ (mapcar '* (f x) v))) (f (caddr l)))
    a (angle '(0 0) (trans v 0 z)))))
  (if
    (and
      a
      x
      (setvar 'snapang (- a x)))
    T
    nil)
  )
; Sub - Funtion---------------------------------------------------------------------
;Main - Funtion---------------------------------------------------------------------
  (princ "\nMoD - Moving objects along their direction. Select objects: ")
  (and
    (setq ss (ssget))
    (sssetfirst ss ss)
    (setq ent (nentsel "\nSelect object for direction:"))
    (setq $snapang   (getvar "snapang")
  $orthomode (getvar "orthomode"))
    (if (Sub-CursorRotate (cadr ent));succes
      (progn
(setvar "orthomode" 1)
(command ".move" ss ""
(progn
   (initget 1)
   (getpoint "\nMove from: "))
(progn
   (princ "\nto point: ")
   pause))
(setvar "snapang"   $snapang)
(setvar "orthomode" $orthomode))
      (princ "\nUnable detect the object's direction.")
      );if
    );and
  (princ)
  );defun