TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: novice on September 16, 2015, 03:09:31 PM

Title: Cursor Rotate
Post by: novice on September 16, 2015, 03:09:31 PM
I wrote some code to rotate my crosshairs so I can input text at an angle to match my drawings, more easily add dimensions at this set angle, etc. Super handy.

So here it is as it is:

Code - Auto/Visual Lisp: [Select]
  1. ;;cr = cursor rotate
  2. ;;(Set snap angle to angle of existing text string, dimension, or
  3. ;;line (set Snap To Object))
  4.  
  5. (defun C:CR ()
  6.   (setq ent (entget (car
  7.     (entsel "\nSelect a text string, dimension, line, arc, or circle: "))))
  8.   (setq tp1 (cdr (assoc 0 ent)))
  9.   (while (= tp1 "LWPOLYLINE")
  10.     (princ "\nThe selected entity is a POLYLINE. Try again...")
  11.     (setq ent (entget (car
  12.       (entsel "\nSelect a text string, dimension, line, arc, or circle: "))))
  13.     (setq tp1 (cdr (assoc 0 ent))))
  14.  
  15. (defun STTEXT ()
  16.   (setq ip (cdr (assoc 10 ent)))
  17.   (setq rang (cdr (assoc 50 ent)))
  18.   (setq dang (* (/ 180 pi) rang))
  19.   (command "snap" "r" ip dang)
  20.   (command "snap" "off")(princ))
  21.  
  22. (defun STLINE ()
  23.   (setq org (getvar "osmode"))
  24.   (setvar "osmode" 0)
  25.   (setq pt1 (cdr (assoc 10 ent)))
  26.   (setq pt2 (cdr (assoc 11 ent)))
  27.   (command "snap" "r" pt1 pt2)
  28.   (setvar "osmode" org)
  29.   (command "snap" "off")(princ))
  30.  
  31. (defun STDIM ()
  32.   (setq aor (cdr (assoc 70 ent)))
  33.   (if (= aor 33)
  34.     (progn (setq pt1 (cdr (assoc 13 ent)))
  35.       (setq pt2 (cdr (assoc 14 ent)))
  36.       (command "snap" "r" pt1 pt2)
  37.       (command "snap" "off")(princ))
  38.     (progn (setq rang (cdr (assoc 50 ent)))
  39.       (setq dang (* (/ 180 pi) rang))
  40.       (command "snap" "r" "0,0" dang)
  41.       (command "snap" "off")(princ))))
  42.  
  43. (defun STCURVE ()
  44.   (setq tp0 (cdr (assoc -1 ent)))
  45.   (redraw tp0 3)
  46.   (setq pt1 (getpoint "\nPick the point of tangency..."))
  47.   (redraw tp0 4)
  48.   (setq ctr (cdr (assoc 10 ent)))
  49.   (setq rang (angle pt1 ctr))
  50.   (setq dang (+ 90 (/ (* rang 180.0) pi)))
  51.   (command "snap" "r" pt1 dang)
  52.   (command "snap" "off")(princ))
  53.  
  54.   (cond ((= tp1 "TEXT") (STTEXT))
  55.         ((= tp1 "LINE") (STLINE))
  56.         ((= tp1 "DIMENSION") (STDIM))
  57.         ((= tp1 "ARC") (STCURVE))
  58.         ((= tp1 "CIRCLE") (STCURVE)))
  59.   (princ))
  60.  
  61. ;;cra = cursor rotate to specified angle
  62.  
  63. (defun C:CRA ()
  64.   (setq ang1 (getstring "Rotate cursor at what angle?: "))
  65.   (command "snap" "r" "0,0" ang1)
  66.   (command "snap" "off")(princ))
  67.  
  68. ;;cr2 = cursor rotate defined by two points
  69.  
  70. (defun c:CR2 ( / r e p1 p2)
  71.   (graphscr)
  72.   (initget "Entity")
  73.   (setq r
  74.   (getangle "\nSnap rotation angle/<Entity>: "))
  75.   (cond
  76.      (  (numberp r)
  77.        (setvar "snapang" r))
  78.      (  (and (or (not r) (eq r "Entity"))
  79.         (setq e (entsel))
  80.         (setq p1 (osnap (cadr e) "qui,end"))
  81.         (setq p2 (osnap (cadr e) "qui,mid")))
  82.    (setvar "snapang" (angle p1 p2)))
  83.      (t (princ "\nInvalid selection.")))
  84.   (princ)
  85. )

There's three commands in there - I'm fine with that (I aim low, I guess). But I don't know how to make this work when clicking on MTEXT or POLYLINES. I wish that weren't the case.

Ideally, I would abandon use of the CR2 command, if I could use an all-purpose CR command to also pick MTEXT, POLYLINES, BLOCKS (would extract angle data from the picked object nested in the block), etc.

Just throwing this out there...

Thanks,
Novice
Title: Re: Cursor Rotate
Post by: ronjonp on September 16, 2015, 04:03:59 PM
Maybe this will give you some ideas:
Code - Auto/Visual Lisp: [Select]
  1. (defun c:rsa (/ a cp e p pa)
  2.   (if (setq e (entsel "\nPick object to match rotation: "))
  3.     (progn
  4.       (setq p (cadr e)
  5.             e (car e)
  6.       )
  7.       (cond ((vlax-property-available-p (vlax-ename->vla-object e) 'rotation)
  8.              (setvar 'snapang (vlax-get (vlax-ename->vla-object e) 'rotation))
  9.             )
  10.             ((and (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list e))))
  11.                   (setq cp (vlax-curve-getclosestpointto e p))
  12.                   (setq pa (vlax-curve-getparamatpoint e cp))
  13.                   (setq a (angle '(0 0) (vlax-curve-getfirstderiv e pa)))
  14.              )
  15.              (setvar 'snapang a)
  16.             )
  17.       )
  18.     )
  19.   )
  20.   (princ)
  21. )
BTW .. welcome to the swamp :)
Title: Re: Cursor Rotate
Post by: novice on September 16, 2015, 04:24:13 PM
Wow... amazing. Thank you. Works fantastic, though I honestly don't have a clue what you did.

One thing I noticed is it gave me a wrong angle when I clicked on a block that had been rotated. It also didn't allow me to snap to a particular point on a circle, to get the tangent there.

I hope you know I'm not complaining!

Thanks for the kind welcome.
Title: Re: Cursor Rotate
Post by: roy_043 on September 17, 2015, 04:48:13 AM
One thing I noticed is it gave me a wrong angle when I clicked on a block that had been rotated.
The SNAPANG is expressed relative to the current UCS. So this can occur if you are not working in the WCS.
To get the rotation angle of the current UCS:
Code: [Select]
(angle '(0.0 0.0 0.0) (getvar 'ucsxdir))
I assume that this is a 2D only utility.
Title: Re: Cursor Rotate
Post by: novice on September 17, 2015, 08:17:53 AM
One thing I noticed is it gave me a wrong angle when I clicked on a block that had been rotated.
The SNAPANG is expressed relative to the current UCS. So this can occur if you are not working in the WCS.
To get the rotation angle of the current UCS:
Code: [Select]
(angle '(0.0 0.0 0.0) (getvar 'ucsxdir))
I assume that this is a 2D only utility.

I always work 2D, WCS.
Title: Re: Cursor Rotate
Post by: ronjonp on September 17, 2015, 09:03:02 AM
Maybe post an example drawing.  I can't replicate the circle & block issue you're seeing.
Title: Re: Cursor Rotate
Post by: Lee Mac on September 17, 2015, 09:38:13 AM
Maybe this will resolve the issues?

Code - Auto/Visual Lisp: [Select]
  1. (defun c:rsa ( / a e o p s z )
  2.     (while
  3.         (progn
  4.             (cond
  5.                 (   (null (setq p (getpoint "\nPick point on object <exit>: ")))
  6.                     nil
  7.                 )
  8.                 (   (null (setq s (ssget "_C" (mapcar '- p '(1e-4 1e-4)) (mapcar '+ p '(1e-4 1e-4)))))
  9.                     (princ "\nPoint does not lie on an object.")
  10.                 )
  11.                 (   (progn
  12.                         (setq e (ssname s 0)
  13.                               o (vlax-ename->vla-object e)
  14.                               z (trans '(0 0 1) 1 0 t)
  15.                               a (angle '(0 0) (trans (getvar 'ucsxdir) 0 z t))
  16.                         )
  17.                         (vlax-property-available-p o 'rotation)
  18.                     )
  19.                     (not (setvar 'snapang (- (vla-get-rotation o) a)))
  20.                 )
  21.                 (   (vl-catch-all-error-p (setq p (vl-catch-all-apply 'vlax-curve-getclosestpointto (list e (trans p 1 0)))))
  22.                     (princ "\nIncompatible object selected.")
  23.                 )
  24.                 (   (not (setvar 'snapang (- (angle '(0 0) (trans (vlax-curve-getfirstderiv e (vlax-curve-getparamatpoint e p)) 0 z)) a))))
  25.             )
  26.         )
  27.     )
  28.     (princ)
  29. )
Title: Re: Cursor Rotate
Post by: novice on September 17, 2015, 10:38:14 AM
Maybe post an example drawing.  I can't replicate the circle & block issue you're seeing.

DWG file attached. The block this routine doesn't seem to work on is labeled "BLOCK1 (UNROTATED)".

The circle issue is just that when I pick the circle using your code, my crosshairs automatically rotate to the tangent of the circle where I selected it, without giving me the option of snapping to an exact point on the circle, for instance where it intersects a line. For comparison, the code I posted (my CR command) allows me to pick the circle first; then, pick an exact point on the circle.
Title: Re: Cursor Rotate
Post by: novice on September 17, 2015, 10:40:34 AM
Maybe this will resolve the issues?

Code - Auto/Visual Lisp: [Select]
  1. (defun c:rsa ( / a e o p s z )
  2.     (while
  3.         (progn
  4.             (cond
  5.                 (   (null (setq p (getpoint "\nPick point on object <exit>: ")))
  6.                     nil
  7.                 )
  8.                 (   (null (setq s (ssget "_C" (mapcar '- p '(1e-4 1e-4)) (mapcar '+ p '(1e-4 1e-4)))))
  9.                     (princ "\nPoint does not lie on an object.")
  10.                 )
  11.                 (   (progn
  12.                         (setq e (ssname s 0)
  13.                               o (vlax-ename->vla-object e)
  14.                               z (trans '(0 0 1) 1 0 t)
  15.                               a (angle '(0 0) (trans (getvar 'ucsxdir) 0 z t))
  16.                         )
  17.                         (vlax-property-available-p o 'rotation)
  18.                     )
  19.                     (not (setvar 'snapang (- (vla-get-rotation o) a)))
  20.                 )
  21.                 (   (vl-catch-all-error-p (setq p (vl-catch-all-apply 'vlax-curve-getclosestpointto (list e (trans p 1 0)))))
  22.                     (princ "\nIncompatible object selected.")
  23.                 )
  24.                 (   (not (setvar 'snapang (- (angle '(0 0) (trans (vlax-curve-getfirstderiv e (vlax-curve-getparamatpoint e p)) 0 z)) a))))
  25.             )
  26.         )
  27.     )
  28.     (princ)
  29. )

This one has the same issue as ronjonp's, but in addition, I can't figure out how it works with MTEXT.
Title: Re: Cursor Rotate
Post by: roy_043 on September 17, 2015, 11:02:18 AM
DWG file attached. The block this routine doesn't seem to work on is labeled "BLOCK1 (UNROTATED)".
As you say: the block is not rotated (rotation=0.0) therefore the function should set the SNAPANG to 0.0, which it does. The fact that the block represents a rotated element is not relevant to the function.
Title: Re: Cursor Rotate
Post by: novice on September 17, 2015, 11:19:04 AM
DWG file attached. The block this routine doesn't seem to work on is labeled "BLOCK1 (UNROTATED)".
As you say: the block is not rotated (rotation=0.0) therefore the function should set the SNAPANG to 0.0, which it does. The fact that the block represents a rotated element is not relevant to the function.

I hope it's clear that I'm a novice! I'm not sure how to integrate your code into the main code. I mean, I assume what you're saying is that the code you offered should fix this problem?
Title: Re: Cursor Rotate
Post by: roy_043 on September 17, 2015, 12:42:23 PM
DWG file attached. The block this routine doesn't seem to work on is labeled "BLOCK1 (UNROTATED)".
As you say: the block is not rotated (rotation=0.0) therefore the function should set the SNAPANG to 0.0, which it does. The fact that the block represents a rotated element is not relevant to the function.

I hope it's clear that I'm a novice! I'm not sure how to integrate your code into the main code. I mean, I assume what you're saying is that the code you offered should fix this problem?
No my suggestion won't fix the problem. Lee's code has incorporated this already. You are confused by the rotation of the content of the block as opposed to the rotation of the block itself.
Title: Re: Cursor Rotate
Post by: roy_043 on September 17, 2015, 12:47:12 PM
@ Lee:
I find it strange that you use (trans) for the UCSXDIR but not for the block rotation. Or am I missing something?
Title: Re: Cursor Rotate
Post by: Lee Mac on September 17, 2015, 12:53:10 PM
@ Lee:
I find it strange that you use (trans) for the UCSXDIR but not for the block rotation. Or am I missing something?

I transform the UCSXDIR to be relative to the active UCS plane, and the code makes the assumption that the block resides in a plane parallel to the UCS plane - or have I missed your point?
Title: Re: Cursor Rotate
Post by: roy_043 on September 17, 2015, 01:13:06 PM
@ Lee:
I find it strange that you use (trans) for the UCSXDIR but not for the block rotation. Or am I missing something?

I transform the UCSXDIR to be relative to the active UCS plane, and the code makes the assumption that the block resides in a plane parallel to the UCS plane - or have I missed your point?
No, but I did not make that assumption.
Title: Re: Cursor Rotate
Post by: Lee Mac on September 17, 2015, 01:27:37 PM
@ Lee:
I find it strange that you use (trans) for the UCSXDIR but not for the block rotation. Or am I missing something?

I transform the UCSXDIR to be relative to the active UCS plane, and the code makes the assumption that the block resides in a plane parallel to the UCS plane - or have I missed your point?
No, but I did not make that assumption.

I think the code must make such an assumption since rotation is a planar operation, and so a compound rotation of the UCS and a block residing in another plane would either be meaningless or would need to be projected to the UCS plane.
Title: Re: Cursor Rotate
Post by: Lee Mac on September 17, 2015, 01:52:25 PM
Try the following code instead:
Code - Auto/Visual Lisp: [Select]
  1. (defun c:rsa ( / a e l o p 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.         (progn
  7.             (cond
  8.                 (   (null (setq p (getpoint "\nPick point on object <exit>: ")))
  9.                     nil
  10.                 )
  11.                 (   (null (setq l (nentselp p)))
  12.                     (princ "\nPoint does not lie on an object.")
  13.                 )
  14.                 (   (or (and (setq e (car l)
  15.                                    o (vlax-ename->vla-object e)
  16.                              )
  17.                              (vlax-property-available-p o 'rotation)
  18.                              (setq a (vla-get-rotation o))
  19.                         )
  20.                         (and (not (vl-catch-all-error-p (setq p (vl-catch-all-apply 'vlax-curve-getclosestpointto (list e (trans p 1 0))))))
  21.                              (setq a (angle '(0 0) (trans (vlax-curve-getfirstderiv e (vlax-curve-getparamatpoint e p)) 0 z)))
  22.                         )
  23.                     )
  24.                     (foreach b (cadddr l)
  25.                         (if (= "INSERT" (cdr (assoc 0 (setq b (entget b)))))
  26.                             (setq a (+ a (cdr (assoc 50 b))))
  27.                         )
  28.                     )
  29.                     (not (setvar 'snapang (- a x)))
  30.                 )
  31.                 (   (princ "\nIncompatible object selected."))
  32.             )
  33.         )
  34.     )
  35.     (princ)
  36. )
Title: Re: Cursor Rotate
Post by: novice on September 17, 2015, 02:10:48 PM
Try the following code instead:
Code - Auto/Visual Lisp: [Select]
  1. (defun c:rsa ( / a e l o p 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.         (progn
  7.             (cond
  8.                 (   (null (setq p (getpoint "\nPick point on object <exit>: ")))
  9.                     nil
  10.                 )
  11.                 (   (null (setq l (nentselp p)))
  12.                     (princ "\nPoint does not lie on an object.")
  13.                 )
  14.                 (   (or (and (setq e (car l)
  15.                                    o (vlax-ename->vla-object e)
  16.                              )
  17.                              (vlax-property-available-p o 'rotation)
  18.                              (setq a (vla-get-rotation o))
  19.                         )
  20.                         (and (not (vl-catch-all-error-p (setq p (vl-catch-all-apply 'vlax-curve-getclosestpointto (list e (trans p 1 0))))))
  21.                              (setq a (angle '(0 0) (trans (vlax-curve-getfirstderiv e (vlax-curve-getparamatpoint e p)) 0 z)))
  22.                         )
  23.                     )
  24.                     (foreach b (cadddr l)
  25.                         (setq a (+ a (cdr (assoc 50 (entget b)))))
  26.                     )
  27.                     (not (setvar 'snapang (- a x)))
  28.                 )
  29.                 (   (princ "\nIncompatible object selected."))
  30.             )
  31.         )
  32.     )
  33.     (princ)
  34. )

Solves the block issue perfectly, and the circle/arc issue. In a perfect world this would combine with ronjonp's code, which neatly handled mtext.
Title: Re: Cursor Rotate
Post by: Lee Mac on September 17, 2015, 05:29:33 PM
Solves the block issue perfectly, and the circle/arc issue. In a perfect world this would combine with ronjonp's code, which neatly handled mtext.

My code should also work with MText (and nested MText), just pick a point on the MText to select it.
Title: Re: Cursor Rotate
Post by: RGUS on September 17, 2015, 11:51:15 PM
Solves the block issue perfectly, and the circle/arc issue. In a perfect world this would combine with ronjonp's code, which neatly handled mtext.

My code should also work with MText (and nested MText), just pick a point on the MText to select it.

Perfect Lee... but then what code of yours isn't.
Is there a way to snap to dimension lines as well...

Excellent, excellent coding.
Title: Re: Cursor Rotate
Post by: novice on September 18, 2015, 12:09:17 PM
Hmm, not sure why it doesn't work for me on mtext. Not at work today, Monday I'll retry and also see if it works on dimension strings.
Title: Re: Cursor Rotate
Post by: novice on September 18, 2015, 12:15:29 PM
DWG file attached. The block this routine doesn't seem to work on is labeled "BLOCK1 (UNROTATED)".
As you say: the block is not rotated (rotation=0.0) therefore the function should set the SNAPANG to 0.0, which it does. The fact that the block represents a rotated element is not relevant to the function.

I hope it's clear that I'm a novice! I'm not sure how to integrate your code into the main code. I mean, I assume what you're saying is that the code you offered should fix this problem?
No my suggestion won't fix the problem. Lee's code has incorporated this already. You are confused by the rotation of the content of the block as opposed to the rotation of the block itself.

Just now realized what you were saying here. Yes, I misspoke. I meant that the code didn't work as I desired when a block wasn't rotated, but the selected nested object was. Anyway, this is all fixed up now.
Title: Re: Cursor Rotate
Post by: Lee Mac on September 19, 2015, 09:37:13 AM
Perfect Lee... but then what code of yours isn't.

Excellent, excellent coding.

Thank you RGUS - that's very kind of you to say  :-)

Is there a way to snap to dimension lines as well...

The current code should already allow you to snap to dimension lines (please see the demonstration below).

Hmm, not sure why it doesn't work for me on mtext. Not at work today, Monday I'll retry and also see if it works on dimension strings.

The code seems to perform well for me with the MText in your sample drawing, and also with dimension text and extension lines:

(http://lee-mac.com/swamp/snapangdemo.gif)
Title: Re: Cursor Rotate
Post by: RGUS on September 20, 2015, 08:21:29 AM
Hmmmm... I see by your example Lee it does work for dimensions, I must have some system variable or such set to stop this from happening for me. It's almost as if the cursor snaps but to a radian angle not a degree angle. I'll have a little play and see what happens.
Title: Re: Cursor Rotate
Post by: Lee Mac on September 20, 2015, 08:48:33 AM
Hmmmm... I see by your example Lee it does work for dimensions, I must have some system variable or such set to stop this from happening for me. It's almost as if the cursor snaps but to a radian angle not a degree angle. I'll have a little play and see what happens.

Could you upload a sample drawing?
Title: Re: Cursor Rotate
Post by: RGUS on September 20, 2015, 02:34:21 PM
Hmmmm... I see by your example Lee it does work for dimensions, I must have some system variable or such set to stop this from happening for me. It's almost as if the cursor snaps but to a radian angle not a degree angle. I'll have a little play and see what happens.

Could you upload a sample drawing?

Sample drawing attached...
Title: Re: Cursor Rotate
Post by: lamarn on September 20, 2015, 03:33:08 PM
Is there a method to set current ucs (x,y) also according to the setvar snapangle with it?
Title: Re: Cursor Rotate
Post by: Lee Mac on September 20, 2015, 03:44:54 PM
Hmmmm... I see by your example Lee it does work for dimensions, I must have some system variable or such set to stop this from happening for me. It's almost as if the cursor snaps but to a radian angle not a degree angle. I'll have a little play and see what happens.

Could you upload a sample drawing?

Sample drawing attached...

Thanks RGUS - please try the updated code above.  :-)
Title: Re: Cursor Rotate
Post by: Lee Mac on September 20, 2015, 03:52:20 PM
Is there a method to set current ucs (x,y) also according to the setvar snapangle with it?

If the UCS is rotated to match the angle, SNAPANG will be set to 0.0 (since this is defined relative to the active UCS).
Title: Re: Cursor Rotate
Post by: RGUS on September 20, 2015, 04:18:16 PM
Hmmmm... I see by your example Lee it does work for dimensions, I must have some system variable or such set to stop this from happening for me. It's almost as if the cursor snaps but to a radian angle not a degree angle. I'll have a little play and see what happens.

Could you upload a sample drawing?

Sample drawing attached...

Thanks RGUS - please try the updated code above.  :-)

Brilliant Lee... perfect! Thanks man.
Title: Re: Cursor Rotate
Post by: Lee Mac on September 20, 2015, 04:20:55 PM
No worries!  :-)
Title: Re: Cursor Rotate
Post by: lamarn on September 20, 2015, 04:50:53 PM
Not a wonderboy in coding. Apparently will not work..

Code: [Select]
(not (command "ucs" "z" (- a x)))

Code: [Select]
(not (setvar 'snapang (- a x)))


               
Title: Re: Cursor Rotate
Post by: Lee Mac on September 20, 2015, 05:12:45 PM
Try:
Code - Auto/Visual Lisp: [Select]
  1. (command "_.ucs" "_z" (angtos (- a x)))
Title: Re: Cursor Rotate
Post by: novice on September 21, 2015, 09:31:02 AM

Hmm, not sure why it doesn't work for me on mtext. Not at work today, Monday I'll retry and also see if it works on dimension strings.

The code seems to perform well for me with the MText in your sample drawing, and also with dimension text and extension lines:

(http://lee-mac.com/swamp/snapangdemo.gif)

Ok, this probably sounds ridiculous, but I had to get the hang of how to pick mtext using your code. It works fine. It's just that there's no pickbox so it doesn't feel like I'm picking anything. So I always clicked on the "insert" or "node" object snap marker. But clicking on these markers does nothing - it does not pick the mtext.

That said, I forgot until now to try it with a rotated dimension. Doesn't seem to work. When I pick my rotated dimension, the snap angle changes but it changes to something unexpected.

Same sample drawing as before attached, but with a rotated dimension in it this time.
Title: Re: Cursor Rotate
Post by: ronjonp on September 21, 2015, 09:36:05 AM
I just tested with your drawing & it worked fine for me  :?
Title: Re: Cursor Rotate
Post by: Lee Mac on September 21, 2015, 09:36:50 AM
Ok, this probably sounds ridiculous, but I had to get the hang of how to pick mtext using your code. It works fine. It's just that there's no pickbox so it doesn't feel like I'm picking anything. So I always clicked on the "insert" or "node" object snap marker. But clicking on these markers does nothing - it does not pick the mtext.

You can't have the best of both options without a separate prompt: you requested an accurate point specification, therefore the crosshairs must be used to allow Object Snap; if you want to use a pickbox as per the previous code, you will need to forgo the accurate point specification and rely on the nearest point to the center of the pickbox.

That said, I forgot until now to try it with a rotated dimension. Doesn't seem to work. When I pick my rotated dimension, the snap angle changes but it changes to something unexpected.

Have you tried the updated code?
(following the comments from RGUS above?)
Title: Re: Cursor Rotate
Post by: novice on September 23, 2015, 09:20:22 AM
Ok, I finally found the updated code and it works great. Everything works great. Thank you everyone, Lee especially of course, for working on this code.

Here it is:

Try the following code instead:
Code - Auto/Visual Lisp: [Select]
  1. (defun c:rsa ( / a e l o p 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.         (progn
  7.             (cond
  8.                 (   (null (setq p (getpoint "\nPick point on object <exit>: ")))
  9.                     nil
  10.                 )
  11.                 (   (null (setq l (nentselp p)))
  12.                     (princ "\nPoint does not lie on an object.")
  13.                 )
  14.                 (   (or (and (setq e (car l)
  15.                                    o (vlax-ename->vla-object e)
  16.                              )
  17.                              (vlax-property-available-p o 'rotation)
  18.                              (setq a (vla-get-rotation o))
  19.                         )
  20.                         (and (not (vl-catch-all-error-p (setq p (vl-catch-all-apply 'vlax-curve-getclosestpointto (list e (trans p 1 0))))))
  21.                              (setq a (angle '(0 0) (trans (vlax-curve-getfirstderiv e (vlax-curve-getparamatpoint e p)) 0 z)))
  22.                         )
  23.                     )
  24.                     (foreach b (cadddr l)
  25.                         (if (= "INSERT" (cdr (assoc 0 (setq b (entget b)))))
  26.                             (setq a (+ a (cdr (assoc 50 b))))
  27.                         )
  28.                     )
  29.                     (not (setvar 'snapang (- a x)))
  30.                 )
  31.                 (   (princ "\nIncompatible object selected."))
  32.             )
  33.         )
  34.     )
  35.     (princ)
  36. )
Title: Re: Cursor Rotate
Post by: Lee Mac on September 23, 2015, 09:29:56 AM
Excellent to hear novice - I'm glad the code is working well for you.

Thank you for your gratitude  :-)
Title: Re: Cursor Rotate
Post by: RGUS on September 23, 2015, 08:31:44 PM
So handy this routine... just occasionally I pick the wrong segment of a polyline in an XREF and the cursor snaps to the angle of the first segment of the polyline...  a small problem that certainly does not detract me from using this great routine Lee. Again thanks very, very much.

I have added a few line to your routine that allow me to pick points or enter directly a desired angle rather than look for an entity that matches the snap_angle I need.

(defun rtd (A) (* 180.0 (/ A pi)))

and then when I exit your code, I've placed this at the end of it.

(setvar "osmode" 512)
(setq pick_snap (getangle "\nAngle: "))
(command "snapang" (rtd pick_snap))
(setvar "osmode" 0)

Not pretty but allows me to pick any other angle.

I hope you don't mind.

Title: Re: Cursor Rotate
Post by: Lee Mac on September 24, 2015, 07:29:14 AM
Not at all, I'm delighted you find the code so useful - perhaps the option could be incorporated in the following way:

Code - Auto/Visual Lisp: [Select]
  1. (defun c:rsa ( / a e l o p 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.             (   (= "Cancel" a) nil)
  8.             (   (progn
  9.                     (initget "Angle Cancel")
  10.                     (or (null (setq p (getpoint "\nPick point on object [Angle/Cancel] <Angle>: "))) (= "Angle" p))
  11.                 )
  12.                 (initget "Object Cancel")
  13.                 (if (numberp (setq a (getangle "Specify angle [Object/Cancel] <Object>: ")))
  14.                     (not (setvar 'snapang a))
  15.                     t
  16.                 )
  17.             )
  18.             (   (= "Cancel" p) nil)
  19.             (   (null (setq l (nentselp p)))
  20.                 (princ "\nPoint does not lie on an object.")
  21.             )
  22.             (   (or (and (setq e (car l)
  23.                                o (vlax-ename->vla-object e)
  24.                          )
  25.                          (vlax-property-available-p o 'rotation)
  26.                          (setq a (vla-get-rotation o))
  27.                     )
  28.                     (and (not (vl-catch-all-error-p (setq p (vl-catch-all-apply 'vlax-curve-getclosestpointto (list e (trans p 1 0))))))
  29.                          (setq a (angle '(0 0) (trans (vlax-curve-getfirstderiv e (vlax-curve-getparamatpoint e p)) 0 z)))
  30.                     )
  31.                 )
  32.                 (foreach b (cadddr l)
  33.                     (if (= "INSERT" (cdr (assoc 0 (setq b (entget b)))))
  34.                         (setq a (+ a (cdr (assoc 50 b))))
  35.                     )
  36.                 )
  37.                 (not (setvar 'snapang (- a x)))
  38.             )
  39.             (   (princ "\nIncompatible object selected."))
  40.         )
  41.     )
  42.     (princ)
  43. )

I'm not sure why you would want to set OSMODE to 0 however?
Title: Re: Cursor Rotate
Post by: lamarn on September 24, 2015, 09:06:59 AM
Like it !
(snapang or ucs wise..)

Title: Re: Cursor Rotate
Post by: Dave M on September 24, 2015, 02:41:05 PM
Great routine!  Would it be difficult to add the ability to set the angle to a specific grade in decimal format?  I usually just calculate the angle and set the snapang variable manually
Title: Re: Cursor Rotate
Post by: RGUS on September 24, 2015, 04:08:48 PM
Not at all, I'm delighted you find the code so useful - perhaps the option could be incorporated in the following way:

Code - Auto/Visual Lisp: [Select]
  1. (defun c:rsa ( / a e l o p 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.             (   (= "Cancel" a) nil)
  8.             (   (progn
  9.                     (initget "Angle Cancel")
  10.                     (or (null (setq p (getpoint "\nPick point on object [Angle/Cancel] <Angle>: "))) (= "Angle" p))
  11.                 )
  12.                 (initget "Object Cancel")
  13.                 (if (numberp (setq a (getangle "Specify angle [Object/Cancel] <Object>: ")))
  14.                     (not (setvar 'snapang a))
  15.                     t
  16.                 )
  17.             )
  18.             (   (= "Cancel" p) nil)
  19.             (   (null (setq l (nentselp p)))
  20.                 (princ "\nPoint does not lie on an object.")
  21.             )
  22.             (   (or (and (setq e (car l)
  23.                                o (vlax-ename->vla-object e)
  24.                          )
  25.                          (vlax-property-available-p o 'rotation)
  26.                          (setq a (vla-get-rotation o))
  27.                     )
  28.                     (and (not (vl-catch-all-error-p (setq p (vl-catch-all-apply 'vlax-curve-getclosestpointto (list e (trans p 1 0))))))
  29.                          (setq a (angle '(0 0) (trans (vlax-curve-getfirstderiv e (vlax-curve-getparamatpoint e p)) 0 z)))
  30.                     )
  31.                 )
  32.                 (foreach b (cadddr l)
  33.                     (if (= "INSERT" (cdr (assoc 0 (setq b (entget b)))))
  34.                         (setq a (+ a (cdr (assoc 50 b))))
  35.                     )
  36.                 )
  37.                 (not (setvar 'snapang (- a x)))
  38.             )
  39.             (   (princ "\nIncompatible object selected."))
  40.         )
  41.     )
  42.     (princ)
  43. )

I'm not sure why you would want to set OSMODE to 0 however?

Clever bugger ain't ya... cheers for this little mod Lee.

I normally work with no snaps on, just an old fart from way back that never had snaps in version 1.0 of ACAD... old habits.
Title: Re: Cursor Rotate
Post by: Lee Mac on September 24, 2015, 06:07:04 PM
Like it !
(snapang or ucs wise..)

Thanks!  :-)

Great routine!  Would it be difficult to add the ability to set the angle to a specific grade in decimal format?  I usually just calculate the angle and set the snapang variable manually

Thanks Dave - I didn't realise this sort of program would prove so useful to so many members, personally I've never altered SNAPANG and usually opt to rotate the UCS. As for setting the angle using decimal format, the getangle prompt in the latest modification to the code (accessible by typing 'A' at the first prompt) should accept any form of angular input, returning the equivalent angle in radians to which the SNAPANG system variable is set.

Could you possibly give an example of the typical input you wish to supply to the program?

Clever bugger ain't ya... cheers for this little mod Lee.

No worries RGUS!  :-)

I normally work with no snaps on, just an old fart from way back that never had snaps in version 1.0 of ACAD... old habits.

Personally, I couldn't imagine drafting anything without snaps (unless perhaps considering the grid snap), but each to their own I suppose.
Title: Re: Cursor Rotate
Post by: novice on September 24, 2015, 07:04:09 PM
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.
Title: Re: Cursor Rotate
Post by: Dave M 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
Title: Re: Cursor Rotate
Post by: Lee Mac 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. )
Title: Re: Cursor Rotate
Post by: novice 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.
Title: Re: Cursor Rotate
Post by: Lee Mac on September 25, 2015, 08:58:10 AM
Thank you novice, I'm glad you like the final code  :-)
Title: Re: Cursor Rotate
Post by: Dave M 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
)

Title: Re: Cursor Rotate
Post by: RGUS 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.

Title: Re: Cursor Rotate
Post by: fools on October 04, 2017, 09:26:53 AM
Can't work correctly when selecting a polyline in a block.
Title: Re: Cursor Rotate
Post by: ahsattarian 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. )