TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: GMap on January 09, 2019, 06:45:08 AM

Title: Auto Align Text to Curve
Post by: GMap 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
Title: Re: Auto Align Text to Curve
Post by: Dlanor 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.
Title: Re: Auto Align Text to Curve
Post by: GMap 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
Title: Re: Auto Align Text to Curve
Post by: Dlanor 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.                 (princ)
  9.         );_end_*error*_defun
  10.  
  11.         (defun rh:adj_ang (ang)
  12.            (cond ( (< (* pi 0.5) ang (* pi 1.5))
  13.                        (setq ang (+ ang pi))
  14.                        (while (> ang (* 2 pi)) (setq ang (- ang (* 2 pi))))
  15.                      )
  16.            );end_cond                  
  17.           ang
  18.   );end_defun
  19.  
  20.  
  21.   (prompt "\nSelect Text, MText, MLeaders and Blocks to Align : ")
  22.   (setq ss (ssget "_:L" '((0 . "*TEXT,INSERT,MULTILEADER"))))
  23.  
  24.   (cond (ss
  25.           (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  26.           (vla-startundomark c_doc)
  27.          
  28.           (setq pl_obj (vlax-ename->vla-object (car (entsel "Select Alignment Line : "))))
  29.           (vlax-for r_obj (vla-get-activeselectionset c_doc)
  30.             (cond ( (= (vlax-get-property r_obj 'objectname) "AcDbMLeader")
  31.                     (setq ml_verts (vlax-invoke r_obj 'getleaderlinevertices 0)
  32.                           c_pt (list (car ml_verts) (cadr ml_verts) 0.0)
  33.                           s_ang (rh:adj_ang (angle '(0 0 0) (vlax-curve-getfirstderiv pl_obj (vlax-curve-getparamatpoint pl_obj c_pt))))
  34.                     );end_setq
  35.                     (vlax-invoke r_obj 'rotate c_pt s_ang)                    
  36.                   )
  37.                   (t
  38.                     (setq c_pt (vlax-curve-getclosestpointto pl_obj (vlax-get r_obj 'insertionpoint))
  39.                           s_ang (rh:adj_ang (angle '(0 0 0) (vlax-curve-getfirstderiv pl_obj (vlax-curve-getparamatpoint pl_obj c_pt))))
  40.                     );end_setq
  41.                     (vlax-put-property r_obj 'rotation s_ang)
  42.                   )
  43.             );end_cond                              
  44.           );end_for
  45.         );end_sub_cond
  46.   );end_cond      
  47.   (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  48.   (princ)
  49. );end_defun
  50.  

The lisp will ignore items on locked layers.
Title: Re: Auto Align Text to Curve
Post by: GMap 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. :-)
Title: Re: Auto Align Text to Curve
Post by: tombu 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                              ;;
;;----------------------------------------------------------------------;;
Title: Re: Auto Align Text to Curve
Post by: GMap on January 18, 2019, 02:40:43 AM
Tombu,
               Thank you for giving the extra code.
Title: Re: Auto Align Text to Curve
Post by: GMap 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/ (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)
)
Title: Re: Auto Align Text to Curve
Post by: tombu 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/ (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/
Title: Re: Auto Align Text to Curve
Post by: Pad on September 30, 2023, 12:31:01 PM
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.

I have a similar lisp to this as a vlx, I'm trying to make the move to Bricscad and this lisp works very well.  Any ideas how to change the lisp so that you select the line/polyline first, then for it to give you the option of selecting the blocks to rotate individually as well as an option to automatically detect and select the blocks with insertion points along the polyline/line vertices?  It wouldreally speed things up.

Thanks
P


I think I have answered my query...

This lisp will select all the touching blocks:

https://www.cadtutor.net/forum/topic/57973-select-all-the-blocks-that-are-touching-polylines/?do=findComment&comment=480354

So I just need to integrate, hopwefully that will be easy enough when I get a chance.

Cheers
P