Author Topic: Cursor Rotate  (Read 17785 times)

0 Members and 1 Guest are viewing this topic.

Dave M

  • Newt
  • Posts: 196
Re: Cursor Rotate
« Reply #45 on: September 24, 2015, 07:11:04 PM »
Lee,
I am a Civil 3D user, and when doing road design sometimes I will use vanilla line work when laying out road profiles, vertical curves and the like.
So, if I want to draw a line at a 2% grade, I set the snapang variable by getting the arctangent of 0.02.
Here is an example:
Command: SNAPANG
Enter new value for SNAPANG <0.0000>: 'cal
>>>> Expression: atan(.02)
Resuming SETVAR command.
Enter new value for SNAPANG <0.0000>: 1.1457628381751
Civil 3D 2018 - Microstation SS4 - Windows 10 - Dropbox

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: Cursor Rotate
« Reply #46 on: September 25, 2015, 05:41:49 AM »
Shoot, doesn't work on a mirrored block - a block where the lines which are members of the block are at an angle and the block is inserted without any rotation, but the block has been mirrored.

In the attached drawing, the diagonal member on the right is a nested block, inserted without rotation. The diagonal member on the left is a mirrored copy of the other. So the Lisp routine works as expected when clicking on the diagonal member on the right, but not for the diagonal member on the left.

Lee,
I am a Civil 3D user, and when doing road design sometimes I will use vanilla line work when laying out road profiles, vertical curves and the like.
So, if I want to draw a line at a 2% grade, I set the snapang variable by getting the arctangent of 0.02.
Here is an example:
Command: SNAPANG
Enter new value for SNAPANG <0.0000>: 'cal
>>>> Expression: atan(.02)
Resuming SETVAR command.
Enter new value for SNAPANG <0.0000>: 1.1457628381751

Thank you both for the feedback - please try the following code instead:

Code - Auto/Visual Lisp: [Select]
  1. (defun c:rsa ( / a e f l o u v x z )
  2.     (setq z (trans '(0 0 1) 1 0 t)
  3.           x (angle '(0 0) (trans (getvar 'ucsxdir) 0 z t))
  4.     )
  5.     (while
  6.         (cond
  7.             (   (or (null u) (= "Object" u))
  8.                 (initget "Angle Grade Cancel")
  9.                 (setq u (cond ((getpoint "\nPick point on object [Angle/Grade/Cancel] <Angle>: ")) ("Angle")))
  10.                 (cond
  11.                     (   (= 'str (type u)))
  12.                     (   (null (setq l (nentselp u)))
  13.                         (princ "\nPoint does not lie on an object.")
  14.                     )
  15.                     (   (or (and (setq e (car l)
  16.                                        o (vlax-ename->vla-object e)
  17.                                  )
  18.                                  (vlax-property-available-p o 'rotation)
  19.                                  (setq a (vla-get-rotation o))
  20.                             )
  21.                             (and (not (vl-catch-all-error-p (setq u (vl-catch-all-apply 'vlax-curve-getclosestpointto (list e (trans u 1 0))))))
  22.                                  (setq a (angle '(0 0) (trans (vlax-curve-getfirstderiv e (vlax-curve-getparamatpoint e u)) 0 z)))
  23.                             )
  24.                         )
  25.                         (if (caddr l)
  26.                             (setq f (lambda ( x ) (reverse (cdr (reverse x))))
  27.                                   v (list (cos a) (sin a) 0.0)
  28.                                   v (mapcar '(lambda ( x ) (apply '+ (mapcar '* (f x) v))) (f (caddr l)))
  29.                                   a (angle '(0 0) (trans v 0 z))
  30.                             )
  31.                         )
  32.                         (not (setvar 'snapang (- a x)))
  33.                     )
  34.                     (   (princ "\nIncompatible object selected."))
  35.                 )
  36.             )
  37.             (   (= "Angle" u)
  38.                 (initget "Object Grade Cancel")
  39.                 (if (numberp (setq u (getangle "\nSpecify angle [Object/Grade/Cancel] <Object>: ")))
  40.                     (not (setvar 'snapang u))
  41.                     t
  42.                 )
  43.             )
  44.             (   (= "Grade" u)
  45.                 (initget "Object Angle Cancel")
  46.                 (if (numberp (setq u (getreal "\nSpecify grade (%) [Object/Angle/Cancel] <Object>: ")))
  47.                     (not (setvar 'snapang (atan (/ u 100.0))))
  48.                     t
  49.                 )
  50.             )
  51.             (   (= "Cancel" u) nil)
  52.         )
  53.     )
  54.     (princ)
  55. )

novice

  • Guest
Re: Cursor Rotate
« Reply #47 on: September 25, 2015, 07:03:05 AM »
Unbelievable, Lee. What a great Lisp routine! You make it look so easy.

Quote from: Lee Mac
I didn't realize this sort of program would prove so useful to so many members...

It's the cat's meow.

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: Cursor Rotate
« Reply #48 on: September 25, 2015, 08:58:10 AM »
Thank you novice, I'm glad you like the final code  :-)

Dave M

  • Newt
  • Posts: 196
Re: Cursor Rotate
« Reply #49 on: September 25, 2015, 11:10:35 AM »
Lee,
Stellar job as usual.  I envy your abilities!  I'll be adding this to my quiver.  Here's a routine I wrote a long time ago.  I use it all the time.  Maybe it can be a benefit to others.
 
Thanks again,
 
Dave
Code: [Select]
;ROTATES CROSSHAIRS TO BE ORTHOGRAPHIC WITH CURRENT VIEW
;FUNCTION TO CHANGE RADIANS TO DEGREES
(DEFUN RTD (A)
 (/ (* A 180.0) pi)
)
;MAIN PROGRAM
(DEFUN C:RXH (/ A B C)
  (SETQ A (GETVAR "VIEWTWIST")) ;GET VIEWTWIST
  (SETQ B (RTD A))  ;CONVERT VIEWTWIST FROM RADIANS TO DEGREES
  (SETQ C (- 360 B))  ;SUBTRACT VIEWTWIST FROM 360
  (COMMAND "SNAPANG" C)  ;SET SNAP ANGLE TO BE ORTHOGRAPHIC TO VIEW
)

Civil 3D 2018 - Microstation SS4 - Windows 10 - Dropbox

RGUS

  • Newt
  • Posts: 106
Re: Cursor Rotate
« Reply #50 on: October 04, 2017, 12:19:39 AM »
Shoot, doesn't work on a mirrored block - a block where the lines which are members of the block are at an angle and the block is inserted without any rotation, but the block has been mirrored.

In the attached drawing, the diagonal member on the right is a nested block, inserted without rotation. The diagonal member on the left is a mirrored copy of the other. So the Lisp routine works as expected when clicking on the diagonal member on the right, but not for the diagonal member on the left.

Lee,
I am a Civil 3D user, and when doing road design sometimes I will use vanilla line work when laying out road profiles, vertical curves and the like.
So, if I want to draw a line at a 2% grade, I set the snapang variable by getting the arctangent of 0.02.
Here is an example:
Command: SNAPANG
Enter new value for SNAPANG <0.0000>: 'cal
>>>> Expression: atan(.02)
Resuming SETVAR command.
Enter new value for SNAPANG <0.0000>: 1.1457628381751

Thank you both for the feedback - please try the following code instead:

Code - Auto/Visual Lisp: [Select]
  1. (defun c:rsa ( / a e f l o u v x z )
  2.     (setq z (trans '(0 0 1) 1 0 t)
  3.           x (angle '(0 0) (trans (getvar 'ucsxdir) 0 z t))
  4.     )
  5.     (while
  6.         (cond
  7.             (   (or (null u) (= "Object" u))
  8.                 (initget "Angle Grade Cancel")
  9.                 (setq u (cond ((getpoint "\nPick point on object [Angle/Grade/Cancel] <Angle>: ")) ("Angle")))
  10.                 (cond
  11.                     (   (= 'str (type u)))
  12.                     (   (null (setq l (nentselp u)))
  13.                         (princ "\nPoint does not lie on an object.")
  14.                     )
  15.                     (   (or (and (setq e (car l)
  16.                                        o (vlax-ename->vla-object e)
  17.                                  )
  18.                                  (vlax-property-available-p o 'rotation)
  19.                                  (setq a (vla-get-rotation o))
  20.                             )
  21.                             (and (not (vl-catch-all-error-p (setq u (vl-catch-all-apply 'vlax-curve-getclosestpointto (list e (trans u 1 0))))))
  22.                                  (setq a (angle '(0 0) (trans (vlax-curve-getfirstderiv e (vlax-curve-getparamatpoint e u)) 0 z)))
  23.                             )
  24.                         )
  25.                         (if (caddr l)
  26.                             (setq f (lambda ( x ) (reverse (cdr (reverse x))))
  27.                                   v (list (cos a) (sin a) 0.0)
  28.                                   v (mapcar '(lambda ( x ) (apply '+ (mapcar '* (f x) v))) (f (caddr l)))
  29.                                   a (angle '(0 0) (trans v 0 z))
  30.                             )
  31.                         )
  32.                         (not (setvar 'snapang (- a x)))
  33.                     )
  34.                     (   (princ "\nIncompatible object selected."))
  35.                 )
  36.             )
  37.             (   (= "Angle" u)
  38.                 (initget "Object Grade Cancel")
  39.                 (if (numberp (setq u (getangle "\nSpecify angle [Object/Grade/Cancel] <Object>: ")))
  40.                     (not (setvar 'snapang u))
  41.                     t
  42.                 )
  43.             )
  44.             (   (= "Grade" u)
  45.                 (initget "Object Angle Cancel")
  46.                 (if (numberp (setq u (getreal "\nSpecify grade (%) [Object/Angle/Cancel] <Object>: ")))
  47.                     (not (setvar 'snapang (atan (/ u 100.0))))
  48.                     t
  49.                 )
  50.             )
  51.             (   (= "Cancel" u) nil)
  52.         )
  53.     )
  54.     (princ)
  55. )

Super excellent code Lee, in fact I downloaded it from your web site.
Is there a way we can use entsel or something similar to select the entity rather than the crosshairs being visible at the time of selection. It sort of feels funny having them on screen when being ask to select something.

But... nonetheless, you are the master.
Thanks for great code.

Oh just found it by changing the line:

                (setq u (cond ((getpoint "\nPick point on object [Angle/Grade/Cancel] <Angle>: ")) ("Angle")))


to:

                (setq u (cond ((cadr (entsel "\nPick point on object [Angle/Grade/Cancel] <Angle>: "))) ("Angle")))

That did it.

« Last Edit: October 04, 2017, 12:57:16 AM by RGUS »

fools

  • Newt
  • Posts: 72
  • China
Re: Cursor Rotate
« Reply #51 on: October 04, 2017, 09:26:53 AM »
Can't work correctly when selecting a polyline in a block.
Good good study , day day up . Sorry about my Chinglish .

ahsattarian

  • Newt
  • Posts: 112
Re: Cursor Rotate
« Reply #52 on: August 08, 2021, 09:19:17 AM »
Use    :     nentsel



Code - Auto/Visual Lisp: [Select]
  1. (defun c:a ()
  2.   (setq es (nentsel "\n Pick Object to Match Rotation : "))
  3.   (setq s (car es))
  4.   (setq po (cadr es))
  5.   (setq obj (vlax-ename->vla-object s))
  6.   (cond
  7.     ((vlax-property-available-p obj 'rotation) (setq ang (vlax-get obj 'rotation)))
  8.     ((and
  9.        (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list s))))
  10.        (setq pt (vlax-curve-getclosestpointto s po))
  11.        (setq par (vlax-curve-getparamatpoint s pt))
  12.        (setq an (angle '(0 0) (vlax-curve-getfirstderiv s par)))
  13.      )
  14.      (setq ang an)
  15.     )
  16.     (t (princ "\n  Invalid selection !!  ") (setq ang nil))
  17.   )
  18.   (cond (ang (cond ((>= ang pi) (setq ang (- ang pi)))) (setvar 'snapang ang)))
  19.   (princ)
  20. )