Brilliant solution!
Is it possible to add your approach to this lisp?
now it works only for Blocks ,MTEXTs,*LEADERs and TEXTs.
With your addition it can works for polylines too
;;; ------------------------------------------------------------------------
(defun c:zzr () (c:zZeroRotation)) ; Rotate Multileaders, Text, Mtext, Blocks to 0 relative to current UCS
(defun c:zZeroRotation (/ *error* AT:UCSAngle ang ss name ldr pts23 base refang)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 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 "_:A" '((0 . "INSERT,MTEXT,*LEADER,TEXT"))); changed to *LEADER - both regular and Multi
(progn
(setq ang (AT:UCSAngle))
(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)
)
((eq name "AcDbMText") (vla-put-rotation x 0.))
((and (eq name "AcDbMLeader") (eq (vla-get-contenttype x) 2))
(vla-put-textrotation x 0.)
)
((eq name "AcDbLeader"); added another condition
(setq
ldr (vlax-vla-object->ename x); Leader entity
pts23 ; defining points 2 & 3
(cdr ; remove first one [arrow point]
(mapcar 'cdr ; remove 10's [leave coordinates only]
(vl-remove-if
'(lambda (x) (/= (car x) 10))
(entget ldr)
); ...remove...
); mapcar
); cdr & pts23
); setq
(command "_.rotate" ldr ""
(setq base (trans (car pts23) 0 1)); (trans)lated from WCS to current UCS
"_reference" (angtos (setq refang (angle base (trans (cadr pts23) 0 1))) 2 8)
(angtos (* (fix (+ (/ refang pi) 0.5)) pi) 2 8); nearer horizontal direction
); command
); Leader condition
); cond
); vlax-for
(vla-delete ss)
)
)
(*error* nil)
(princ)
)
;;; ------------------------------------------------------------------------
