Automatic Qleader for text

May 14, 2022

1.   select text
2. (setq p1 (get point))
3.   entmake Qleader from p1 to test boundin box
4.   (From offset some distance from text bounding box)
   (Leader same as attached picture.)
   (From text left or right no issue)
   (if straight 2-point qleader or 3 point)

Edited May 14, 2022 by Ajmal
attach more picture

May 14, 2022

@Ajmal

For better understanding, and maybe get further help, please upload such sample.dwg
As far as I know, ACAD only can edit DWG.

May 15, 2022

TEST FILE.dwg

May 19, 2022

try this;

(alert "ONLY WORKS ON MTEXT
Command:ASD
SMART LEADER
")
(setq osm (getvar 'osmode))
(defun c:asd ()					
  (command "ucs" "w")					;return to ucs
  (setvar 'osmode 0)
  (setq a (car (entsel))				;select of text
	b (entget a)					;convert to list
	c (vlax-ename->vla-object a)			;convert ot vla?
	d (cdr (assoc 10 b))				;get origin point
	e 140 						;text offset
	f 1000				 		;scale
	g (vlax-get-property c 'width) 			;width of text
	h (list 0.0 (* -1 e) 0.0)			;leader alignment left
	i (list g (* -1 e) 0.0)				;leader alignment right
  )
(command "ucs" "object" a)				;ucs of object
(command "xline" h i "")				;xline for reference
(setq xl-del (entlast))					;for deletion of xline
(setq j (getpoint h))					;point where leader will be
(if (< (distance j h) (distance j i))			;detecting which side
  (setq k j l h m i)					;setting up points
  (setq k j l i m h))					;setting up points
(command "leader" k l m "" "" "n")			;leader
(command "erase" xl-del "")				;delete xline
(setvar 'osmode osm)
(command "ucs" "w")					;return to ucs
  )

May 19, 2022

; ELEAD - 2022.05.19 exceed
; https://www.cadtutor.net/forum/topic/75182-automatic-qleader-for-text/
; If you select text and click a point, a LEADER is created 
; that connects the underline of the text.
; 
; Command List
; ELEAD - Make 1 Leader
; MELEAD - Make multiple leaders. towards 1 point
; ELEADRESET - Reset property values
;
; - This is a minor modification of Lee Mac's StrikeThrough Text ( http://www.lee-mac.com/strikethrough.html )
;
; - Created on the current layer. by current color
; - Individual Arrow Size is set without modifying STYLE.
; - works for rotated text.
; - Leaders are created from the left or right side closest to the base point.
; - whenever you open a drawing, you have to set the environment the first time.
; - When Pick is difficult, you can get help from a crossing selection.
; - If no selection is made, it is terminated.
;
; - To make it easier to draw a horizontal line, getpoint based on an imaginary center point. (ELEAD Only)
; - If multiple texts are selected, only one of them is randomly selected. (ELEAD Only)



(vl-load-com)
(defun C:ELEAD ( / enttext lst basept hgt md1 md2 ang pt0 pt1 pt2 dist1 dist2 newpt1 newpt2 ss )
 
 (if (= exoffset nil)
   (progn 
     (princ "\n this is first time you run ELEAD lisp in this dwg.")
     (setq exoffset (getreal "\n input horizontal offset (Real size) (space bar = 35)"))
     (if (= exoffset nil) (setq exoffset 35))
   )
 )

 (if (= exoffsety nil)
   (progn
     (setq exoffsety (getreal "\n input vertical offset (Ratio of Textheight, example : 1 = Top, 0 = Mid, -1 = Bottom) (space bar = -1.4)"))
     (if (= exoffsety nil) (setq exoffsety -1.4))
   )
 )

 (if (= arrowsizecustom nil)
   (progn 
     (setq arrowsizecustom (getreal "\n input arrow size (Real size) (space bar = 85)"))
     (if (= arrowsizecustom nil) (setq arrowsizecustom 85))
   )
 )

 (princ "\n ELEAD Settings - Horizontal Offset : ")
 (princ exoffset)
 (princ " / Vertical Offset : ")
 (princ exoffsety)
 (princ " / Arrow Size : ")
 (princ arrowsizecustom)
 (princ "\n If you want to reset these value, cancel this and input command : ELEADRESET ") 

 (while (setq ss (ssget ":S" '((0 . "*TEXT")))) 
   (setq enttext (ssname ss 0))
   (setq enx (entget enttext))

   (setq lst (LM:textbox enx))
   
   (setq hgt (cdr (assoc 40 enx))
          md1 (mid (car  lst) (last  lst))
          md2 (mid (cadr lst) (caddr lst))
          ang (angle (car  lst) (last  lst))
   )
   (setq pt1 (polar (polar (last lst) ang (* exoffsety hgt)) (+ ang (/ pi 2)) exoffset))
   (setq pt2 (polar (polar (caddr lst) ang (* exoffsety hgt)) (+ ang (* pi 1.5)) exoffset))
   (setq pt0 (mid pt1 pt2))
   (setq basept (getpoint pt0 "\n pick point for leader "))
   ;(setq pt1 (polar (polar md1 ang (* exoffsety hgt)) (+ ang (/ pi 2)) exoffset))
   ;(setq pt2 (polar (polar md2 ang (* exoffsety hgt)) (+ ang (* pi 1.5)) exoffset))

   (setq dist1 (distance basept pt1))
   (setq dist2 (distance basept pt2))
   (if (< dist2 dist1)
     (progn
       (setq newpt1 pt2)
       (setq newpt2 pt1)
     )
     (progn
       (setq newpt1 pt1)
       (setq newpt2 pt2)
     )
   )

   (entmake (list (cons 0 "LEADER") 
                     (cons 100 "AcDbEntity") 
                     (cons 67 0) 
                     (cons 100 "AcDbLeader") 
                     (cons 71 1) 
                     (cons 72 0) 
                     (cons 73 0) 
                     (cons 74 0) 
                     (cons 75 0) 
                     (cons 40 1) 
                     (cons 41 1) 
                     (cons 76 3) 
                     (cons 10 basept) 
                     (cons 10 newpt1) 
                     (cons 10 newpt2))
   )


   (vla-put-ArrowheadSize (vlax-ename->vla-object (entlast)) arrowsizecustom)

 );end of while

 (princ)
)

(defun C:ELEADRESET ( )
 (princ "\n Latest ELEAD Settings = Horizontal Offset [ ")
 (princ exoffset)
 (princ " ] / Vertical Offset [ ")
 (princ exoffsety)
 (princ " ] / Arrow Size [ ")
 (princ arrowsizecustom)
 (princ " ] is now deleted.")
 (setq exoffset nil)
 (setq exoffsety nil)
 (setq arrowsizecustom nil)
 (princ)
)



(defun C:MELEAD ( / enttext lst basept hgt md1 md2 ang pt0 pt1 pt2 dist1 dist2 newpt1 newpt2 ss ssl index)
 
 (if (= exoffset nil)
   (progn 
     (princ "\n this is first time you run ELEAD lisp in this dwg.")
     (setq exoffset (getreal "\n input horizontal offset (Real size) (space bar = 35)"))
     (if (= exoffset nil) (setq exoffset 35))
   )
 )

 (if (= exoffsety nil)
   (progn
     (setq exoffsety (getreal "\n input vertical offset (Ratio of Textheight, example : 1 = Top, 0 = Mid, -1 = Bottom) (space bar = -1.4)"))
     (if (= exoffsety nil) (setq exoffsety -1.4))
   )
 )

 (if (= arrowsizecustom nil)
   (progn 
     (setq arrowsizecustom (getreal "\n input arrow size (Real size) (space bar = 85)"))
     (if (= arrowsizecustom nil) (setq arrowsizecustom 85))
   )
 )

 (princ "\n ELEAD Settings - Horizontal Offset : ")
 (princ exoffset)
 (princ " / Vertical Offset : ")
 (princ exoffsety)
 (princ " / Arrow Size : ")
 (princ arrowsizecustom)
 (princ "\n If you want to reset these value, cancel this and input command : ELEADRESET ") 

 (setq basept (getpoint "\n pick point for leader "))

 (while (setq ss (ssget ":S" '((0 . "*TEXT"))))
   (setq ssl (sslength ss))
   (setq index 0)

   (repeat ssl
     (setq enttext (ssname ss index))
     (setq enx (entget enttext))
     (setq lst (LM:textbox enx))

     (setq hgt (cdr (assoc 40 enx)))
     (setq md1 (mid (car  lst) (last  lst)))
     (setq md2 (mid (cadr lst) (caddr lst)))
     (setq ang (angle (car  lst) (last  lst)))

     (setq pt1 (polar (polar (last lst) ang (* exoffsety hgt)) (+ ang (/ pi 2)) exoffset))
     (setq pt2 (polar (polar (caddr lst) ang (* exoffsety hgt)) (+ ang (* pi 1.5)) exoffset))

     (setq dist1 (distance basept pt1))
     (setq dist2 (distance basept pt2))
     (if (< dist2 dist1)
       (progn
         (setq newpt1 pt2)
         (setq newpt2 pt1)
       )
       (progn
         (setq newpt1 pt1)
         (setq newpt2 pt2)
       )
     )

     (entmake (list (cons 0 "LEADER") 
                     (cons 100 "AcDbEntity") 
                     (cons 67 0) 
                     (cons 100 "AcDbLeader") 
                     (cons 71 1) 
                     (cons 72 0) 
                     (cons 73 0) 
                     (cons 74 0) 
                     (cons 75 0) 
                     (cons 40 1) 
                     (cons 41 1) 
                     (cons 76 3) 
                     (cons 10 basept) 
                     (cons 10 newpt1) 
                     (cons 10 newpt2))
     )
     (vla-put-ArrowheadSize (vlax-ename->vla-object (entlast)) arrowsizecustom)
     (setq index (+ index 1))
   )

 );end of while

 (princ)
)



(defun mid ( a b )
    (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) a b)
)

(defun LM:textbox ( enx / bpt hgt jus lst ocs org rot wid )
    (cond
        (   (and (= "ATTRIB" (cdr (assoc 000 enx)))
                 (= "Embedded Object" (cdr (assoc 101 enx)))
            )
            (LM:textbox (cons '(000 . "MTEXT") (member '(101 . "Embedded Object") enx)))
        )
        (   (cond
                (   (wcmatch  (cdr (assoc 000 enx)) "ATTRIB,TEXT")
                    (setq bpt (cdr (assoc 010 enx))
                          rot (cdr (assoc 050 enx))
                          lst (textbox enx)
                          lst (list (car lst) (list (caadr lst) (cadar lst)) (cadr lst) (list (caar lst) (cadadr lst)))
                    )
                )
                (   (= "MTEXT" (cdr (assoc 000 enx)))
                    (setq ocs  (cdr (assoc 210 enx))
                          bpt  (trans (cdr (assoc 010 enx)) 0 ocs)
                          rot  (angle '(0.0 0.0) (trans (cdr (assoc 011 enx)) 0 ocs))
                          wid  (cdr (assoc 042 enx))
                          hgt  (cdr (assoc 043 enx))
                          jus  (cdr (assoc 071 enx))
                          org  (list (cond ((member jus '(2 5 8)) (/ wid -2.0)) ((member jus '(3 6 9)) (- wid))      (0.0))
                                     (cond ((member jus '(1 2 3)) (- hgt))      ((member jus '(4 5 6)) (/ hgt -2.0)) (0.0))
                               )
                          lst  (list org (mapcar '+ org (list wid 0)) (mapcar '+ org (list wid hgt)) (mapcar '+ org (list 0 hgt)))
                    )
                )
            )
            (   (lambda ( m ) (mapcar '(lambda ( p ) (mapcar '+ (mxv m p) bpt)) lst))
                (list
                    (list (cos rot) (sin (- rot)) 0.0)
                    (list (sin rot) (cos rot)     0.0)
                   '(0.0 0.0 1.0)
                )
            )
        )
    )
)

how about this?

command : ELEAD

Edited May 19, 2022 by exceed

May 19, 2022

This is exactly what i expect

Thanks, exceed

but i have request for this

1. Can you do this for ucs also?

2 as attached drawing there is one ore item is coming with leader so vertical text i cannot arrange (i think that is landing point)

TEST.dwg

Edited May 19, 2022 by Ajmal
explanation

May 19, 2022

; ELEAD ucs modified ver. - 2022.05.19 exceed
; https://www.cadtutor.net/forum/topic/75182-automatic-qleader-for-text/
; If you select text and click a point, a LEADER is created 
; that connects the underline of the text.
; 
; Command List
; ELEAD - Make 1 Leader
; MELEAD - Make multiple leaders. towards 1 point
; ELEADRESET - Reset property values
;
; - This is a minor modification of Lee Mac's StrikeThrough Text ( http://www.lee-mac.com/strikethrough.html )
;
; - Created on the current layer. by current color
; - Individual Arrow Size is set without modifying STYLE.
; - works for rotated text.
; - Leaders are created from the left or right side closest to the base point.
; - whenever you open a drawing, you have to set the environment the first time.
; - When Pick is difficult, you can get help from a crossing selection.
; - If no selection is made, it is terminated.
;
; - To make it easier to draw a horizontal line, getpoint based on an imaginary center point. (ELEAD Only)
; - If multiple texts are selected, only one of them is randomly selected. (ELEAD Only)



(vl-load-com)
(defun C:ELEAD ( / *error* objtext textangle leaderobj enttext lst basept hgt md1 md2 ang pt0 pt1 pt2 dist1 dist2 newpt1 newpt2 ss )

  (LM:startundo (LM:acdoc))
  (setvar 'cmdecho 0)
  (command "_.UCS" "W")

  ;error control
    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (command "_.UCS" "P")
        (setvar 'cmdecho 1)
        (princ)
    )

 (if (= exoffset nil)
   (progn 
     (princ "\n this is first time you run ELEAD lisp in this dwg.")
     (setq exoffset (getreal "\n input horizontal offset (Real size) (space bar = 35)"))
     (if (= exoffset nil) (setq exoffset 35))
   )
 )

 (if (= exoffsety nil)
   (progn
     (setq exoffsety (getreal "\n input vertical offset (Ratio of Textheight, example : 1 = Top, 0 = Mid, -1 = Bottom) (space bar = -1.4)"))
     (if (= exoffsety nil) (setq exoffsety -1.4))
   )
 )

 (if (= arrowsizecustom nil)
   (progn 
     (setq arrowsizecustom (getreal "\n input arrow size (Real size) (space bar = 85)"))
     (if (= arrowsizecustom nil) (setq arrowsizecustom 85))
   )
 )

 (princ "\n ELEAD Settings - Horizontal Offset : ")
 (princ exoffset)
 (princ " / Vertical Offset : ")
 (princ exoffsety)
 (princ " / Arrow Size : ")
 (princ arrowsizecustom)
 (princ "\n If you want to reset these value, cancel this and input command : ELEADRESET ") 

 (while (setq ss (ssget ":S" '((0 . "*TEXT")))) 
   (setq enttext (ssname ss 0))
  
   ;part start - for rotate texts 0 or 270
   (setq objtext (vlax-ename->vla-object enttext))
   (setq textangle (RtD (vlax-get-property objtext 'rotation)))
   (cond 
     ((and (>= textangle 0) (< textangle 45))
       (vlax-put-property objtext 'rotation (DtR 0))
     )
     ((and (>= textangle 45) (< textangle 135))
       (vlax-put-property objtext 'rotation (DtR 270))
     )
     ((and (>= textangle 135) (< textangle 225))
       (vlax-put-property objtext 'rotation (DtR 0))        
     )
     ((and (>= textangle 225) (< textangle 315))
       (vlax-put-property objtext 'rotation (DtR 270))
     )
     ((and (>= textangle 315) (< textangle 360))
       (vlax-put-property objtext 'rotation (DtR 0))        
     ) 
   );end of cond
   ;part end

   (setq enx (entget enttext))

   (setq lst (LM:textbox enx))
   
   (setq hgt (cdr (assoc 40 enx))
          md1 (mid (car  lst) (last  lst))
          md2 (mid (cadr lst) (caddr lst))
          ang (angle (car  lst) (last  lst))
   )
   (setq pt1 (polar (polar (last lst) ang (* exoffsety hgt)) (+ ang (/ pi 2)) exoffset))
   (setq pt2 (polar (polar (caddr lst) ang (* exoffsety hgt)) (+ ang (* pi 1.5)) exoffset))
   (setq pt0 (mid pt1 pt2))
   (setq basept (getpoint pt0 "\n pick point for leader "))
   (setq basept (trans basept 1 0))
   
   ;(setq pt1 (polar (polar md1 ang (* exoffsety hgt)) (+ ang (/ pi 2)) exoffset))
   ;(setq pt2 (polar (polar md2 ang (* exoffsety hgt)) (+ ang (* pi 1.5)) exoffset))

   (setq dist1 (distance basept pt1))
   (setq dist2 (distance basept pt2))
   (if (< dist2 dist1)
     (progn
       (setq newpt1 pt2)
       (setq newpt2 pt1)
     )
     (progn
       (setq newpt1 pt1)
       (setq newpt2 pt2)
     )
   )

   (entmake (list (cons 0 "LEADER") 
                     (cons 100 "AcDbEntity") 
                     (cons 67 0) 
                     (cons 100 "AcDbLeader") 
                     (cons 71 1) 
                     (cons 72 0) 
                     (cons 73 0) 
                     (cons 74 0) 
                     (cons 75 0) 
                     (cons 40 1) 
                     (cons 41 1) 
                     (cons 76 3) 
                     (cons 10 basept) 
                     (cons 10 newpt1) 
                     (cons 10 newpt2))
   )

   (setq leaderobj (vlax-ename->vla-object (entlast)))
   (vla-put-ArrowheadSize leaderobj arrowsizecustom)
   (vlax-put-property leaderobj 'type 2) ; make line with arrow
   (vlax-put-property leaderobj 'scalefactor 1) ; make scale 1
   

 );end of while


 (command "_.UCS" "P")
 (setvar 'cmdecho 1)
 (LM:endundo (LM:acdoc))
 (princ)
)

(defun C:ELEADRESET ( )
 (princ "\n Latest ELEAD Settings = Horizontal Offset [ ")
 (princ exoffset)
 (princ " ] / Vertical Offset [ ")
 (princ exoffsety)
 (princ " ] / Arrow Size [ ")
 (princ arrowsizecustom)
 (princ " ] is now deleted.")
 (setq exoffset nil)
 (setq exoffsety nil)
 (setq arrowsizecustom nil)
 (princ)
)



(defun C:MELEAD ( / *error* objtext textangle leaderobj enttext lst basept hgt md1 md2 ang pt0 pt1 pt2 dist1 dist2 newpt1 newpt2 ss ssl index)
 
  (LM:startundo (LM:acdoc))
  (setvar 'cmdecho 0)
  (command "_.UCS" "W")

  ;error control
    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (command "_.UCS" "P")
        (setvar 'cmdecho 1)
        (princ)
    )


 (if (= exoffset nil)
   (progn 
     (princ "\n this is first time you run ELEAD lisp in this dwg.")
     (setq exoffset (getreal "\n input horizontal offset (Real size) (space bar = 35)"))
     (if (= exoffset nil) (setq exoffset 35))
   )
 )

 (if (= exoffsety nil)
   (progn
     (setq exoffsety (getreal "\n input vertical offset (Ratio of Textheight, example : 1 = Top, 0 = Mid, -1 = Bottom) (space bar = -1.4)"))
     (if (= exoffsety nil) (setq exoffsety -1.4))
   )
 )

 (if (= arrowsizecustom nil)
   (progn 
     (setq arrowsizecustom (getreal "\n input arrow size (Real size) (space bar = 85)"))
     (if (= arrowsizecustom nil) (setq arrowsizecustom 85))
   )
 )

 (princ "\n ELEAD Settings - Horizontal Offset : ")
 (princ exoffset)
 (princ " / Vertical Offset : ")
 (princ exoffsety)
 (princ " / Arrow Size : ")
 (princ arrowsizecustom)
 (princ "\n If you want to reset these value, cancel this and input command : ELEADRESET ") 

 (setq basept (getpoint "\n pick point for leader "))
 (setq basept (trans basept 1 0))

 (while (setq ss (ssget ":S" '((0 . "*TEXT"))))
   (setq ssl (sslength ss))
   (setq index 0)

   (repeat ssl
     (setq enttext (ssname ss index))

   ;part start - for rotate texts 0 or 270
   (setq objtext (vlax-ename->vla-object enttext))
   (setq textangle (RtD (vlax-get-property objtext 'rotation)))
   (cond 
     ((and (>= textangle 0) (< textangle 45))
       (vlax-put-property objtext 'rotation (DtR 0))
     )
     ((and (>= textangle 45) (< textangle 135))
       (vlax-put-property objtext 'rotation (DtR 270))
     )
     ((and (>= textangle 135) (< textangle 225))
       (vlax-put-property objtext 'rotation (DtR 0))        
     )
     ((and (>= textangle 225) (< textangle 315))
       (vlax-put-property objtext 'rotation (DtR 270))
     )
     ((and (>= textangle 315) (< textangle 360))
       (vlax-put-property objtext 'rotation (DtR 0))        
     ) 
   );end of cond
   ;part end




     (setq enx (entget enttext))
     (setq lst (LM:textbox enx))

     (setq hgt (cdr (assoc 40 enx)))
     (setq md1 (mid (car  lst) (last  lst)))
     (setq md2 (mid (cadr lst) (caddr lst)))
     (setq ang (angle (car  lst) (last  lst)))

     (setq pt1 (polar (polar (last lst) ang (* exoffsety hgt)) (+ ang (/ pi 2)) exoffset))
     (setq pt2 (polar (polar (caddr lst) ang (* exoffsety hgt)) (+ ang (* pi 1.5)) exoffset))

     (setq dist1 (distance basept pt1))
     (setq dist2 (distance basept pt2))
     (if (< dist2 dist1)
       (progn
         (setq newpt1 pt2)
         (setq newpt2 pt1)
       )
       (progn
         (setq newpt1 pt1)
         (setq newpt2 pt2)
       )
     )

     (entmake (list (cons 0 "LEADER") 
                     (cons 100 "AcDbEntity") 
                     (cons 67 0) 
                     (cons 100 "AcDbLeader") 
                     (cons 71 1) 
                     (cons 72 0) 
                     (cons 73 0) 
                     (cons 74 0) 
                     (cons 75 0) 
                     (cons 40 1) 
                     (cons 41 1) 
                     (cons 76 3) 
                     (cons 10 basept) 
                     (cons 10 newpt1) 
                     (cons 10 newpt2))
     )
     (setq leaderobj (vlax-ename->vla-object (entlast)))
     (vla-put-ArrowheadSize leaderobj arrowsizecustom)
     (vlax-put-property leaderobj 'type 2) ; make line with arrow
     (vlax-put-property leaderobj 'scalefactor 1) ; make scale 1
     (setq index (+ index 1))
   )

 );end of while



 (command "_.UCS" "P")
 (setvar 'cmdecho 1)
 (LM:endundo (LM:acdoc))
 (princ)
)

(defun RtD (r) (* 180.0 (/ r pi)))
(defun DtR (d) (* pi (/ d 180.0)))

(defun mid ( a b )
    (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) a b)
)

(defun LM:textbox ( enx / bpt hgt jus lst ocs org rot wid )
    (cond
        (   (and (= "ATTRIB" (cdr (assoc 000 enx)))
                 (= "Embedded Object" (cdr (assoc 101 enx)))
            )
            (LM:textbox (cons '(000 . "MTEXT") (member '(101 . "Embedded Object") enx)))
        )
        (   (cond
                (   (wcmatch  (cdr (assoc 000 enx)) "ATTRIB,TEXT")
                    (setq bpt (cdr (assoc 010 enx))
                          rot (cdr (assoc 050 enx))
                          lst (textbox enx)
                          lst (list (car lst) (list (caadr lst) (cadar lst)) (cadr lst) (list (caar lst) (cadadr lst)))
                    )
                )
                (   (= "MTEXT" (cdr (assoc 000 enx)))
                    (setq ocs  (cdr (assoc 210 enx))
                          bpt  (trans (cdr (assoc 010 enx)) 0 ocs)
                          rot  (angle '(0.0 0.0) (trans (cdr (assoc 011 enx)) 0 ocs))
                          wid  (cdr (assoc 042 enx))
                          hgt  (cdr (assoc 043 enx))
                          jus  (cdr (assoc 071 enx))
                          org  (list (cond ((member jus '(2 5 8)) (/ wid -2.0)) ((member jus '(3 6 9)) (- wid))      (0.0))
                                     (cond ((member jus '(1 2 3)) (- hgt))      ((member jus '(4 5 6)) (/ hgt -2.0)) (0.0))
                               )
                          lst  (list org (mapcar '+ org (list wid 0)) (mapcar '+ org (list wid hgt)) (mapcar '+ org (list 0 hgt)))
                    )
                )
            )
            (   (lambda ( m ) (mapcar '(lambda ( p ) (mapcar '+ (mxv m p) bpt)) lst))
                (list
                    (list (cos rot) (sin (- rot)) 0.0)
                    (list (sin rot) (cos rot)     0.0)
                   '(0.0 0.0 1.0)
                )
            )
        )
    )
)

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)

(MLEAD, this is for show examples in several cases, ELEAD will work the same way for 1 text)

My English is not good, so I don't know what vertical arrangement means.

I understand that you want the text to be rotated horizontally or vertically.

original text : 0 ~ 45 deg -> 0 deg

original text : 45 ~ 135 deg -> 270 deg

like this, they were aligned to the nearest side. is this right?

and then Changes ucs vertically to the visible screen while the origin is moved & the z-axis is rotated.

+

If you want, the UCS has only the origin moved and you want to be perpendicular to the direction of UCS rotation,

Add a ; before all (command "UCS" "W") and (command "UCS" "P").

like this gif

Edited May 20, 2022 by exceed

May 24, 2022

wow. really it genuinely nice one

i add some rotation off for this

; ELEAD ucs modified ver. - 2022.05.19 exceed
; https://www.cadtutor.net/forum/topic/75182-automatic-qleader-for-text/
; If you select text and click a point, a LEADER is created 
; that connects the underline of the text.
; 
; Command List
; ELEAD - Make 1 Leader
; MELEAD - Make multiple leaders. towards 1 point
; ELEADRESET - Reset property values
;
; - This is a minor modification of Lee Mac's StrikeThrough Text ( http://www.lee-mac.com/strikethrough.html )
;
; - Created on the current layer. by current color
; - Individual Arrow Size is set without modifying STYLE.
; - works for rotated text.
; - Leaders are created from the left or right side closest to the base point.
; - whenever you open a drawing, you have to set the environment the first time.
; - When Pick is difficult, you can get help from a crossing selection.
; - If no selection is made, it is terminated.
;
; - To make it easier to draw a horizontal line, getpoint based on an imaginary center point. (ELEAD Only)
; - If multiple texts are selected, only one of them is randomly selected. (ELEAD Only)



(vl-load-com)
(defun C:ELEAD ( / *error* objtext textangle leaderobj enttext lst basept hgt md1 md2 ang pt0 pt1 pt2 dist1 dist2 newpt1 newpt2 ss )

  (LM:startundo (LM:acdoc))
  (setvar 'cmdecho 0)
  (command "_.UCS" "W")

  ;error control
    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (command "_.UCS" "P")
        (setvar 'cmdecho 1)
        (princ)
    )

 (if (= exoffset nil)
   (progn 
     (princ "\n this is first time you run ELEAD lisp in this dwg.")
     (setq exoffset (getreal "\n input horizontal offset (Real size) (space bar = 10)"))
     (if (= exoffset nil) (setq exoffset 10))
   )
 )

 (if (= exoffsety nil)
   (progn
     (setq exoffsety (getreal "\n input vertical offset (Ratio of Textheight, example : 1 = Top, 0 = Mid, -1 = Bottom) (space bar = -1.25)"))
     (if (= exoffsety nil) (setq exoffsety -1.25))
   )
 )

 (if (= arrowsizecustom nil)
   (progn 
     (setq arrowsizecustom (getreal "\n input arrow size (Real size) (space bar = 85)"))
     (if (= arrowsizecustom nil) (setq arrowsizecustom 85))
   )
 )
  (if
    (null inttxt)
    (setq inttxt "Yes")
  )
(initget "Yes No")
(if
  (setq tmp(getkword (strcat "\nText rotation [Yes/No] <" inttxt ">:")))
  (setq inttxt tmp)
 )

 (princ "\n ELEAD Settings - Horizontal Offset : ")
 (princ exoffset)
 (princ " / Vertical Offset : ")
 (princ exoffsety)
 (princ " / Arrow Size : ")
 (princ arrowsizecustom)
 (princ "\n If you want to reset these value, cancel this and input command : ELEADRESET ") 

 (while (setq ss (ssget ":S" '((0 . "*TEXT")))) 
   (setq enttext (ssname ss 0))
  
   ;part start - for rotate texts 0 or 270
   (setq objtext (vlax-ename->vla-object enttext))
   (setq textangle (RtD (vlax-get-property objtext 'rotation)))
   (if (= inttxt "Yes")
     (progn
   (cond 
     ((and (>= textangle 0) (< textangle 45))
       (vlax-put-property objtext 'rotation (DtR 0))
     )
     ((and (>= textangle 45) (< textangle 135))
       (vlax-put-property objtext 'rotation (DtR 270))
     )
     ((and (>= textangle 135) (< textangle 225))
       (vlax-put-property objtext 'rotation (DtR 0))        
     )
     ((and (>= textangle 225) (< textangle 315))
       (vlax-put-property objtext 'rotation (DtR 270))
     )
     ((and (>= textangle 315) (< textangle 360))
       (vlax-put-property objtext 'rotation (DtR 0))        
     ) 
   )))
    ;end of cond
   ;part end

   (setq enx (entget enttext))

   (setq lst (LM:textbox enx))
   
   (setq hgt (cdr (assoc 40 enx))
          md1 (mid (car  lst) (last  lst))
          md2 (mid (cadr lst) (caddr lst))
          ang (angle (car  lst) (last  lst))
   )
   (setq pt1 (polar (polar (last lst) ang (* exoffsety hgt)) (+ ang (/ pi 2)) exoffset))
   (setq pt2 (polar (polar (caddr lst) ang (* exoffsety hgt)) (+ ang (* pi 1.5)) exoffset))
   (setq pt0 (mid pt1 pt2))
   (setq basept (getpoint pt0 "\n pick point for leader "))
   (setq basept (trans basept 1 0))
   
   
   ;(setq pt1 (polar (polar md1 ang (* exoffsety hgt)) (+ ang (/ pi 2)) exoffset))
   ;(setq pt2 (polar (polar md2 ang (* exoffsety hgt)) (+ ang (* pi 1.5)) exoffset))

   (setq dist1 (distance basept pt1))
   (setq dist2 (distance basept pt2))
   (if (< dist2 dist1)
     (progn
       (setq newpt1 pt2)
       (setq newpt2 pt1)
     )
     (progn
       (setq newpt1 pt1)
       (setq newpt2 pt2)
     )
   )
   (entmake (list (cons 0 "LEADER") 
                      (cons 8 (cdr (assoc 8(entget enttext))))
                     (cons 100 "AcDbEntity") 
                     (cons 67 0) 
                     (cons 100 "AcDbLeader") 
                     (cons 71 1) 
                     (cons 72 0) 
                     (cons 73 3) 
                     (cons 74 0) 
                     (cons 75 0) 
                     (cons 40 1) 
                     (cons 41 1) 
                     (cons 76 3) 
                     (cons 10 basept) 
                     (cons 10 newpt1) 
                     (cons 10 newpt2))
   )

   (setq leaderobj (vlax-ename->vla-object (entlast)))
   (vla-put-ArrowheadSize leaderobj arrowsizecustom)
   (vlax-put-property leaderobj 'type 2) ; make line with arrow
   
   

 );end of while


 (command "_.UCS" "P")
 (setvar 'cmdecho 1)
 (LM:endundo (LM:acdoc))
 (princ)
)

(defun C:ELEADRESET ( )
 (princ "\n Latest ELEAD Settings = Horizontal Offset [ ")
 (princ exoffset)
 (princ " ] / Vertical Offset [ ")
 (princ exoffsety)
 (princ " ] / Arrow Size [ ")
 (princ arrowsizecustom)
 (princ " ] is now deleted.")
 (setq exoffset nil)
 (setq exoffsety nil)
 (setq arrowsizecustom nil)
 (princ)
)



(defun C:MELEAD ( / *error* objtext textangle leaderobj enttext lst basept hgt md1 md2 ang pt0 pt1 pt2 dist1 dist2 newpt1 newpt2 ss ssl index)
 
  (LM:startundo (LM:acdoc))
  (setvar 'cmdecho 0)
  (command "_.UCS" "W")

  ;error control
    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (command "_.UCS" "P")
        (setvar 'cmdecho 1)
        (princ)
    )


 (if (= exoffset nil)
   (progn 
     (princ "\n this is first time you run ELEAD lisp in this dwg.")
     (setq exoffset (getreal "\n input horizontal offset (Real size) (space bar = 10)"))
     (if (= exoffset nil) (setq exoffset 10))
   )
 )

 (if (= exoffsety nil)
   (progn
     (setq exoffsety (getreal "\n input vertical offset (Ratio of Textheight, example : 1 = Top, 0 = Mid, -1 = Bottom) (space bar = -1.25)"))
     (if (= exoffsety nil) (setq exoffsety -1.25))
   )
 )

 (if (= arrowsizecustom nil)
   (progn 
     (setq arrowsizecustom (getreal "\n input arrow size (Real size) (space bar = 85)"))
     (if (= arrowsizecustom nil) (setq arrowsizecustom 85))
   )
 )
  (if
    (null inttxt)
    (setq inttxt "Yes")
  )
(initget "Yes No")
(if
  (setq tmp(getkword (strcat "\nText rotation [Yes/No] <" inttxt ">:")))
  (setq inttxt tmp)
 )

 (princ "\n ELEAD Settings - Horizontal Offset : ")
 (princ exoffset)
 (princ " / Vertical Offset : ")
 (princ exoffsety)
 (princ " / Arrow Size : ")
 (princ arrowsizecustom)
 (princ "\n If you want to reset these value, cancel this and input command : ELEADRESET ") 

 (setq basept (getpoint "\n pick point for leader "))
 (setq basept (trans basept 1 0))

 (while (setq ss (ssget ":S" '((0 . "*TEXT"))))
   (setq ssl (sslength ss))
   (setq index 0)

   (repeat ssl
     (setq enttext (ssname ss index))

   ;part start - for rotate texts 0 or 270
   (setq objtext (vlax-ename->vla-object enttext))
   (setq textangle (RtD (vlax-get-property objtext 'rotation)))
   (if(= inttxt "Yes")
     (progn
       (cond 
     ((and (>= textangle 0) (< textangle 45))
       (vlax-put-property objtext 'rotation (DtR 0))
     )
     ((and (>= textangle 45) (< textangle 135))
       (vlax-put-property objtext 'rotation (DtR 270))
     )
     ((and (>= textangle 135) (< textangle 225))
       (vlax-put-property objtext 'rotation (DtR 0))        
     )
     ((and (>= textangle 225) (< textangle 315))
       (vlax-put-property objtext 'rotation (DtR 270))
     )
     ((and (>= textangle 315) (< textangle 360))
       (vlax-put-property objtext 'rotation (DtR 0))        
     ) 
   )))
       
       ;end of cond
   ;part end




     (setq enx (entget enttext))
     (setq lst (LM:textbox enx))

     (setq hgt (cdr (assoc 40 enx)))
     (setq md1 (mid (car  lst) (last  lst)))
     (setq md2 (mid (cadr lst) (caddr lst)))
     (setq ang (angle (car  lst) (last  lst)))

     (setq pt1 (polar (polar (last lst) ang (* exoffsety hgt)) (+ ang (/ pi 2)) exoffset))
     (setq pt2 (polar (polar (caddr lst) ang (* exoffsety hgt)) (+ ang (* pi 1.5)) exoffset))

     (setq dist1 (distance basept pt1))
     (setq dist2 (distance basept pt2))
     (if (< dist2 dist1)
       (progn
         (setq newpt1 pt2)
         (setq newpt2 pt1)
       )
       (progn
         (setq newpt1 pt1)
         (setq newpt2 pt2)
       )
     )

     (entmake (list (cons 0 "LEADER") 
                    (cons 8 (cdr (assoc 8(entget enttext))))
                     (cons 100 "AcDbEntity") 
                     (cons 67 0) 
                     (cons 100 "AcDbLeader") 
                     (cons 71 1) 
                     (cons 72 0) 
                     (cons 73 3) 
                     (cons 74 0) 
                     (cons 75 0) 
                     (cons 40 1) 
                     (cons 41 1) 
                     (cons 76 3) 
                     (cons 10 basept) 
                     (cons 10 newpt1) 
                     (cons 10 newpt2))
     )
     (setq leaderobj (vlax-ename->vla-object (entlast)))
     (vla-put-ArrowheadSize leaderobj arrowsizecustom)
     (vlax-put-property leaderobj 'type 2) ; make line with arrow
     
     (setq index (+ index 1))
   )

 );end of while



 (command "_.UCS" "P")
 (setvar 'cmdecho 1)
 (LM:endundo (LM:acdoc))
 (princ)
)

(defun RtD (r) (* 180.0 (/ r pi)))
(defun DtR (d) (* pi (/ d 180.0)))

(defun mid ( a b )
    (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) a b)
)

(defun LM:textbox ( enx / bpt hgt jus lst ocs org rot wid )
    (cond
        (   (and (= "ATTRIB" (cdr (assoc 000 enx)))
                 (= "Embedded Object" (cdr (assoc 101 enx)))
            )
            (LM:textbox (cons '(000 . "MTEXT") (member '(101 . "Embedded Object") enx)))
        )
        (   (cond
                (   (wcmatch  (cdr (assoc 000 enx)) "ATTRIB,TEXT")
                    (setq bpt (cdr (assoc 010 enx))
                          rot (cdr (assoc 050 enx))
                          lst (textbox enx)
                          lst (list (car lst) (list (caadr lst) (cadar lst)) (cadr lst) (list (caar lst) (cadadr lst)))
                    )
                )
                (   (= "MTEXT" (cdr (assoc 000 enx)))
                    (setq ocs  (cdr (assoc 210 enx))
                          bpt  (trans (cdr (assoc 010 enx)) 0 ocs)
                          rot  (angle '(0.0 0.0) (trans (cdr (assoc 011 enx)) 0 ocs))
                          wid  (cdr (assoc 042 enx))
                          hgt  (cdr (assoc 043 enx))
                          jus  (cdr (assoc 071 enx))
                          org  (list (cond ((member jus '(2 5 8)) (/ wid -2.0)) ((member jus '(3 6 9)) (- wid))      (0.0))
                                     (cond ((member jus '(1 2 3)) (- hgt))      ((member jus '(4 5 6)) (/ hgt -2.0)) (0.0))
                               )
                          lst  (list org (mapcar '+ org (list wid 0)) (mapcar '+ org (list wid hgt)) (mapcar '+ org (list 0 hgt)))
                    )
                )
            )
            (   (lambda ( m ) (mapcar '(lambda ( p ) (mapcar '+ (mxv m p) bpt)) lst))
                (list
                    (list (cos rot) (sin (- rot)) 0.0)
                    (list (sin rot) (cos rot)     0.0)
                   '(0.0 0.0 1.0)
                )
            )
        )
    )
)

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)

and i need reverse method can you help me to add that I tried but I cannot

(while
  (progn
    (setq entldr nil enttxt nil)
  (if
  (setq sel(LM:ssget "\nSelect Text & leader: "
             (list "_:L"
                   (list
                     '(000 . "TEXT,MTEXT,LEADER")
                     (if (= 1 (getvar 'cvport))
                       (cons 410 (getvar 'ctab))
                       '(410 . "Model")
                     )
                   )
             )
           )
  )
  (progn
    (cond
      (	(< 2 (sslength sel))
        (princ "\nThe selection have more than 2 object")
       )
      (	(= 1 (sslength sel))
        (progn
          (cond
            (	(not (wcmatch(cdr (assoc 0(entget(ssname sel 0))))"TEXT,MTEXT"))
              (princ "\nThe selection don't have text")
             )
            (	(not (wcmatch(cdr (assoc 0(entget(ssname sel 0))))"LEADER"))
             (princ "\nThe selection don't have leader")
             )
          )
        )
       )
      (	(= 2 (sslength sel))
        (progn
          (repeat (setq i (sslength sel))
            (or (not (entget (setq ent (ssname sel (setq i (1- i))))))
                (if
                  (not (wcmatch(cdr (assoc 0(entget ent)))"TEXT,MTEXT"))
                  (setq entldr ent)
                  (setq enttext ent)))
          )
          (cond
            (	(= entldr nil)
              (princ "\nThe selection have multiple text")
             )
            (	(= enttext nil)
              (princ "\nThe selection have multiple leader")
             )
          )
        )
       )
    )
  )
)))
(setq objtext (vlax-ename->vla-object enttext))

Let me explain

I will select text and existing leader its need to make the new leader. existing will be modified or delete

from existing leader, it will take the starting point as a "basept"

all same as your code

TEST.dwg

May 24, 2022

8 hours ago, Ajmal said:

wow. really it genuinely nice one

i add some rotation off for this

; ELEAD ucs modified ver. - 2022.05.19 exceed
; https://www.cadtutor.net/forum/topic/75182-automatic-qleader-for-text/
; If you select text and click a point, a LEADER is created 
; that connects the underline of the text.
; 
; Command List
; ELEAD - Make 1 Leader
; MELEAD - Make multiple leaders. towards 1 point
; ELEADRESET - Reset property values
;
; - This is a minor modification of Lee Mac's StrikeThrough Text ( http://www.lee-mac.com/strikethrough.html )
;
; - Created on the current layer. by current color
; - Individual Arrow Size is set without modifying STYLE.
; - works for rotated text.
; - Leaders are created from the left or right side closest to the base point.
; - whenever you open a drawing, you have to set the environment the first time.
; - When Pick is difficult, you can get help from a crossing selection.
; - If no selection is made, it is terminated.
;
; - To make it easier to draw a horizontal line, getpoint based on an imaginary center point. (ELEAD Only)
; - If multiple texts are selected, only one of them is randomly selected. (ELEAD Only)



(vl-load-com)
(defun C:ELEAD ( / *error* objtext textangle leaderobj enttext lst basept hgt md1 md2 ang pt0 pt1 pt2 dist1 dist2 newpt1 newpt2 ss )

  (LM:startundo (LM:acdoc))
  (setvar 'cmdecho 0)
  (command "_.UCS" "W")

  ;error control
    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (command "_.UCS" "P")
        (setvar 'cmdecho 1)
        (princ)
    )

 (if (= exoffset nil)
   (progn 
     (princ "\n this is first time you run ELEAD lisp in this dwg.")
     (setq exoffset (getreal "\n input horizontal offset (Real size) (space bar = 10)"))
     (if (= exoffset nil) (setq exoffset 10))
   )
 )

 (if (= exoffsety nil)
   (progn
     (setq exoffsety (getreal "\n input vertical offset (Ratio of Textheight, example : 1 = Top, 0 = Mid, -1 = Bottom) (space bar = -1.25)"))
     (if (= exoffsety nil) (setq exoffsety -1.25))
   )
 )

 (if (= arrowsizecustom nil)
   (progn 
     (setq arrowsizecustom (getreal "\n input arrow size (Real size) (space bar = 85)"))
     (if (= arrowsizecustom nil) (setq arrowsizecustom 85))
   )
 )
  (if
    (null inttxt)
    (setq inttxt "Yes")
  )
(initget "Yes No")
(if
  (setq tmp(getkword (strcat "\nText rotation [Yes/No] <" inttxt ">:")))
  (setq inttxt tmp)
 )

 (princ "\n ELEAD Settings - Horizontal Offset : ")
 (princ exoffset)
 (princ " / Vertical Offset : ")
 (princ exoffsety)
 (princ " / Arrow Size : ")
 (princ arrowsizecustom)
 (princ "\n If you want to reset these value, cancel this and input command : ELEADRESET ") 

 (while (setq ss (ssget ":S" '((0 . "*TEXT")))) 
   (setq enttext (ssname ss 0))
  
   ;part start - for rotate texts 0 or 270
   (setq objtext (vlax-ename->vla-object enttext))
   (setq textangle (RtD (vlax-get-property objtext 'rotation)))
   (if (= inttxt "Yes")
     (progn
   (cond 
     ((and (>= textangle 0) (< textangle 45))
       (vlax-put-property objtext 'rotation (DtR 0))
     )
     ((and (>= textangle 45) (< textangle 135))
       (vlax-put-property objtext 'rotation (DtR 270))
     )
     ((and (>= textangle 135) (< textangle 225))
       (vlax-put-property objtext 'rotation (DtR 0))        
     )
     ((and (>= textangle 225) (< textangle 315))
       (vlax-put-property objtext 'rotation (DtR 270))
     )
     ((and (>= textangle 315) (< textangle 360))
       (vlax-put-property objtext 'rotation (DtR 0))        
     ) 
   )))
    ;end of cond
   ;part end

   (setq enx (entget enttext))

   (setq lst (LM:textbox enx))
   
   (setq hgt (cdr (assoc 40 enx))
          md1 (mid (car  lst) (last  lst))
          md2 (mid (cadr lst) (caddr lst))
          ang (angle (car  lst) (last  lst))
   )
   (setq pt1 (polar (polar (last lst) ang (* exoffsety hgt)) (+ ang (/ pi 2)) exoffset))
   (setq pt2 (polar (polar (caddr lst) ang (* exoffsety hgt)) (+ ang (* pi 1.5)) exoffset))
   (setq pt0 (mid pt1 pt2))
   (setq basept (getpoint pt0 "\n pick point for leader "))
   (setq basept (trans basept 1 0))
   
   
   ;(setq pt1 (polar (polar md1 ang (* exoffsety hgt)) (+ ang (/ pi 2)) exoffset))
   ;(setq pt2 (polar (polar md2 ang (* exoffsety hgt)) (+ ang (* pi 1.5)) exoffset))

   (setq dist1 (distance basept pt1))
   (setq dist2 (distance basept pt2))
   (if (< dist2 dist1)
     (progn
       (setq newpt1 pt2)
       (setq newpt2 pt1)
     )
     (progn
       (setq newpt1 pt1)
       (setq newpt2 pt2)
     )
   )
   (entmake (list (cons 0 "LEADER") 
                      (cons 8 (cdr (assoc 8(entget enttext))))
                     (cons 100 "AcDbEntity") 
                     (cons 67 0) 
                     (cons 100 "AcDbLeader") 
                     (cons 71 1) 
                     (cons 72 0) 
                     (cons 73 3) 
                     (cons 74 0) 
                     (cons 75 0) 
                     (cons 40 1) 
                     (cons 41 1) 
                     (cons 76 3) 
                     (cons 10 basept) 
                     (cons 10 newpt1) 
                     (cons 10 newpt2))
   )

   (setq leaderobj (vlax-ename->vla-object (entlast)))
   (vla-put-ArrowheadSize leaderobj arrowsizecustom)
   (vlax-put-property leaderobj 'type 2) ; make line with arrow
   
   

 );end of while


 (command "_.UCS" "P")
 (setvar 'cmdecho 1)
 (LM:endundo (LM:acdoc))
 (princ)
)

(defun C:ELEADRESET ( )
 (princ "\n Latest ELEAD Settings = Horizontal Offset [ ")
 (princ exoffset)
 (princ " ] / Vertical Offset [ ")
 (princ exoffsety)
 (princ " ] / Arrow Size [ ")
 (princ arrowsizecustom)
 (princ " ] is now deleted.")
 (setq exoffset nil)
 (setq exoffsety nil)
 (setq arrowsizecustom nil)
 (princ)
)



(defun C:MELEAD ( / *error* objtext textangle leaderobj enttext lst basept hgt md1 md2 ang pt0 pt1 pt2 dist1 dist2 newpt1 newpt2 ss ssl index)
 
  (LM:startundo (LM:acdoc))
  (setvar 'cmdecho 0)
  (command "_.UCS" "W")

  ;error control
    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (command "_.UCS" "P")
        (setvar 'cmdecho 1)
        (princ)
    )


 (if (= exoffset nil)
   (progn 
     (princ "\n this is first time you run ELEAD lisp in this dwg.")
     (setq exoffset (getreal "\n input horizontal offset (Real size) (space bar = 10)"))
     (if (= exoffset nil) (setq exoffset 10))
   )
 )

 (if (= exoffsety nil)
   (progn
     (setq exoffsety (getreal "\n input vertical offset (Ratio of Textheight, example : 1 = Top, 0 = Mid, -1 = Bottom) (space bar = -1.25)"))
     (if (= exoffsety nil) (setq exoffsety -1.25))
   )
 )

 (if (= arrowsizecustom nil)
   (progn 
     (setq arrowsizecustom (getreal "\n input arrow size (Real size) (space bar = 85)"))
     (if (= arrowsizecustom nil) (setq arrowsizecustom 85))
   )
 )
  (if
    (null inttxt)
    (setq inttxt "Yes")
  )
(initget "Yes No")
(if
  (setq tmp(getkword (strcat "\nText rotation [Yes/No] <" inttxt ">:")))
  (setq inttxt tmp)
 )

 (princ "\n ELEAD Settings - Horizontal Offset : ")
 (princ exoffset)
 (princ " / Vertical Offset : ")
 (princ exoffsety)
 (princ " / Arrow Size : ")
 (princ arrowsizecustom)
 (princ "\n If you want to reset these value, cancel this and input command : ELEADRESET ") 

 (setq basept (getpoint "\n pick point for leader "))
 (setq basept (trans basept 1 0))

 (while (setq ss (ssget ":S" '((0 . "*TEXT"))))
   (setq ssl (sslength ss))
   (setq index 0)

   (repeat ssl
     (setq enttext (ssname ss index))

   ;part start - for rotate texts 0 or 270
   (setq objtext (vlax-ename->vla-object enttext))
   (setq textangle (RtD (vlax-get-property objtext 'rotation)))
   (if(= inttxt "Yes")
     (progn
       (cond 
     ((and (>= textangle 0) (< textangle 45))
       (vlax-put-property objtext 'rotation (DtR 0))
     )
     ((and (>= textangle 45) (< textangle 135))
       (vlax-put-property objtext 'rotation (DtR 270))
     )
     ((and (>= textangle 135) (< textangle 225))
       (vlax-put-property objtext 'rotation (DtR 0))        
     )
     ((and (>= textangle 225) (< textangle 315))
       (vlax-put-property objtext 'rotation (DtR 270))
     )
     ((and (>= textangle 315) (< textangle 360))
       (vlax-put-property objtext 'rotation (DtR 0))        
     ) 
   )))
       
       ;end of cond
   ;part end




     (setq enx (entget enttext))
     (setq lst (LM:textbox enx))

     (setq hgt (cdr (assoc 40 enx)))
     (setq md1 (mid (car  lst) (last  lst)))
     (setq md2 (mid (cadr lst) (caddr lst)))
     (setq ang (angle (car  lst) (last  lst)))

     (setq pt1 (polar (polar (last lst) ang (* exoffsety hgt)) (+ ang (/ pi 2)) exoffset))
     (setq pt2 (polar (polar (caddr lst) ang (* exoffsety hgt)) (+ ang (* pi 1.5)) exoffset))

     (setq dist1 (distance basept pt1))
     (setq dist2 (distance basept pt2))
     (if (< dist2 dist1)
       (progn
         (setq newpt1 pt2)
         (setq newpt2 pt1)
       )
       (progn
         (setq newpt1 pt1)
         (setq newpt2 pt2)
       )
     )

     (entmake (list (cons 0 "LEADER") 
                    (cons 8 (cdr (assoc 8(entget enttext))))
                     (cons 100 "AcDbEntity") 
                     (cons 67 0) 
                     (cons 100 "AcDbLeader") 
                     (cons 71 1) 
                     (cons 72 0) 
                     (cons 73 3) 
                     (cons 74 0) 
                     (cons 75 0) 
                     (cons 40 1) 
                     (cons 41 1) 
                     (cons 76 3) 
                     (cons 10 basept) 
                     (cons 10 newpt1) 
                     (cons 10 newpt2))
     )
     (setq leaderobj (vlax-ename->vla-object (entlast)))
     (vla-put-ArrowheadSize leaderobj arrowsizecustom)
     (vlax-put-property leaderobj 'type 2) ; make line with arrow
     
     (setq index (+ index 1))
   )

 );end of while



 (command "_.UCS" "P")
 (setvar 'cmdecho 1)
 (LM:endundo (LM:acdoc))
 (princ)
)

(defun RtD (r) (* 180.0 (/ r pi)))
(defun DtR (d) (* pi (/ d 180.0)))

(defun mid ( a b )
    (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) a b)
)

(defun LM:textbox ( enx / bpt hgt jus lst ocs org rot wid )
    (cond
        (   (and (= "ATTRIB" (cdr (assoc 000 enx)))
                 (= "Embedded Object" (cdr (assoc 101 enx)))
            )
            (LM:textbox (cons '(000 . "MTEXT") (member '(101 . "Embedded Object") enx)))
        )
        (   (cond
                (   (wcmatch  (cdr (assoc 000 enx)) "ATTRIB,TEXT")
                    (setq bpt (cdr (assoc 010 enx))
                          rot (cdr (assoc 050 enx))
                          lst (textbox enx)
                          lst (list (car lst) (list (caadr lst) (cadar lst)) (cadr lst) (list (caar lst) (cadadr lst)))
                    )
                )
                (   (= "MTEXT" (cdr (assoc 000 enx)))
                    (setq ocs  (cdr (assoc 210 enx))
                          bpt  (trans (cdr (assoc 010 enx)) 0 ocs)
                          rot  (angle '(0.0 0.0) (trans (cdr (assoc 011 enx)) 0 ocs))
                          wid  (cdr (assoc 042 enx))
                          hgt  (cdr (assoc 043 enx))
                          jus  (cdr (assoc 071 enx))
                          org  (list (cond ((member jus '(2 5 8)) (/ wid -2.0)) ((member jus '(3 6 9)) (- wid))      (0.0))
                                     (cond ((member jus '(1 2 3)) (- hgt))      ((member jus '(4 5 6)) (/ hgt -2.0)) (0.0))
                               )
                          lst  (list org (mapcar '+ org (list wid 0)) (mapcar '+ org (list wid hgt)) (mapcar '+ org (list 0 hgt)))
                    )
                )
            )
            (   (lambda ( m ) (mapcar '(lambda ( p ) (mapcar '+ (mxv m p) bpt)) lst))
                (list
                    (list (cos rot) (sin (- rot)) 0.0)
                    (list (sin rot) (cos rot)     0.0)
                   '(0.0 0.0 1.0)
                )
            )
        )
    )
)

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)

and i need reverse method can you help me to add that I tried but I cannot

(while
  (progn
    (setq entldr nil enttxt nil)
  (if
  (setq sel(LM:ssget "\nSelect Text & leader: "
             (list "_:L"
                   (list
                     '(000 . "TEXT,MTEXT,LEADER")
                     (if (= 1 (getvar 'cvport))
                       (cons 410 (getvar 'ctab))
                       '(410 . "Model")
                     )
                   )
             )
           )
  )
  (progn
    (cond
      (	(< 2 (sslength sel))
        (princ "\nThe selection have more than 2 object")
       )
      (	(= 1 (sslength sel))
        (progn
          (cond
            (	(not (wcmatch(cdr (assoc 0(entget(ssname sel 0))))"TEXT,MTEXT"))
              (princ "\nThe selection don't have text")
             )
            (	(not (wcmatch(cdr (assoc 0(entget(ssname sel 0))))"LEADER"))
             (princ "\nThe selection don't have leader")
             )
          )
        )
       )
      (	(= 2 (sslength sel))
        (progn
          (repeat (setq i (sslength sel))
            (or (not (entget (setq ent (ssname sel (setq i (1- i))))))
                (if
                  (not (wcmatch(cdr (assoc 0(entget ent)))"TEXT,MTEXT"))
                  (setq entldr ent)
                  (setq enttext ent)))
          )
          (cond
            (	(= entldr nil)
              (princ "\nThe selection have multiple text")
             )
            (	(= enttext nil)
              (princ "\nThe selection have multiple leader")
             )
          )
        )
       )
    )
  )
)))
(setq objtext (vlax-ename->vla-object enttext))

Let me explain

I will select text and existing leader its need to make the new leader. existing will be modified or delete

from existing leader, it will take the starting point as a "basept"

all same as your code

TEST.dwg 75.63 kB · 0 downloads

; ELEAD replace leader ver. - 2022.05.24 exceed
; https://www.cadtutor.net/forum/topic/75182-automatic-qleader-for-text/
; If you select text and leader, a LEADER will be replaced
; that connects the underline of the mtext's 1st line.
; 
; Command List
; ELEAD - Replace 1 Leader
; ELEADRESET - Reset property values
;
; - This is a minor modification of Lee Mac's StrikeThrough Text ( http://www.lee-mac.com/strikethrough.html )
;
; - works for rotated text.
; - Leaders are created from the left or right side closest to the base point.
; - whenever you open a drawing, you have to set the environment the first time.
;
; - When Pick is difficult, you can get help from a crossing selection.
;
; - If multiple Mtexts are selected, only one of them is randomly selected. (ELEAD Only)

(vl-load-com)
(defun C:ELEAD ( / *error* objtext textangle leaderobj enttext lst basept hgt md1 md2 ang pt0 pt1 pt2 dist1 dist2 newpt1 newpt2 ss objldr objlist type ldrbasept baseptx basepty )

  (LM:startundo (LM:acdoc))
  (setvar 'cmdecho 0)
  (command "_.UCS" "W")

  ;error control
    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (command "_.UCS" "P")
        (setvar 'cmdecho 1)
        (princ)
    )

 (if (= exoffset nil)
   (progn 
     (princ "\n this is first time you run ELEAD lisp in this dwg.")
     (setq exoffset (getreal "\n input horizontal offset (Real size) (space bar = 10)"))
     (if (= exoffset nil) (setq exoffset 10))
   )
 )

 (if (= exoffsety nil)
   (progn
     (setq exoffsety (getreal "\n input vertical offset (Ratio of Textheight, example : 1 = Top, 0 = Mid, -1 = Bottom) (space bar = -1.25)"))
     (if (= exoffsety nil) (setq exoffsety -1.25))
   )
 )

 ;(if (= arrowsizecustom nil)
 ;  (progn 
 ;    (setq arrowsizecustom (getreal "\n input arrow size (Real size) (space bar = 85)"))
 ;    (if (= arrowsizecustom nil) (setq arrowsizecustom 85))
 ;  )
 ;)
  (if
    (null inttxt)
    (setq inttxt "Yes")
  )
(initget "Yes No")
(if
  (setq tmp(getkword (strcat "\nText rotation [Yes/No] <" inttxt ">:")))
  (setq inttxt tmp)
 )

 (princ "\n ELEAD Settings - Horizontal Offset : ")
 (princ exoffset)
 (princ " / Vertical Offset : ")
 (princ exoffsety)
 ;(princ " / Arrow Size : ")
 ;(princ arrowsizecustom)
 (princ "\n If you want to reset these value, cancel this and input command : ELEADRESET ") 

 (while (setq ss (ssget '((0 . "*TEXT,LEADER")))) 
   (setq ssl (sslength ss))
   (setq ssind 0)
   (setq typelist '())  
   (setq objtext nil)
   (setq objldr nil) 

   (repeat ssl
     (setq objlist (vlax-ename->vla-object (ssname ss ssind)))
     (setq type (vlax-get-property objlist 'EntityName))
     (cond
       ((= type "AcDbMText")
         (setq objtext objlist)
       )
       ((= type "AcDbLeader")
         (setq objldr objlist)
       )
     )
     (setq ssind (+ ssind 1))
   )
   (if (or (= objtext nil) (= objldr nil))
     (progn
       (princ "\n ELEAD : Please Re-select, need 1 MText & 1 Leader.")
       (c:elead)     
     )
   )


(setq ldrbasept (vlax-safearray->list (vlax-variant-value (vlax-get-property objldr 'coordinates))))
;(princ ldrbasept)
(setq baseptx (car ldrbasept))
(setq basepty (cadr ldrbasept))


   ;part start - for rotate texts 0 or 270
 
   (setq textangle (RtD (vlax-get-property objtext 'rotation)))
   (if (= inttxt "Yes")
     (progn
   (cond 
     ((and (>= textangle 0) (< textangle 45))
       (vlax-put-property objtext 'rotation (DtR 0))
     )
     ((and (>= textangle 45) (< textangle 135))
       (vlax-put-property objtext 'rotation (DtR 270))
     )
     ((and (>= textangle 135) (< textangle 225))
       (vlax-put-property objtext 'rotation (DtR 0))        
     )
     ((and (>= textangle 225) (< textangle 315))
       (vlax-put-property objtext 'rotation (DtR 270))
     )
     ((and (>= textangle 315) (< textangle 360))
       (vlax-put-property objtext 'rotation (DtR 0))        
     ) 
   )))
    ;end of cond
   ;part end
   (setq enttext (vlax-vla-object->ename objtext))
   (setq enx (entget enttext))
   ;(princ enx)

   (setq lst (LM:textbox enx))
   
   (setq hgt (cdr (assoc 40 enx))
          md1 (mid (car  lst) (last  lst))
          md2 (mid (cadr lst) (caddr lst))
          ang (angle (car  lst) (last  lst))
   )
   (setq pt1 (polar (polar (last lst) ang (* exoffsety hgt)) (+ ang (/ pi 2)) exoffset))
   (setq pt2 (polar (polar (caddr lst) ang (* exoffsety hgt)) (+ ang (* pi 1.5)) exoffset))
   ;(setq pt0 (mid pt1 pt2))
   ;(setq basept (getpoint pt0 "\n pick point for leader "))
   ;(setq basept (trans basept 1 0))
   
   (setq basept (list baseptx basepty 0.0))
   ;(princ basept)   

   ;(setq pt1 (polar (polar md1 ang (* exoffsety hgt)) (+ ang (/ pi 2)) exoffset))
   ;(setq pt2 (polar (polar md2 ang (* exoffsety hgt)) (+ ang (* pi 1.5)) exoffset))

   (setq dist1 (distance basept pt1))
   (setq dist2 (distance basept pt2))
   (if (< dist2 dist1)
     (progn
       (setq newpt1 pt2)
       (setq newpt2 pt1)
     )
     (progn
       (setq newpt1 pt1)
       (setq newpt2 pt2)
     )
   )
   (entmake (list (cons 0 "LEADER") 
                     (cons 8 (cdr (assoc 8 (entget enttext))))
                     (cons 100 "AcDbEntity") 
                     (cons 67 0) 
                     (cons 100 "AcDbLeader") 
                     (cons 71 1) 
                     (cons 72 0) 
                     (cons 73 3) 
                     (cons 74 1) 
                     (cons 75 0) 
                     (cons 40 1) 
                     (cons 41 1) 
                     (cons 76 3) 
                     (cons 10 basept) 
                     (cons 10 newpt1) 
                     (cons 10 newpt2))
   )

   (setq leaderobj (vlax-ename->vla-object (entlast)))

   
  ;(vla-put-ArrowheadSize leaderobj arrowsizecustom)
  ;(vlax-put-property leaderobj 'scalefactor 1) ; edit scale of leader
  ;(vlax-put-property leaderobj 'type 2) ; make line with arrow

  (vlax-put-property leaderobj 'scalefactor (vlax-get-property objldr 'scalefactor))
  (vlax-put-property leaderobj 'arrowheadsize (vlax-get-property objldr 'arrowheadsize))
  (vlax-put-property leaderobj 'type (vlax-get-property objldr 'type))
  (vlax-put-property leaderobj 'arrowheadtype (vlax-get-property objldr 'arrowheadtype))
  (vlax-put-property leaderobj 'dimensionlinecolor (vlax-get-property objldr 'dimensionlinecolor))
  (vlax-put-property leaderobj 'layer (vlax-get-property objldr 'layer))


   (vla-delete objldr)

 );end of while


 (command "_.UCS" "P")
 (setvar 'cmdecho 1)
 (LM:endundo (LM:acdoc))
 (princ)
)

(defun C:ELEADRESET ( )
 (princ "\n Latest ELEAD Settings = Horizontal Offset [ ")
 (princ exoffset)
 (princ " ] / Vertical Offset [ ")
 (princ exoffsety)
 ;(princ " ] / Arrow Size [ ")
 ;(princ arrowsizecustom)
 (princ " ] is now deleted.")
 (setq exoffset nil)
 (setq exoffsety nil)
 (setq arrowsizecustom nil)
 (princ)
)


(defun RtD (r) (* 180.0 (/ r pi)))
(defun DtR (d) (* pi (/ d 180.0)))

(defun mid ( a b )
    (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) a b)
)

(defun LM:textbox ( enx / bpt hgt jus lst ocs org rot wid )
    (cond
        (   (and (= "ATTRIB" (cdr (assoc 000 enx)))
                 (= "Embedded Object" (cdr (assoc 101 enx)))
            )
            (LM:textbox (cons '(000 . "MTEXT") (member '(101 . "Embedded Object") enx)))
        )
        (   (cond
                (   (wcmatch  (cdr (assoc 000 enx)) "ATTRIB,TEXT")
                    (setq bpt (cdr (assoc 010 enx))
                          rot (cdr (assoc 050 enx))
                          lst (textbox enx)
                          lst (list (car lst) (list (caadr lst) (cadar lst)) (cadr lst) (list (caar lst) (cadadr lst)))
                    )
                )
                (   (= "MTEXT" (cdr (assoc 000 enx)))
                    (setq ocs  (cdr (assoc 210 enx))
                          bpt  (trans (cdr (assoc 010 enx)) 0 ocs)
                          rot  (angle '(0.0 0.0) (trans (cdr (assoc 011 enx)) 0 ocs))
                          wid  (cdr (assoc 042 enx))
                          hgt  (cdr (assoc 043 enx))
                          jus  (cdr (assoc 071 enx))
                          org  (list (cond ((member jus '(2 5 8)) (/ wid -2.0)) ((member jus '(3 6 9)) (- wid))      (0.0))
                                     (cond ((member jus '(1 2 3)) (- hgt))      ((member jus '(4 5 6)) (/ hgt -2.0)) (0.0))
                               )
                          lst  (list org (mapcar '+ org (list wid 0)) (mapcar '+ org (list wid hgt)) (mapcar '+ org (list 0 hgt)))
                    )
                )
            )
            (   (lambda ( m ) (mapcar '(lambda ( p ) (mapcar '+ (mxv m p) bpt)) lst))
                (list
                    (list (cos rot) (sin (- rot)) 0.0)
                    (list (sin rot) (cos rot)     0.0)
                   '(0.0 0.0 1.0)
                )
            )
        )
    )
)

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)

like this?

I know LM:ssget method is great. but I cannot understand it yet.

so I wrote only what I know.

Since mtext and leaders can be separated when selecting two,

so we have to remove the "S" from ssget (one-time selection option)

Originally, it is good to put it in the properties when doing entmake,

but it is supposed to be modified twice from the outside to make it easier to you can see it.

so, you can copy this to the command line, then select the leader.

(vlax-dump-object (vlax-ename->vla-object (car (entsel))) t)

it prints leaders object properties.

and then you can put the attributes you want to keep in the last statement. after [ ' ] x 2ea

objldr = original leader

leaderobj = new leader

it just get and put, get and put.... again and again

  (vlax-put-property leaderobj 'scalefactor (vlax-get-property objldr 'scalefactor))
  (vlax-put-property leaderobj 'arrowheadsize (vlax-get-property objldr 'arrowheadsize))
  (vlax-put-property leaderobj 'type (vlax-get-property objldr 'type))
  (vlax-put-property leaderobj 'arrowheadtype (vlax-get-property objldr 'arrowheadtype))
  (vlax-put-property leaderobj 'dimensionlinecolor (vlax-get-property objldr 'dimensionlinecolor))
  (vlax-put-property leaderobj 'layer (vlax-get-property objldr 'layer))

Edited May 24, 2022 by exceed
keep original leader settings

May 24, 2022

1 hour ago, exceed said:

; ELEAD replace leader ver. - 2022.05.24 exceed
; https://www.cadtutor.net/forum/topic/75182-automatic-qleader-for-text/
; If you select text and leader, a LEADER will be replaced
; that connects the underline of the mtext's 1st line.
; 
; Command List
; ELEAD - Replace 1 Leader
; ELEADRESET - Reset property values
;
; - This is a minor modification of Lee Mac's StrikeThrough Text ( http://www.lee-mac.com/strikethrough.html )
;
; - works for rotated text.
; - Leaders are created from the left or right side closest to the base point.
; - whenever you open a drawing, you have to set the environment the first time.
;
; - When Pick is difficult, you can get help from a crossing selection.
;
; - If multiple Mtexts are selected, only one of them is randomly selected. (ELEAD Only)

(vl-load-com)
(defun C:ELEAD ( / *error* objtext textangle leaderobj enttext lst basept hgt md1 md2 ang pt0 pt1 pt2 dist1 dist2 newpt1 newpt2 ss objldr objlist type ldrbasept baseptx basepty )

  (LM:startundo (LM:acdoc))
  (setvar 'cmdecho 0)
  (command "_.UCS" "W")

  ;error control
    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (command "_.UCS" "P")
        (setvar 'cmdecho 1)
        (princ)
    )

 (if (= exoffset nil)
   (progn 
     (princ "\n this is first time you run ELEAD lisp in this dwg.")
     (setq exoffset (getreal "\n input horizontal offset (Real size) (space bar = 10)"))
     (if (= exoffset nil) (setq exoffset 10))
   )
 )

 (if (= exoffsety nil)
   (progn
     (setq exoffsety (getreal "\n input vertical offset (Ratio of Textheight, example : 1 = Top, 0 = Mid, -1 = Bottom) (space bar = -1.25)"))
     (if (= exoffsety nil) (setq exoffsety -1.25))
   )
 )

 ;(if (= arrowsizecustom nil)
 ;  (progn 
 ;    (setq arrowsizecustom (getreal "\n input arrow size (Real size) (space bar = 85)"))
 ;    (if (= arrowsizecustom nil) (setq arrowsizecustom 85))
 ;  )
 ;)
  (if
    (null inttxt)
    (setq inttxt "Yes")
  )
(initget "Yes No")
(if
  (setq tmp(getkword (strcat "\nText rotation [Yes/No] <" inttxt ">:")))
  (setq inttxt tmp)
 )

 (princ "\n ELEAD Settings - Horizontal Offset : ")
 (princ exoffset)
 (princ " / Vertical Offset : ")
 (princ exoffsety)
 ;(princ " / Arrow Size : ")
 ;(princ arrowsizecustom)
 (princ "\n If you want to reset these value, cancel this and input command : ELEADRESET ") 

 (while (setq ss (ssget '((0 . "*TEXT,LEADER")))) 
   (setq ssl (sslength ss))
   (setq ssind 0)
   (setq typelist '())  
   (setq objtext nil)
   (setq objldr nil) 

   (repeat ssl
     (setq objlist (vlax-ename->vla-object (ssname ss ssind)))
     (setq type (vlax-get-property objlist 'EntityName))
     (cond
       ((= type "AcDbMText")
         (setq objtext objlist)
       )
       ((= type "AcDbLeader")
         (setq objldr objlist)
       )
     )
     (setq ssind (+ ssind 1))
   )
   (if (or (= objtext nil) (= objldr nil))
     (progn
       (princ "\n ELEAD : Please Re-select, need 1 MText & 1 Leader.")
       (c:elead)     
     )
   )


(setq ldrbasept (vlax-safearray->list (vlax-variant-value (vlax-get-property objldr 'coordinates))))
;(princ ldrbasept)
(setq baseptx (car ldrbasept))
(setq basepty (cadr ldrbasept))


   ;part start - for rotate texts 0 or 270
 
   (setq textangle (RtD (vlax-get-property objtext 'rotation)))
   (if (= inttxt "Yes")
     (progn
   (cond 
     ((and (>= textangle 0) (< textangle 45))
       (vlax-put-property objtext 'rotation (DtR 0))
     )
     ((and (>= textangle 45) (< textangle 135))
       (vlax-put-property objtext 'rotation (DtR 270))
     )
     ((and (>= textangle 135) (< textangle 225))
       (vlax-put-property objtext 'rotation (DtR 0))        
     )
     ((and (>= textangle 225) (< textangle 315))
       (vlax-put-property objtext 'rotation (DtR 270))
     )
     ((and (>= textangle 315) (< textangle 360))
       (vlax-put-property objtext 'rotation (DtR 0))        
     ) 
   )))
    ;end of cond
   ;part end
   (setq enttext (vlax-vla-object->ename objtext))
   (setq enx (entget enttext))
   ;(princ enx)

   (setq lst (LM:textbox enx))
   
   (setq hgt (cdr (assoc 40 enx))
          md1 (mid (car  lst) (last  lst))
          md2 (mid (cadr lst) (caddr lst))
          ang (angle (car  lst) (last  lst))
   )
   (setq pt1 (polar (polar (last lst) ang (* exoffsety hgt)) (+ ang (/ pi 2)) exoffset))
   (setq pt2 (polar (polar (caddr lst) ang (* exoffsety hgt)) (+ ang (* pi 1.5)) exoffset))
   ;(setq pt0 (mid pt1 pt2))
   ;(setq basept (getpoint pt0 "\n pick point for leader "))
   ;(setq basept (trans basept 1 0))
   
   (setq basept (list baseptx basepty 0.0))
   ;(princ basept)   

   ;(setq pt1 (polar (polar md1 ang (* exoffsety hgt)) (+ ang (/ pi 2)) exoffset))
   ;(setq pt2 (polar (polar md2 ang (* exoffsety hgt)) (+ ang (* pi 1.5)) exoffset))

   (setq dist1 (distance basept pt1))
   (setq dist2 (distance basept pt2))
   (if (< dist2 dist1)
     (progn
       (setq newpt1 pt2)
       (setq newpt2 pt1)
     )
     (progn
       (setq newpt1 pt1)
       (setq newpt2 pt2)
     )
   )
   (entmake (list (cons 0 "LEADER") 
                     (cons 8 (cdr (assoc 8 (entget enttext))))
                     (cons 100 "AcDbEntity") 
                     (cons 67 0) 
                     (cons 100 "AcDbLeader") 
                     (cons 71 1) 
                     (cons 72 0) 
                     (cons 73 3) 
                     (cons 74 1) 
                     (cons 75 0) 
                     (cons 40 1) 
                     (cons 41 1) 
                     (cons 76 3) 
                     (cons 10 basept) 
                     (cons 10 newpt1) 
                     (cons 10 newpt2))
   )

   (setq leaderobj (vlax-ename->vla-object (entlast)))

   
  ;(vla-put-ArrowheadSize leaderobj arrowsizecustom)
  ;(vlax-put-property leaderobj 'scalefactor 1) ; edit scale of leader
  ;(vlax-put-property leaderobj 'type 2) ; make line with arrow

  (vlax-put-property leaderobj 'scalefactor (vlax-get-property objldr 'scalefactor))
  (vlax-put-property leaderobj 'arrowheadsize (vlax-get-property objldr 'arrowheadsize))
  (vlax-put-property leaderobj 'type (vlax-get-property objldr 'type))
  (vlax-put-property leaderobj 'arrowheadtype (vlax-get-property objldr 'arrowheadtype))
  (vlax-put-property leaderobj 'dimensionlinecolor (vlax-get-property objldr 'dimensionlinecolor))
  (vlax-put-property leaderobj 'layer (vlax-get-property objldr 'layer))


   (vla-delete objldr)

 );end of while


 (command "_.UCS" "P")
 (setvar 'cmdecho 1)
 (LM:endundo (LM:acdoc))
 (princ)
)

(defun C:ELEADRESET ( )
 (princ "\n Latest ELEAD Settings = Horizontal Offset [ ")
 (princ exoffset)
 (princ " ] / Vertical Offset [ ")
 (princ exoffsety)
 ;(princ " ] / Arrow Size [ ")
 ;(princ arrowsizecustom)
 (princ " ] is now deleted.")
 (setq exoffset nil)
 (setq exoffsety nil)
 (setq arrowsizecustom nil)
 (princ)
)


(defun RtD (r) (* 180.0 (/ r pi)))
(defun DtR (d) (* pi (/ d 180.0)))

(defun mid ( a b )
    (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) a b)
)

(defun LM:textbox ( enx / bpt hgt jus lst ocs org rot wid )
    (cond
        (   (and (= "ATTRIB" (cdr (assoc 000 enx)))
                 (= "Embedded Object" (cdr (assoc 101 enx)))
            )
            (LM:textbox (cons '(000 . "MTEXT") (member '(101 . "Embedded Object") enx)))
        )
        (   (cond
                (   (wcmatch  (cdr (assoc 000 enx)) "ATTRIB,TEXT")
                    (setq bpt (cdr (assoc 010 enx))
                          rot (cdr (assoc 050 enx))
                          lst (textbox enx)
                          lst (list (car lst) (list (caadr lst) (cadar lst)) (cadr lst) (list (caar lst) (cadadr lst)))
                    )
                )
                (   (= "MTEXT" (cdr (assoc 000 enx)))
                    (setq ocs  (cdr (assoc 210 enx))
                          bpt  (trans (cdr (assoc 010 enx)) 0 ocs)
                          rot  (angle '(0.0 0.0) (trans (cdr (assoc 011 enx)) 0 ocs))
                          wid  (cdr (assoc 042 enx))
                          hgt  (cdr (assoc 043 enx))
                          jus  (cdr (assoc 071 enx))
                          org  (list (cond ((member jus '(2 5 8)) (/ wid -2.0)) ((member jus '(3 6 9)) (- wid))      (0.0))
                                     (cond ((member jus '(1 2 3)) (- hgt))      ((member jus '(4 5 6)) (/ hgt -2.0)) (0.0))
                               )
                          lst  (list org (mapcar '+ org (list wid 0)) (mapcar '+ org (list wid hgt)) (mapcar '+ org (list 0 hgt)))
                    )
                )
            )
            (   (lambda ( m ) (mapcar '(lambda ( p ) (mapcar '+ (mxv m p) bpt)) lst))
                (list
                    (list (cos rot) (sin (- rot)) 0.0)
                    (list (sin rot) (cos rot)     0.0)
                   '(0.0 0.0 1.0)
                )
            )
        )
    )
)

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)

like this?

I know LM:ssget method is great. but I cannot understand it yet.

so I wrote only what I know.

Since mtext and two leaders can be separated when selecting two, we removed the "S" for one-time selection from ssget.

Originally, it is good to put it in the properties when doing entmake,

but it is supposed to be modified twice from the outside to make it easier to see.

(vlax-dump-object (vlax-ename->vla-object (car (entsel))) t)

so, you can copy this to the command line, select the leader

and put the attributes you want to keep in the last statement. after [ ' ]

  (vlax-put-property leaderobj 'scalefactor (vlax-get-property objldr 'scalefactor))
  (vlax-put-property leaderobj 'arrowheadsize (vlax-get-property objldr 'arrowheadsize))
  (vlax-put-property leaderobj 'type (vlax-get-property objldr 'type))
  (vlax-put-property leaderobj 'arrowheadtype (vlax-get-property objldr 'arrowheadtype))
  (vlax-put-property leaderobj 'dimensionlinecolor (vlax-get-property objldr 'dimensionlinecolor))
  (vlax-put-property leaderobj 'layer (vlax-get-property objldr 'layer))

your great.........this is awesome.

June 1, 2022

On 24/05/2022 at 11:44, exceed said:

; ELEAD replace leader ver. - 2022.05.24 exceed
; https://www.cadtutor.net/forum/topic/75182-automatic-qleader-for-text/
; If you select text and leader, a LEADER will be replaced
; that connects the underline of the mtext's 1st line.
; 
; Command List
; ELEAD - Replace 1 Leader
; ELEADRESET - Reset property values
;
; - This is a minor modification of Lee Mac's StrikeThrough Text ( http://www.lee-mac.com/strikethrough.html )
;
; - works for rotated text.
; - Leaders are created from the left or right side closest to the base point.
; - whenever you open a drawing, you have to set the environment the first time.
;
; - When Pick is difficult, you can get help from a crossing selection.
;
; - If multiple Mtexts are selected, only one of them is randomly selected. (ELEAD Only)

(vl-load-com)
(defun C:ELEAD ( / *error* objtext textangle leaderobj enttext lst basept hgt md1 md2 ang pt0 pt1 pt2 dist1 dist2 newpt1 newpt2 ss objldr objlist type ldrbasept baseptx basepty )

  (LM:startundo (LM:acdoc))
  (setvar 'cmdecho 0)
  (command "_.UCS" "W")

  ;error control
    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (command "_.UCS" "P")
        (setvar 'cmdecho 1)
        (princ)
    )

 (if (= exoffset nil)
   (progn 
     (princ "\n this is first time you run ELEAD lisp in this dwg.")
     (setq exoffset (getreal "\n input horizontal offset (Real size) (space bar = 10)"))
     (if (= exoffset nil) (setq exoffset 10))
   )
 )

 (if (= exoffsety nil)
   (progn
     (setq exoffsety (getreal "\n input vertical offset (Ratio of Textheight, example : 1 = Top, 0 = Mid, -1 = Bottom) (space bar = -1.25)"))
     (if (= exoffsety nil) (setq exoffsety -1.25))
   )
 )

 ;(if (= arrowsizecustom nil)
 ;  (progn 
 ;    (setq arrowsizecustom (getreal "\n input arrow size (Real size) (space bar = 85)"))
 ;    (if (= arrowsizecustom nil) (setq arrowsizecustom 85))
 ;  )
 ;)
  (if
    (null inttxt)
    (setq inttxt "Yes")
  )
(initget "Yes No")
(if
  (setq tmp(getkword (strcat "\nText rotation [Yes/No] <" inttxt ">:")))
  (setq inttxt tmp)
 )

 (princ "\n ELEAD Settings - Horizontal Offset : ")
 (princ exoffset)
 (princ " / Vertical Offset : ")
 (princ exoffsety)
 ;(princ " / Arrow Size : ")
 ;(princ arrowsizecustom)
 (princ "\n If you want to reset these value, cancel this and input command : ELEADRESET ") 

 (while (setq ss (ssget '((0 . "*TEXT,LEADER")))) 
   (setq ssl (sslength ss))
   (setq ssind 0)
   (setq typelist '())  
   (setq objtext nil)
   (setq objldr nil) 

   (repeat ssl
     (setq objlist (vlax-ename->vla-object (ssname ss ssind)))
     (setq type (vlax-get-property objlist 'EntityName))
     (cond
       ((= type "AcDbMText")
         (setq objtext objlist)
       )
       ((= type "AcDbLeader")
         (setq objldr objlist)
       )
     )
     (setq ssind (+ ssind 1))
   )
   (if (or (= objtext nil) (= objldr nil))
     (progn
       (princ "\n ELEAD : Please Re-select, need 1 MText & 1 Leader.")
       (c:elead)     
     )
   )


(setq ldrbasept (vlax-safearray->list (vlax-variant-value (vlax-get-property objldr 'coordinates))))
;(princ ldrbasept)
(setq baseptx (car ldrbasept))
(setq basepty (cadr ldrbasept))


   ;part start - for rotate texts 0 or 270
 
   (setq textangle (RtD (vlax-get-property objtext 'rotation)))
   (if (= inttxt "Yes")
     (progn
   (cond 
     ((and (>= textangle 0) (< textangle 45))
       (vlax-put-property objtext 'rotation (DtR 0))
     )
     ((and (>= textangle 45) (< textangle 135))
       (vlax-put-property objtext 'rotation (DtR 270))
     )
     ((and (>= textangle 135) (< textangle 225))
       (vlax-put-property objtext 'rotation (DtR 0))        
     )
     ((and (>= textangle 225) (< textangle 315))
       (vlax-put-property objtext 'rotation (DtR 270))
     )
     ((and (>= textangle 315) (< textangle 360))
       (vlax-put-property objtext 'rotation (DtR 0))        
     ) 
   )))
    ;end of cond
   ;part end
   (setq enttext (vlax-vla-object->ename objtext))
   (setq enx (entget enttext))
   ;(princ enx)

   (setq lst (LM:textbox enx))
   
   (setq hgt (cdr (assoc 40 enx))
          md1 (mid (car  lst) (last  lst))
          md2 (mid (cadr lst) (caddr lst))
          ang (angle (car  lst) (last  lst))
   )
   (setq pt1 (polar (polar (last lst) ang (* exoffsety hgt)) (+ ang (/ pi 2)) exoffset))
   (setq pt2 (polar (polar (caddr lst) ang (* exoffsety hgt)) (+ ang (* pi 1.5)) exoffset))
   ;(setq pt0 (mid pt1 pt2))
   ;(setq basept (getpoint pt0 "\n pick point for leader "))
   ;(setq basept (trans basept 1 0))
   
   (setq basept (list baseptx basepty 0.0))
   ;(princ basept)   

   ;(setq pt1 (polar (polar md1 ang (* exoffsety hgt)) (+ ang (/ pi 2)) exoffset))
   ;(setq pt2 (polar (polar md2 ang (* exoffsety hgt)) (+ ang (* pi 1.5)) exoffset))

   (setq dist1 (distance basept pt1))
   (setq dist2 (distance basept pt2))
   (if (< dist2 dist1)
     (progn
       (setq newpt1 pt2)
       (setq newpt2 pt1)
     )
     (progn
       (setq newpt1 pt1)
       (setq newpt2 pt2)
     )
   )
   (entmake (list (cons 0 "LEADER") 
                     (cons 8 (cdr (assoc 8 (entget enttext))))
                     (cons 100 "AcDbEntity") 
                     (cons 67 0) 
                     (cons 100 "AcDbLeader") 
                     (cons 71 1) 
                     (cons 72 0) 
                     (cons 73 3) 
                     (cons 74 1) 
                     (cons 75 0) 
                     (cons 40 1) 
                     (cons 41 1) 
                     (cons 76 3) 
                     (cons 10 basept) 
                     (cons 10 newpt1) 
                     (cons 10 newpt2))
   )

   (setq leaderobj (vlax-ename->vla-object (entlast)))

   
  ;(vla-put-ArrowheadSize leaderobj arrowsizecustom)
  ;(vlax-put-property leaderobj 'scalefactor 1) ; edit scale of leader
  ;(vlax-put-property leaderobj 'type 2) ; make line with arrow

  (vlax-put-property leaderobj 'scalefactor (vlax-get-property objldr 'scalefactor))
  (vlax-put-property leaderobj 'arrowheadsize (vlax-get-property objldr 'arrowheadsize))
  (vlax-put-property leaderobj 'type (vlax-get-property objldr 'type))
  (vlax-put-property leaderobj 'arrowheadtype (vlax-get-property objldr 'arrowheadtype))
  (vlax-put-property leaderobj 'dimensionlinecolor (vlax-get-property objldr 'dimensionlinecolor))
  (vlax-put-property leaderobj 'layer (vlax-get-property objldr 'layer))


   (vla-delete objldr)

 );end of while


 (command "_.UCS" "P")
 (setvar 'cmdecho 1)
 (LM:endundo (LM:acdoc))
 (princ)
)

(defun C:ELEADRESET ( )
 (princ "\n Latest ELEAD Settings = Horizontal Offset [ ")
 (princ exoffset)
 (princ " ] / Vertical Offset [ ")
 (princ exoffsety)
 ;(princ " ] / Arrow Size [ ")
 ;(princ arrowsizecustom)
 (princ " ] is now deleted.")
 (setq exoffset nil)
 (setq exoffsety nil)
 (setq arrowsizecustom nil)
 (princ)
)


(defun RtD (r) (* 180.0 (/ r pi)))
(defun DtR (d) (* pi (/ d 180.0)))

(defun mid ( a b )
    (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) a b)
)

(defun LM:textbox ( enx / bpt hgt jus lst ocs org rot wid )
    (cond
        (   (and (= "ATTRIB" (cdr (assoc 000 enx)))
                 (= "Embedded Object" (cdr (assoc 101 enx)))
            )
            (LM:textbox (cons '(000 . "MTEXT") (member '(101 . "Embedded Object") enx)))
        )
        (   (cond
                (   (wcmatch  (cdr (assoc 000 enx)) "ATTRIB,TEXT")
                    (setq bpt (cdr (assoc 010 enx))
                          rot (cdr (assoc 050 enx))
                          lst (textbox enx)
                          lst (list (car lst) (list (caadr lst) (cadar lst)) (cadr lst) (list (caar lst) (cadadr lst)))
                    )
                )
                (   (= "MTEXT" (cdr (assoc 000 enx)))
                    (setq ocs  (cdr (assoc 210 enx))
                          bpt  (trans (cdr (assoc 010 enx)) 0 ocs)
                          rot  (angle '(0.0 0.0) (trans (cdr (assoc 011 enx)) 0 ocs))
                          wid  (cdr (assoc 042 enx))
                          hgt  (cdr (assoc 043 enx))
                          jus  (cdr (assoc 071 enx))
                          org  (list (cond ((member jus '(2 5 8)) (/ wid -2.0)) ((member jus '(3 6 9)) (- wid))      (0.0))
                                     (cond ((member jus '(1 2 3)) (- hgt))      ((member jus '(4 5 6)) (/ hgt -2.0)) (0.0))
                               )
                          lst  (list org (mapcar '+ org (list wid 0)) (mapcar '+ org (list wid hgt)) (mapcar '+ org (list 0 hgt)))
                    )
                )
            )
            (   (lambda ( m ) (mapcar '(lambda ( p ) (mapcar '+ (mxv m p) bpt)) lst))
                (list
                    (list (cos rot) (sin (- rot)) 0.0)
                    (list (sin rot) (cos rot)     0.0)
                   '(0.0 0.0 1.0)
                )
            )
        )
    )
)

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)

like this?

I know LM:ssget method is great. but I cannot understand it yet.

so I wrote only what I know.

Since mtext and leaders can be separated when selecting two,

so we have to remove the "S" from ssget (one-time selection option)

Originally, it is good to put it in the properties when doing entmake,

but it is supposed to be modified twice from the outside to make it easier to you can see it.

so, you can copy this to the command line, then select the leader.

(vlax-dump-object (vlax-ename->vla-object (car (entsel))) t)

it prints leaders object properties.

and then you can put the attributes you want to keep in the last statement. after [ ' ] x 2ea

objldr = original leader

leaderobj = new leader

it just get and put, get and put.... again and again

  (vlax-put-property leaderobj 'scalefactor (vlax-get-property objldr 'scalefactor))
  (vlax-put-property leaderobj 'arrowheadsize (vlax-get-property objldr 'arrowheadsize))
  (vlax-put-property leaderobj 'type (vlax-get-property objldr 'type))
  (vlax-put-property leaderobj 'arrowheadtype (vlax-get-property objldr 'arrowheadtype))
  (vlax-put-property leaderobj 'dimensionlinecolor (vlax-get-property objldr 'dimensionlinecolor))
  (vlax-put-property leaderobj 'layer (vlax-get-property objldr 'layer))

Cannot invoke (command) from *error* without prior call to (*push-error-using-command*).
Converting (command) calls to (command-s) is recommended.

UCS is getting problem while Ese and after finishing. i think error control issue.

June 7, 2022

Instead of this how can I add the “Tab” key to change getting P1 and P2

(setq pt1 (polar (polar (last lst) ang (* exoffsety hgt)) (+ ang (/ pi 2)) exoffset))
   (setq pt2 (polar (polar (caddr lst) ang (* exoffsety hgt)) (+ ang (* pi 1.5)) exoffset))
   (setq pt0 (mid pt1 pt2))
   (setq basept (getpoint pt0 "\n pick point for leader "))
   (setq basept (trans basept 1 0))
  
   (setq dist1 (distance basept pt1))
   (setq dist2 (distance basept pt2))
   (if (< dist2 dist1)
     (progn
       (setq newpt1 pt2)
       (setq newpt2 pt1)
     )
     (progn
       (setq newpt1 pt1)
       (setq newpt2 pt2)
     )
   )

or

orthomode leader

Edited June 7, 2022 by Ajmal
add more achievement

Automatic Qleader for text

Recommended Posts

Ajmal

Link to comment

Share on other sites

devitg

Link to comment

Share on other sites

Ajmal

Link to comment

Share on other sites

phjlc

Link to comment

Share on other sites

exceed

Link to comment

Share on other sites

Ajmal

Link to comment

Share on other sites

exceed

Link to comment

Share on other sites

Ajmal

Link to comment

Share on other sites

exceed

Link to comment

Share on other sites

Ajmal

Link to comment

Share on other sites

Ajmal

Link to comment

Share on other sites

Ajmal

Link to comment

Share on other sites

Join the conversation

Tutorials

Forums

Activity