AfraLisp Blog

The AutoLisp/Visual Lisp/VBA Resource Website

AfraLisp Blog

Home Newsletter Utter Rubbish Coding Tips AutoCAD Tips Contact Downloads WAUN

In answer to the question re: rotating lines from a base other than 0, I am enclosing a lisp routine that I have used for several years to rotate the crosshairs to an angle other than 0, and becomes the new 0 base until reset.

The easiest way to use this routine is simply execute the command, the
default choice is <P> for pick, enter to accept, and select the chosen line
with the pick box. This then becomes the new X - 0 base line and you can
then draw / rotate any other lines from this line with a true angle
selection. When finished execute the command again and the crosshairs will
return to a normal UCS, includes other options ie. pre-set angles etc.

I cannot claim to be the author of this routine, since the original version
was one that I picked up somewhere on my travels many years ago. During some
downtime it was reworked by a lisp guru I was working with, and then tweaked
again by myself (lisp hacker) over the past 3 years. That's the history,
and it works.

Kev Knowles

;CODING STARTS HERE
(defun *roterr* (mm)
(setvar "ANGBASE" abase)
(setq *error* olderr)
(princ)
)
(defun rtd (a)
(/ (* a 180) pi)
)
(defun rotgo (an)
(setvar "SNAPANG" an)
(princ (strcat "\nCrosshair rotation angle " (rtos (rtd an) 2 4) " degrees."))
)
(defun C:ROTATECROSS (/ pl pl1 pl2 angs str anssv midpt endpt)
(setq olderr *error* *error* *roterr* angs nil)
(if (= rot:ans nil) (setq rot:ans "P"))
(if (= (getvar "SNAPANG") 0.0)
(setq rot:ans "P")
(setq rot:ans "R")
)
(setq anssv rot:ans)
(setvar "CMDECHO" 0)
(setvar "SNAPMODE" 0)
(setq rot:ans (getstring (strcat "\nCrosshair ROTATION by Pick/Select/Angle/30°/45°/60°/Reset <" rot:ans ">: ")))
(if (/= rot:ans "") (setq rot:ans (strcase rot:ans)) (setq rot:ans anssv))
(cond
((= rot:ans "P")
(setq pl (entsel "\nPick line to rotate to :"))
(if (/= pl nil)
(progn
(setq pp (cadr pl))
(setq pl (entget (car pl)))
(cond
((or (= (cdr (assoc 0 pl)) "RAY")
(= (cdr (assoc 0 pl)) "XLINE")
)
(progn
(setq endpt (cdr (assoc 10 pl)))
(setq angs (angle pp endpt))
(rotgo angs)
)
) ;VALID ENTITIES
((or
(= (cdr (assoc 0 pl)) "LINE")
(= (cdr (assoc 0 pl)) "POLYLINE")
(= (cdr (assoc 0 pl)) "LWPOLYLINE")
)
(progn
(setq midpt (osnap pp "mid"))
(setq endpt (osnap pp "end"))
(setq angs (angle midpt endpt))
(rotgo angs)
)
) ;VALID ENTITIES
((or
(= (cdr (assoc 0 pl)) "MTEXT")
(= (cdr (assoc 0 pl)) "TEXT")
(= (cdr (assoc 0 pl)) "CIRCLE")
(= (cdr (assoc 0 pl)) "ELLIPSE")
(= (cdr (assoc 0 pl)) "ARC")
)
(princ "\nCan't do that entity.")
);INVALID ENTITIES
(t (princ "\nNothing picked."))
)
)
)
)
((= rot:ans "S")
(setvar "ORTHOMODE" 0)
(initget 1)
(setq pl1 (getpoint "\nPick first alignment point : ")
pl2 (getpoint pl1 "\nPick second alignment point : ")
angs (angle pl1 pl2)
)
(rotgo angs)
)
((= rot:ans "A")
(initget 1)
(setq angs (* pi (/ (getreal "\nEnter rotation angle : ") 180.0)))
(rotgo angs)
)
((= rot:ans "3")
(initget 1)
(setq angs (* pi (/ 30 180.0)))
(rotgo angs)
)
((= rot:ans "4")
(initget 1)
(setq angs (* pi (/ 45 180.0)))
(rotgo angs)
)
((= rot:ans "6")
(initget 1)
(setq angs (* pi (/ 60 180.0)))
(rotgo angs)
)
((= rot:ans "R")
(setq angs 0)
(rotgo angs)
)
(t (princ "\nInvalid input."))
)
(setq *error* olderr)
(princ)
)
(princ)
;CODING ENDS HERE

The AutoLisp/Visual Lisp/VBA Resource Website

Copyright © 1999-Perpetuity by AfraLisp

All rights reserved.
Information in this document is subject to change without notice.
Site created and maintained by Kenny Ramage

The AutoLisp/Visual Lisp/VBA Resource Website