Author Topic: Auto Align Text to Curve  (Read 693 times)

0 Members and 1 Guest are viewing this topic.

GMap

  • Mosquito
  • Posts: 5
Auto Align Text to Curve
« on: January 09, 2019, 06:45:08 AM »
  I thank Lee Mac, who made this Lisp, this Lisp is very useful for me. Its multiple rotate Text to polyline Curve, but I need additional changes from experts.
  I need to rotate both text and block to polyline Curve.

Thanks
« Last Edit: February 21, 2019, 06:59:52 PM by GMap »

Dlanor

  • Newt
  • Posts: 126
Re: Auto Align Text to Curve
« Reply #1 on: January 09, 2019, 09:07:05 AM »
Try this

Code - Auto/Visual Lisp: [Select]
  1. (defun c:ABL ( / *error* c_doc ss pl_obj c_pt s_ang)
  2.  
  3.  (defun *error* ( msg )
  4.    (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  5.    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn Error : " msg " occurred.")))
  6.    (princ)
  7.  );_end_*error*_defun
  8.  
  9.  
  10.  (prompt "\nSelect Blocks to Align : ")
  11.  (setq ss (ssget '((0 . "INSERT"))))
  12.  
  13.  (cond (ss
  14.          (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  15.          (vla-startundomark c_doc)
  16.  
  17.          (setq pl_obj (vlax-ename->vla-object (car (entsel "Select Alignment Line : "))))
  18.          (vlax-for b_obj (vla-get-activeselectionset c_doc)
  19.            (setq c_pt (vlax-curve-getclosestpointto pl_obj (vlax-get b_obj 'insertionpoint))
  20.                  s_ang (angle '(0 0 0) (vlax-curve-getfirstderiv pl_obj (vlax-curve-getparamatpoint pl_obj c_pt)))
  21.            );end_setq
  22.            (vlax-put-property b_obj 'rotation s_ang)
  23.          );end_for
  24.        );end_sub_cond
  25.  );end_cond      
  26.  (setq ss nil)
  27.  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  28.  (princ)
  29. );end_defun
  30.  

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.

GMap

  • Mosquito
  • Posts: 5
Re: Auto Align Text to Curve
« Reply #2 on: January 09, 2019, 10:14:31 PM »
Hello sir,
        It's amazing, your Lisp will help me save a lot of time. I've checked your Lisp code on many drawings, it works very well. But can you align the text, Mtext, Multileader and block at the same time? I do not want to use two different Lisp.

Thank you
« Last Edit: January 09, 2019, 10:17:52 PM by GMap »

Dlanor

  • Newt
  • Posts: 126
Re: Auto Align Text to Curve
« Reply #3 on: January 10, 2019, 12:39:58 PM »
To rotate an MLeader it is neccessary to find the initial vertex of the Mleader line and use this as the rotation point to rotate the enire MLeader. The method used assumes that the initial point is the point of the arrow. However MLeaders can be constructed from the tail to the point. In this case the leader will still be rotated, but around the wrong point and will need to be moved.

Code - Auto/Visual Lisp: [Select]
  1. ;; Align To Line
  2.  
  3. (defun c:A2L ( / *error* rh:adj_ang c_doc ss pl_obj ml_verts c_pt s_ang )
  4.  
  5. (defun *error* ( msg )
  6. (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  7. (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred.")))
  8. );_end_*error*_defun
  9.  
  10. (defun rh:adj_ang (ang)
  11.           (cond ( (< (* pi 0.5) ang (* pi 1.5))
  12.                       (setq ang (+ ang pi))
  13.                       (while (> ang (* 2 pi)) (setq ang (- ang (* 2 pi))))
  14.                     )
  15.           );end_cond                  
  16.          ang
  17.  );end_defun
  18.  
  19.  
  20.  (prompt "\nSelect Text, MText, MLeaders and Blocks to Align : ")
  21.  (setq ss (ssget "_:L" '((0 . "*TEXT,INSERT,MULTILEADER"))))
  22.  
  23.  (cond (ss
  24.          (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  25.          (vla-startundomark c_doc)
  26.  
  27.          (setq pl_obj (vlax-ename->vla-object (car (entsel "Select Alignment Line : "))))
  28.          (vlax-for r_obj (vla-get-activeselectionset c_doc)
  29.            (cond ( (= (vlax-get-property r_obj 'objectname) "AcDbMLeader")
  30.                    (setq ml_verts (vlax-invoke r_obj 'getleaderlinevertices 0)
  31.                          c_pt (list (car ml_verts) (cadr ml_verts) 0.0)
  32.                          s_ang (rh:adj_ang (angle '(0 0 0) (vlax-curve-getfirstderiv pl_obj (vlax-curve-getparamatpoint pl_obj c_pt))))
  33.                    );end_setq
  34.                    (vlax-invoke r_obj 'rotate c_pt s_ang)                    
  35.                  )
  36.                  (t
  37.                    (setq c_pt (vlax-curve-getclosestpointto pl_obj (vlax-get r_obj 'insertionpoint))
  38.                          s_ang (rh:adj_ang (angle '(0 0 0) (vlax-curve-getfirstderiv pl_obj (vlax-curve-getparamatpoint pl_obj c_pt))))
  39.                    );end_setq
  40.                    (vlax-put-property r_obj 'rotation s_ang)
  41.                  )
  42.            );end_cond                              
  43.          );end_for
  44.        );end_sub_cond
  45.  );end_cond      
  46.  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  47.  (princ)
  48. );end_defun
  49.  

The lisp will ignore items on locked layers.
« Last Edit: January 10, 2019, 12:51:26 PM by Dlanor »

GMap

  • Mosquito
  • Posts: 5
Re: Auto Align Text to Curve
« Reply #4 on: January 10, 2019, 09:43:53 PM »
Dlanor,
    Thanks for the Lisp code and guidance, it is better than my expectations, I will always be grateful to you. :-)

tombu

  • Newt
  • Posts: 132
  • ByLayer=>Not0
Re: Auto Align Text to Curve
« Reply #5 on: January 17, 2019, 12:49:12 PM »
Modified to include Blocks and Mtext.
Code: [Select]
;|-------------------=={ 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                              ;;
;;----------------------------------------------------------------------;;
Tom Beauford P.S.M.
Leon County FL Public Works - Windows 7 64 bit AutoCAD Civil 3D

GMap

  • Mosquito
  • Posts: 5
Re: Auto Align Text to Curve
« Reply #6 on: January 18, 2019, 02:40:43 AM »
Tombu,
               Thank you for giving the extra code.

GMap

  • Mosquito
  • Posts: 5
Re: Auto Align Text to Curve
« Reply #7 on: February 09, 2019, 07:52:39 AM »
Hello sir,

          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/

Code: [Select]
;;; ------------------------------------------------------------------------
;;; 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)
)
« Last Edit: February 09, 2019, 07:56:48 AM by GMap »

tombu

  • Newt
  • Posts: 132
  • ByLayer=>Not0
Re: Auto Align Text to Curve
« Reply #8 on: February 09, 2019, 09:03:43 AM »
Hello sir,

          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/
You should look for sites where the authors post their code rather than ones that post collections of code gathered from the internet.
Look here where the author where he's updated the code in 2011: https://www.cadtutor.net/forum/topic/15148-zerorotationlsp-set-rotation-of-objects-to-zero-based-on-current-ucs/
Tom Beauford P.S.M.
Leon County FL Public Works - Windows 7 64 bit AutoCAD Civil 3D