Jump to content

Automatic Qleader for text

Ajmal

By Ajmal,
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Ajmal Enthusiast

Ajmal

Posted
Posted (edited)

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) 

image.thumb.png.2368c36bece23e5db20a42a02de80493.pngimage.thumb.png.5fde2dc5b79b2efa2adbf924dc97850e.png

Edited by Ajmal
attach more picture
Link to comment
Share on other sites
devitg Proficient

devitg

Posted
Posted

@Ajmal

 

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

Link to comment
Share on other sites
phjlc Rookie

phjlc

Posted
Posted

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
  )

 

  • Like 1
Link to comment
Share on other sites
exceed Collaborator

exceed

Posted
Posted (edited) 
; 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

eleader.gif

Edited by exceed
Link to comment
Share on other sites
Ajmal Enthusiast

Ajmal

Posted
  • Author
Posted (edited)

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 by Ajmal
explanation
  • Like 1
Link to comment
Share on other sites
exceed Collaborator

exceed

Posted
Posted (edited) 
; 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)
    )
)

rotated.gif

 

(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"). 

no%20rotate.gif

like this gif

 

Edited by exceed
Link to comment
Share on other sites
Ajmal Enthusiast

Ajmal

Posted
  • Author
Posted

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

Link to comment
Share on other sites
exceed Collaborator

exceed

Posted
Posted (edited)
1 hour 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 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))

 

 

 

Edited by exceed
keep original leader settings
Link to comment
Share on other sites
Ajmal Enthusiast

Ajmal

Posted
  • Author
Posted
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. 

  • Like 1
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...