;;; ------------------------------------------------------------------------

(defun c:zr () (c:ZeroRotation)) ; Rotate Multileaders, Text, Mtext, Blocks to 0 relative to current UCS
(defun c:ZeroRotation (/ *error* AT:UCSAngle ang ss name)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;?;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; SUBROUTINES ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;?;;;;;;;;;;;;;;;;;;;;;;

(defun *error* (msg)
(and *AcadDoc* (vla-endundomark *AcadDoc*))
(if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))
(princ (strcat "\nError: " msg))
)
)

(defun AT:UCSAngle (/)
;; Return current UCS angle
;; Alan J. Thompson, 04.06.10
((lambda (x) (atan (cadr x) (car x))) (trans (getvar 'UCSXDIR) 0 (trans '(0. 0. 1.) 1 0 T) T))
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;?;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; MAIN ROUTINE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;?;;;;;;;;;;;;;;;;;;;;;;

(vl-load-com)

(vla-startundomark
(cond (*AcadDoc*)
((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
)
)

(if (ssget "_P" '((0 . "INSERT,MTEXT,MULTILEADER,TEXT"))) ;_:L
(progn
(setq ang (AT:UCSAngle))
(setq *_ang (cond ((getangle (getvar 'lastpoint)
(strcat "\nSpecify rotation angle : "
)
)
)
(*_ang)
(0.0)
)
)
(vlax-for x (setq ss (vla-get-activeselectionset *AcadDoc*))
(cond ((vl-position (setq name (vla-get-objectname x)) '("AcDbBlockReference" "AcDbText"))
(vla-put-rotation x (+ ang *_ang))
)
((eq name "AcDbMText") (vla-put-rotation x *_ang))
((and (eq name "AcDbMLeader") (eq (vla-get-contenttype x) 2))
(vla-put-textrotation x *_ang)
)
)
)
(vla-delete ss)
)
)
(*error* nil)
(princ)
)

;;; --------------------------------------------------?----------------------

;;; Align all objects along one X/Y/Z axis of a reference point
;;; http://forums.autodesk.com/t5/visual-lisp-autolisp?-and-general/align-all-objects-along-one-x-y-z-axi?s-of-a-reference-point/m-p/5928797#U5928797
(defun c:AxR (/ ax co ed pt) ; ss
(initget "X Y Z")
(setq ax (cond ((getkword "Which coordinate make the same [X/Y/Z] : "))
("Y")
)
)
(initget 1)
(setq co (getpoint "\nSelect a destination point: ")
co (nth (- (ascii ax) 88) co)
)
(if (setq ss (ssget '((0 . "INSERT,*TEXT"))))
(repeat (setq i (sslength ss))
(setq ed (entget (ssname ss (setq i (1- i))))
pt (assoc 10 ed)
)
(entmod (subst (cond ((= ax "X")
(list 10 co (caddr pt) (last pt))
)
((= ax "Y")
(list 10 (cadr pt) co (last pt))
)
((= ax "Z")
(list 10 (cadr pt) (caddr pt) co)
)
)
pt
ed
)
)
)
)
(princ)
)
(c:axr)
(c:zr)

Advertisements