Author Topic: Moving objects along their direction WITHOUT UCS command  (Read 970 times)

0 Members and 1 Guest are viewing this topic.

saunambon654

  • Mosquito
  • Posts: 13
Moving objects along their direction WITHOUT UCS command
« on: March 03, 2023, 09:23:08 AM »
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

  • Mosquito
  • Posts: 13
Re: Moving objects along their direction WITHOUT UCS command
« Reply #1 on: March 03, 2023, 10:43:39 AM »
Not sure why you would need a lisp for that, when you could just use object snaps.

saunambon654

  • Mosquito
  • Posts: 13
Re: Moving objects along their direction WITHOUT UCS command
« Reply #2 on: March 03, 2023, 08:21:18 PM »
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?
« Last Edit: March 03, 2023, 08:25:05 PM by saunambon654 »

danAllen

  • Newt
  • Posts: 132
Re: Moving objects along their direction WITHOUT UCS command
« Reply #3 on: March 03, 2023, 11:39:04 PM »
Have you looked at SNAPANG? This allows setting ortho to a different angle, though it won't work for entering X&Y coordinates.

saunambon654

  • Mosquito
  • Posts: 13
Re: Moving objects along their direction WITHOUT UCS command
« Reply #4 on: March 04, 2023, 01:56:34 AM »
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

  • Mosquito
  • Posts: 13
Re: Moving objects along their direction WITHOUT UCS command
« Reply #5 on: March 04, 2023, 08:57:35 AM »
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

  • Seagull
  • Posts: 12905
  • London, England
Re: Moving objects along their direction WITHOUT UCS command
« Reply #6 on: March 05, 2023, 05:49:50 PM »
Use nentsel or entsel to obtain the entity in place of getpoint/nentselp.

danAllen

  • Newt
  • Posts: 132
Re: Moving objects along their direction WITHOUT UCS command
« Reply #7 on: March 06, 2023, 05:13:58 PM »
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

  • Mosquito
  • Posts: 13
Re: Moving objects along their direction WITHOUT UCS command
« Reply #8 on: March 06, 2023, 07:39:48 PM »
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