;;; This Part of Program Modified by Henrique 2016
;;; ------------------------------------------------------------------------

(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
;;; This Part of Program Modified by Marko Ribar 2016
;;; https://www.theswamp.org/index.php?topic=51858.new;topicseen#new
(defun c:Axr1 ( / ax co ss i ed pt e ptt )

(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
)
)
(if (and (= (cdr (assoc 0 ed)) "INSERT") (= (cdr (assoc 66 ed)) 1))
(progn
(setq e (cdr (assoc -1 ed)))
(while (= (cdr (assoc 0 (entget (setq e (entnext e))))) "ATTRIB")
(setq ed (entget e)
ptt (assoc 10 ed)
)
(setq ed (entmod (subst (cons 72 0) (assoc 72 ed) ed)))
(setq ed (entmod (subst (list 11 0.0 0.0 0.0) (assoc 11 ed) ed)))
(entmod
(subst
(cond
( (= ax "X")
(list 10 (+ co (- (cadr ptt) (cadr pt))) (caddr ptt) (last ptt))
)
( (= ax "Y")
(list 10 (cadr ptt) (+ co (- (caddr ptt) (caddr pt))) (last ptt))
)
( (= ax "Z")
(list 10 (cadr ptt) (caddr ptt) (+ co (- (last ptt) (last pt))))
)
)
ptt
ed
)
)
)
)
)
)
)
(princ)
)
;;; Combined to one programm by Igal Averbuh 2016
(defun c:axr ()
(c:axr1)
(c:zr)
)
(c:axr)

Advertisements