;;; Cursor Rotate (Modified by Igal Averbuh 2016)
;;; Added option to set snap angle by 2 points on screen

(defun c:crt ( / r e p1 p2)
(graphscr)
(initget "Entity")
(setq r
(getangle "\nSet Snap rotation angle by 2Points on Entity: "))
(cond
( (numberp r)
(setvar "snapang" r))
( (and (or (not r) (eq r "2Points"))
(setq e (entsel))
(setq p1 (osnap (cadr e) "qui,end"))
(setq p2 (osnap (cadr e) "qui,mid")))
(setvar "snapang" (angle p1 p2)))
(t (princ "\nInvalid selection.")))
(princ)
)

;=========================================================================
; SNAPLINE.lsp Snapang match line (Command function for AutoCAD)
; (c) Copyright 2001 TimeSavers for CAD
; from: http://www.timesaversforcad.com
;-------------------------------------------------------------------------
; Description:
;
; Sets SNAPANG to angle of selected LINE, LWPOLYLINE, POLYLINE, XLINE
; or LEADER segment. Works for subentities (nested in BLOCK or XREF)
; as well.
;
; To run transparent, first place contents below in ACAD.LSP or
; .MNL to preload, then assign to a toolbar button or pulldown
; in your .MNU file:
; ^P'snapline
; Works only for native AutoCAD commands, not AutoLISP commands.
;=========================================================================
(defun c:ce (/ a)(if (setq a (linang))(setvar "snapang" a))(princ))
;-GET ANGLE OF LINE SEGMENT
(defun linang (/ *la:err* dtor e et ed p1 p2 aptr l_ang)
;-ERROR HANDLING
(defun *la:err* (m)
(or (member m '("Function cancelled" "quit / exit abort" "console break"))
(prompt (strcat "\n\n"))
)
(if aptr (setvar "aperture" aptr))(setq *error* *e*)(princ)
)
;-DEGREES TO RADIANS
(defun dtor (d)(/ (* d pi) 180.0))

;-GET VALUES
(setq *e* (cond (*e*)(*error*))
*error* *la:err*
)

;-ACTUAL FUNCTION
(if (or (while (progn (initget "Cancel Angle 2Points ")
(setq ne (nentsel "\n[Cancel/2Points/Angle/]: "))
(cond ((not ne)(princ "0 found"))
((= ne "Cancel")(setq l_ang 0) nil)
((= ne "2Points")(c:crt) nil)
((= ne "Angle")(not (setq l_ang (getangle "\nAngle: "))))
((listp ne)
(setq e (car ne)
ed (entget e)
et (cdr (assoc 0 ed))
)
(if (not (wcmatch et "*LINE,VERTEX,LEADER,HATCH"))
(princ "Invalid object, Try Again ")
)
)
)
)
)
(/= ne "")
)
(or l_ang
(progn
(setq aptr (getvar "aperture"))
(setvar "aperture" (getvar "pickbox"))
(setq p1 (osnap (cadr ne) "nea")
p2 (osnap (cadr ne) "mid")
l_ang (angle p1 p2)
)
(setvar "aperture" aptr)
)
)
)

(setq *error* *e*)
l_ang
)
;-END FILE
(c:ce)

Advertisements