;|-------------------=={ Auto Align Text to Curve }==-------------------
Prompts the user for a selection of single-line Text objects and a
curve for the alignment; rotates each text item to align with the
tangent vector at the nearest point on the curve.
----------------------------------------------------------------------
Author: Lee Mac, Copyright © 2013 - www.lee-mac.com
http://www.theswamp.org/index.php?topic=54837.0
----------------------------------------------------------------------
(load "Auto Align Text to Curve.lsp") atc |;
(defun c:atc ( / *error* ent enx idx sel )
(defun *error* ( msg )
(LM:endundo (LM:acdoc))
(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
(princ (strcat "\nError: " msg))
)
(princ)
)
(if
(and (setq sel (LM:ssget "\nSelect Text: " '("_:L" ((0 . "*TEXT,INSERT")))))
(progn
(while
(progn (setvar 'errno 0) (setq ent (car (entsel "\nSelect Curve: ")))
(cond
( (= 7 (getvar 'errno))
(princ "\nMissed, try again.")
)
( (= 'ename (type ent))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list ent)))
(princ "\nInvalid object selected.")
)
)
)
)
)
(= 'ename (type ent))
)
)
(progn
(LM:startundo (LM:acdoc))
(repeat (setq idx (sslength sel))
(setq enx (entget (ssname sel (setq idx (1- idx)))))
(entmod
(subst
(cons 50
(LM:readable
(angle '(0.0 0.0 0.0)
(trans
(vlax-curve-getfirstderiv ent
(vlax-curve-getparamatpoint ent
(vlax-curve-getclosestpointto ent
(trans
(cdr
(assoc
(if
(or
(= (cdr(assoc 0 enx)) "INSERT")
(= (cdr(assoc 0 enx)) "MTEXT")
(and
(zerop (cdr (assoc 72 enx)))
(zerop (cdr (assoc 73 enx)))
)
)
10 11
)
enx
)
)
(cdr (assoc -1 enx)) 0
)
)
)
)
0 (cdr (assoc -1 enx))
)
)
)
)
(assoc 50 enx) enx
)
)
)
(LM:endundo (LM:acdoc))
)
)
(command "_.justifytext" sel "" "MC")
(princ)
)
;; Readable - Lee Mac
;; Returns an angle corrected for text readability.
(defun LM:readable ( a )
( (lambda ( a )
(if (and (< (* pi 0.5) a) (<= a (* pi 1.5)))
(LM:readable (+ a pi))
a
)
)
(rem (+ a pi pi) (+ pi pi))
)
)
;; ssget - Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
(defun LM:ssget ( msg params / sel )
(princ msg)
(setvar 'nomutt 1)
(setq sel (vl-catch-all-apply 'ssget params))
(setvar 'nomutt 0)
(if (not (vl-catch-all-error-p sel)) sel)
)
;; Start Undo - Lee Mac
;; Opens an Undo Group.
(defun LM:startundo ( doc )
(LM:endundo doc)
(vla-startundomark doc)
)
;; End Undo - Lee Mac
;; Closes an Undo Group.
(defun LM:endundo ( doc )
(while (= 8 (logand 8 (getvar 'undoctl)))
(vla-endundomark doc)
)
)
;; Active Document - Lee Mac
;; Returns the VLA Active Document Object
(defun LM:acdoc nil
(eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
(LM:acdoc)
)
(vl-load-com) (princ)
;;----------------------------------------------------------------------;;
;; End of File ;;
;;----------------------------------------------------------------------;;
;;; ------------------------------------------------------------------------
;;; ZeroRotation.lsp v1.2
;;;
;;; Copyright© 03.09.09
;;; Alan J. Thompson (alanjt)
;;;
;;; Contact: alanjt @ TheSwamp.org, CADTutor.net
;;;
;;; Permission to use, copy, modify, and distribute this software
;;; for any purpose and without fee is hereby granted, provided
;;; that the above copyright notice appears in all copies and
;;; that both that copyright notice and the limited warranty and
;;; restricted rights notice below appear in all supporting
;;; documentation.
;;;
;;; The following program(s) are provided "as is" and with all faults.
;;; Alan J. Thompson DOES NOT warrant that the operation of the program(s)
;;; will be uninterrupted and/or error free.
;;;
;;; Set objects (Multileaders, Text, Mtext, Blocks) with a
;;; rotation of 0 (relative to current UCS).
;;;
;;; Revision History:
;;;
;;; v1.1 (10.23.09) 1. Minor rewrite for speed optimization.
;;; v1.2 (05.31.11) 1. Complete rewrite.
;;;
;;; ------------------------------------------------------------------------
(defun c:zr () (c:ZeroRotation))
(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 "_:L" '((0 . "INSERT,MTEXT,MULTILEADER,TEXT")))
(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.)
)
)
)
(vla-delete ss)
)
)
(*error* nil)
(princ)
)
Hello sir,You should look for sites where the authors post their code rather than ones that post collections of code gathered from the internet.
I have searched this Lisp from the internet, it can be rotated the Mleader to zero degree angle. So my question is that the leader can not be rotated according to the alignment?
https://lispbox.wordpress.com/2015/11/19/rotate-multileaders-text-mtext-blocks-to-zero-degree-relative-to-current-ucs/ (https://lispbox.wordpress.com/2015/11/19/rotate-multileaders-text-mtext-blocks-to-zero-degree-relative-to-current-ucs/)
Try thisCode - Auto/Visual Lisp: [Select]
);_end_*error*_defun );end_setq );end_for );end_sub_cond );end_cond );end_defun
It asks you to make a select set of the blocks to align (no layer or block name in filter), then the alignment line (no checks) .
It rotates the blocks about their insertion point.
Tested on your drawing. If you want it refining let me know.