Leaderboard

Maybe this line. To many closing brackets. (setq lot (getstring "\nLot Number Not found Please Input: "))

; ECT - 2022.05.26 exceed ; https://www.cadtutor.net/forum/topic/75239-combine-text-and-export/ ; - what is this ; Text content is concatenated between texts close to each other. ; ; - how to use ; 1. select a group of text twice. ; 2. overwriting the text of the 1st selected group. ; ; - note ; 1. Because it simply works on distance-based, ; It's not a 1:1 pair. For example, if text group2 is less than group1, the closest group2 is copied. ; 2. If there is text with overlapping positions, it may not work properly. (vl-load-com) (defun c:ECT ( / ss ssl index1 ss1list obj1 coord1 list1 ss2 ss2l index2 ss2list obj2 coord2 list2 pairstack index11 coord11 index22 coord22 dist12 distlist distmin pslen psindex txt1 txt2 puttxt ) (princ "\n pick 1st group of text") (setq ss (ssadd)) (setq ss (ssget ":L" '((0 . "*TEXT")))) (setq ssl (sslength ss)) (if (/= ssl 0) (progn (setq index1 0) (setq ss1list '()) ;make 1st list (repeat ssl (setq obj1 (vlax-ename->vla-object (ssname ss index1))) (setq coord1 (vlax-safearray->list (vlax-variant-value (vlax-get-property obj1 'InsertionPoint)))) (setq list1 (list obj1 coord1)) (setq ss1list (cons list1 ss1list)) (setq index1 (+ index1 1)) ) (princ "\n pick 2nd group of text") (setq ss2 (ssget ":L" '((0 . "*TEXT")))) (setq ss2l (sslength ss2)) (setq index2 0) (setq ss2list '()) ;make 2nd list (repeat ss2l (setq obj2 (vlax-ename->vla-object (ssname ss2 index2))) (setq coord2 (vlax-safearray->list (vlax-variant-value (vlax-get-property obj2 'InsertionPoint)))) (setq list2 (list obj2 coord2)) (setq ss2list (cons list2 ss2list)) (setq index2 (+ index2 1)) ) (setq pairstack '()) (setq index11 0) (repeat ssl (setq coord11 (cadr (nth index11 ss1list))) (setq index22 0) (setq distlist '()) (repeat ss2l (setq coord22 (cadr (nth index22 ss2list))) (setq dist12 (distance coord11 coord22)) (setq distlist (cons (list (car (nth index22 ss2list)) dist12) distlist)) (setq index22 (+ index22 1)) ) (setq distlist (vl-sort distlist (function (lambda (x1 x2)(< (cadr x1) (cadr x2))) ) )) (setq distmin (car (car distlist))) (setq pairlist (list (car (nth index11 ss1list)) distmin)) (setq pairstack (cons pairlist pairstack)) (setq index11 (+ index11 1)) ) (setq pslen (length pairstack)) (setq psindex 0) (repeat pslen (setq txt1 (car (nth psindex pairstack))) (setq txt2 (cadr (nth psindex pairstack))) (setq puttxt (strcat (vlax-get-property txt1 'TextString) " / " (vlax-get-property txt2 'TextString))) (vlax-put-property txt1 'TextString puttxt) (setq psindex (+ psindex 1)) ) );end of progn );end of if (princ) );end of defun COMMAND : ECT You should check the areas with overlapping or densed text. it makes error.

OK So it you might have made something like this if you got it to work: (defun c:testthis ( / spt1 spt2 roomname a b c d scpt1 mywidth myheight) ;; after the '/' are local variable names (setq ;;setq: Tells LISP you are setting a variable spt1 (getpoint "\nPick the first point") ;;should be obvious what this does spt3 (getcorner "\nPick the next corner" spt1) ;;should be obvious what this does roomname (getstring "\nEnter Room Name: " T) ;;T allows spaces, else space acts as a return a (if (< (car spt1)(car spt3))(car spt1)(car spt3)) ;;Lower Left X coord car gives first item in a list, here x coord b (if (> (car spt1)(car spt3))(car spt1)(car spt3)) ;;Upper Right X coord c (if (< (cadr spt1)(cadr spt3))(cadr spt1)(cadr spt3)) ;;Lower Left y Coord cadr gives second item in a list, here y coord d (if (> (cadr spt1)(cadr spt3))(cadr spt1)(cadr spt3)) ;;Upper Right Y Coord ) (setq mywidth (abs (- a b))) ;;abs for absolute value (witohut = or -), (- is subtract (setq myheight (abs (- c d))) ;;center points (setq scpt1 (list (/ (+ a b) 2) (/ (+ c d) 2)) ) ;;create a coordinate which is a list (/ for divide (+ for add (command "mtext" scpt1 "J" "MC" scpt1 (strcat roomname "\n" (rtos mywidth 2 2) " x " (rtos myheight 2 2 )) "") ;;Command echos what you'd type in command line, anything in "" is a fixed value in else it is calculated ) Put a few notes in if you want to learn how it does what it does

"A gentleman and a scholar!" I will definitely help support this great community.

No need but if you really want to give someone money maybe donate to @CADTutor to help with upkeep. https://www.paypal.com/webapps/shoppingcart?flowlogging_id=f4665218b5343&mfid=1653580133615_f4665218b5343

Haha, awesome! The program is already better than I expected. I didn't realize it was adding the lot # to the label as well. I thought I would have to use NUMINC.lsp for that. I can't pay you the rate you can probably charge for this work, but I would like to at least buy you a few drinks!

If your going to give me money I will have to switch SW to work with a DCL file. (defun C:SW (/ 25M10 25M40 50M10 50M40 75M10 75M40) (or (setq 25M10 (vlax-ldata-get "xfmr" "25M10")) (setq 25M10 "Not Set")) (or (setq 25M40 (vlax-ldata-get "xfmr" "25M40")) (setq 25M40 "Not Set")) (or (setq 50M10 (vlax-ldata-get "xfmr" "50M10")) (setq 50M10 "Not Set")) (or (setq 50M40 (vlax-ldata-get "xfmr" "50M40")) (setq 50M40 "Not Set")) (or (setq 75M10 (vlax-ldata-get "xfmr" "75M10")) (setq 75M10 "Not Set")) (or (setq 75M40 (vlax-ldata-get "xfmr" "75M40")) (setq 75M40 "Not Set")) (setq fo (open (setq fn (vl-filename-mktemp "" "" ".dcl")) "w")) (write-line "Table : dialog { label = \"Maximum Distances for Transformers\";" fo) (write-line " : edit_box {label = \"25KVA and 1/0 wire\"; key = \"25M10\"; alignment = centered; edit_width = 10; allow_accept = true;}" fo) (write-line " : edit_box {label = \"25KVA and 4/0 wire\"; key = \"25M40\"; alignment = centered; edit_width = 10; allow_accept = true;}" fo) (write-line " : edit_box {label = \"50KVA and 1/0 wire\"; key = \"50M10\"; alignment = centered; edit_width = 10; allow_accept = true;}" fo) (write-line " : edit_box {label = \"50KVA and 4/0 wire\"; key = \"50M40\"; alignment = centered; edit_width = 10; allow_accept = true;}" fo) (write-line " : edit_box {label = \"75KVA and 1/0 wire\"; key = \"75M10\"; alignment = centered; edit_width = 10; allow_accept = true;}" fo) (write-line " : edit_box {label = \"75KVA and 4/0 wire\"; key = \"75M40\"; alignment = centered; edit_width = 10; allow_accept = true;}" fo) (write-line " ok_only;" fo) (write-line "}" fo) (close fo) (new_dialog "Table" (setq d (load_dialog fn))) ; Set Dialog Initial Settings (set_tile "25M10" 25M10) (set_tile "25M40" 25M40) (set_tile "50M10" 50M10) (set_tile "50M40" 50M40) (set_tile "75M10" 75M10) (set_tile "75M40" 75M40) (action_tile "25M10" "(vlax-ldata-put \"xfmr\" \"25M10\" $value)") (action_tile "25M40" "(vlax-ldata-put \"xfmr\" \"25M40\" $value)") (action_tile "50M10" "(vlax-ldata-put \"xfmr\" \"50M10\" $value)") (action_tile "50M40" "(vlax-ldata-put \"xfmr\" \"50M40\" $value)") (action_tile "75M10" "(vlax-ldata-put \"xfmr\" \"75M10\" $value)") (action_tile "75M40" "(vlax-ldata-put \"xfmr\" \"75M40\" $value)") (start_dialog) ; Unload Dialog (unload_dialog d) (vl-file-delete fn) (princ) ) (defun C:foo (/ poly len spt pt1 pt2 SST lot SSX xfmr ept wire) (defun *error* () (command nil nil nil) (if (not (member *error* '("quit / exit abort"))) ;might have to change this to what autocad says (princ (strcat "\nError: " *error*)) ) ) (or (setq 25M10 (vlax-ldata-get "xfmr" "25M10")) (setq 25M10 "Not Set")) (or (setq 25M40 (vlax-ldata-get "xfmr" "25M40")) (setq 25M40 "Not Set")) (or (setq 50M10 (vlax-ldata-get "xfmr" "50M10")) (setq 50M10 "Not Set")) (or (setq 50M40 (vlax-ldata-get "xfmr" "50M40")) (setq 50M40 "Not Set")) (or (setq 75M10 (vlax-ldata-get "xfmr" "75M10")) (setq 75M10 "Not Set")) (or (setq 75M40 (vlax-ldata-get "xfmr" "75M40")) (setq 75M40 "Not Set")) (cond ((eq 25M10 "Not Set") (prompt "\nTransformer Distances not set Please run code: SW") (quit) ) ((eq 25M40 "Not Set") (prompt "\nTransformer Distances not set Please run code: SW") (quit) ) ((eq 50M10 "Not Set") (prompt "\nTransformer Distances not set Please run code: SW") (quit) ) ((eq 50M40 "Not Set") (prompt "\nTransformer Distances not set Please run code: SW") (quit) ) ((eq 75M10 "Not Set") (prompt "\nTransformer Distances not set Please run code: SW") (quit) ) ((eq 75M40 "Not Set") (prompt "\nTransformer Distances not set Please run code: SW") (quit) ) ) (initget "25 50 75") (setq xfmr (getkword "\nSize of Transformers[25/50/75]: ")) (while (setq e (car (entsel "\nSelect Polyline"))) (setq poly (vlax-ename->vla-object e)) (setq len (+ (* 10 (fix ((if (minusp (vla-get-length poly)) - +) (/ (vla-get-length poly) (float 10)) 0.5))) 15)) ;Lee Mac round lenth up to nearest 10' add 15' (setq spt (vlax-curve-getStartPoint poly)) (setq pt1 (mapcar '- spt '(30 30))) (setq pt2 (mapcar '+ spt '(30 30))) (if (and (setq SST (ssget "C" pt1 pt2 '((0 . "MTEXT") (8 . "APS-LNDLN")))) (= (sslength SST) 1)) (setq lot (cdr (assoc 1 (entget (ssname SST 0))))) ) (if xfmr (progn) (setq xfmr (LM:vl-getattributevalue (vlax-ename->vla-object (car (entsel "\nSelect Transformr Block: "))) "KVA")) ) (if lot (progn) (setq lot (cdr (assoc 1 (entget (car (entsel "\nSelect Lot Number")))))) ) (cond ((and (eq xfmr "25") (<= len (read 25M10))) (setq wire "WIRE 1/0") ) ((and (eq xfmr "25") (<= len (read 25M40))) (setq wire "WIRE 4/0") ) ((and (eq xfmr "25") (> len (read 25M40))) (setq wire "ERROR") ) ((and (eq xfmr "50") (<= len (read 50M10))) (setq wire "WIRE 1/0") ) ((and (eq xfmr "50") (<= len (read 50M40))) (setq wire "WIRE 4/0") ) ((and (eq xfmr "50") (> len (read 50M40))) (setq wire "ERROR") ) ((and (eq xfmr "75") (<= len (read 75M10))) (setq wire "WIRE 1/0") ) ((and (eq xfmr "75") (<= len (read 75M40))) (setq wire "WIRE 4/0") ) ((and (eq xfmr "75") (> len (read 75M40))) (setq wire "ERROR") ) ) (if (setq blk (vlax-ename->vla-object (car (entsel "\nSelect Block: ")))) (progn (LM:vl-setattributevalue blk "FOOTAGE" (strcat (itoa len) "'")) (LM:vl-setattributevalue blk "WIRE" wire) (LM:vl-setattributevalue blk "LOT_NUM" lot) ) ) (sssetfirst nil (ssadd e)) (mapcar 'set '(poly e len spt pt1 pt2 SST lot SSX xfmr ept wire) '(nil nil nil nil nil nil nil nil nil nil nil nil)) ) (princ) ) ;; Get Attribute Value - Lee Mac ;; Returns the value held by the specified tag within the supplied block, if present. ;; blk - [vla] VLA Block Reference Object ;; tag - [str] Attribute TagString ;; Returns: [str] Attribute value, else nil if tag is not found. (defun LM:vl-getattributevalue (blk tag) (setq tag (strcase tag)) (vl-some '(lambda (att) (if (= tag (strcase (vla-get-tagstring att))) (vla-get-textstring att))) (vlax-invoke blk 'getattributes)) ) ;; Set Attribute Value - Lee Mac ;; Sets the value of the first attribute with the given tag found within the block, if present. ;; blk - [vla] VLA Block Reference Object ;; tag - [str] Attribute TagString ;; val - [str] Attribute Value ;; Returns: [str] Attribute value if successful, else nil. (defun LM:vl-setattributevalue (blk tag val) (setq tag (strcase tag)) (vl-some '(lambda (att) (if (= tag (strcase (vla-get-tagstring att))) (progn (vla-put-textstring att val) val ) ) ) (vlax-invoke blk 'getattributes) ) )

that's it i replaced (setq lot (cdr (assoc 1 (entget (car (entsel "\nSelect Lot Number")))))) To just ask for a number rather then selecting text if it wasn't found.

Woah.. that was fast. This looks perfect! I haven't been able to test it yet because I'm getting another error in the visual lisp editor. I skimmed through the code and don't see any obvious extra parenthesis. Do you have cash app? I would like toss a few bucks your way in appreciation of your time.

Exceed I need more time to look but I did something similar to a schedule of 5 columns, so need opposite of XY rather sort YX, it also took into account blanks, the reason I mention is just window select all text. It had hundreds of lines and and end result was a list. When you sort the Y's you should get 2 values with same Y plus tolerance if not then second is blank. I looked at nth x & nth x+1 comparing using equal with a tolerance, in this case on x which is opposite for me. The sample has something to do with road design so I doubt it will ever be on an angle. Ps I wrote it as version 2 for a customer the end task was convert column text to a table for the future. Found one out there but used lines for boxes around text, no good for me as did multiple schedules in one window pick. It had variable line spacing. XY sort (setq lst (vl-sort lst '(lambda (a b) (cond ((< (car a) (car b))) ((= (car a) (car b) ) (< (cadr a) (cadr b))) ) ) ) )

Basically does what you want. SW when run for the first time will output this Max length for 50KVA & 4/0 wire [Not Set] If you run it again it will have whats inputted. Max length for 50KVA & 4/0 wire [135]: (input can be typing a number or using the mouse to select two points) These values will be saved to the drawing using ldata and recalled when foo or sw is run again. if someone tries to run the main program before SW or all xfmr lengths are not set it will ask to run the SW command and exit. You might have to edit what the error says to prevent the popup about "quit / exit abort" Didn't do step 6 they way you want it out if spite! no I'm sure their is a easy way to do it but can't figure it out right now and its late. currently it ask for the size of the transformer and keep that size while the command is active so if you need to switch sizes you have to exit the command. (defun C:SW (/ 25M10 25M40 50M10 50M40 75M10 75M40) (or (setq 25M10 (vlax-ldata-get "xfmr" "25M10")) (setq 25M10 "Not Set")) (if (setq 25M10 (rtos (getdist (strcat "\nMax length for 25KVA & 1/0 wire [" 25M10 "]: "))2 0)) (vlax-ldata-put "xfmr" "25M10" 25M10) ) (or (setq 25M40 (vlax-ldata-get "xfmr" "25M40")) (setq 25M40 "Not Set")) (if (setq 25M40 (rtos (getdist (strcat "\nMax length for 25KVA & 4/0 wire [" 25M40 "]: "))2 0)) (vlax-ldata-put "xfmr" "25M40" 25M40) ) (or (setq 50M10 (vlax-ldata-get "xfmr" "50M10")) (setq 50M10 "Not Set")) (if (setq 50M10 (rtos (getdist (strcat "\nMax length for 50KVA & 1/0 wire [" 50M10 "]: "))2 0)) (vlax-ldata-put "xfmr" "50M10" 50M10) ) (or (setq 50M40 (vlax-ldata-get "xfmr" "50M40")) (setq 50M40 "Not Set")) (if (setq 50M40 (rtos (getdist (strcat "\nMax length for 50KVA & 4/0 wire [" 50M40 "]: "))2 0)) (vlax-ldata-put "xfmr" "50M40" 50M40) ) (or (setq 75M10 (vlax-ldata-get "xfmr" "75M10")) (setq 75M10 "Not Set")) (if (setq 75M10 (rtos (getdist (strcat "\nMax length for 75KVA & 1/0 wire [" 75M10 "]: "))2 0)) (vlax-ldata-put "xfmr" "75M10" 75M10) ) (or (setq 75M40 (vlax-ldata-get "xfmr" "75M40")) (setq 75M40 "Not Set")) (if (setq 75M40 (rtos (getdist (strcat "\nMax length for 75KVA & 4/0 wire [" 75M40 "]: "))2 )) (vlax-ldata-put "xfmr" "75M40" 75M40) ) ) (defun C:foo (/ poly len spt pt1 pt2 SST lot SSX xfmr ept wire) (defun *error* () (command nil nil nil) (if (not (member *error* '("quit / exit abort"))) ;might have to change this to what autocad says (princ (strcat "\nError: " *error*)) ) ) (or (setq 25M10 (vlax-ldata-get "xfmr" "25M10")) (setq 25M10 "Not Set")) (or (setq 25M40 (vlax-ldata-get "xfmr" "25M40")) (setq 25M40 "Not Set")) (or (setq 50M10 (vlax-ldata-get "xfmr" "50M10")) (setq 50M10 "Not Set")) (or (setq 50M40 (vlax-ldata-get "xfmr" "50M40")) (setq 50M40 "Not Set")) (or (setq 75M10 (vlax-ldata-get "xfmr" "75M10")) (setq 75M10 "Not Set")) (or (setq 75M40 (vlax-ldata-get "xfmr" "75M40")) (setq 75M40 "Not Set")) (cond ((eq 25M10 "Not Set") (prompt "\nTransformer Distances not set Please run code: SW") (quit) ) ((eq 25M40 "Not Set") (prompt "\nTransformer Distances not set Please run code: SW") (quit) ) ((eq 50M10 "Not Set") (prompt "\nTransformer Distances not set Please run code: SW") (quit) ) ((eq 50M40 "Not Set") (prompt "\nTransformer Distances not set Please run code: SW") (quit) ) ((eq 75M10 "Not Set") (prompt "\nTransformer Distances not set Please run code: SW") (quit) ) ((eq 75M40 "Not Set") (prompt "\nTransformer Distances not set Please run code: SW") (quit) ) ) (initget "25 50 75") (setq xfmr (getkword "\nSize of Transformers[25/50/75]: ")) (while (setq e (car (entsel "\nSelect Polyline"))) (setq poly (vlax-ename->vla-object e)) (setq len (+ (* 10 (fix ((if (minusp (vla-get-length poly)) - +) (/ (vla-get-length poly) (float 10)) 0.5))) 15)) ;Lee Mac round lenth up to nearest 10' add 15' (setq spt (vlax-curve-getStartPoint poly)) (setq pt1 (mapcar '- spt '(30 30))) (setq pt2 (mapcar '+ spt '(30 30))) (if (and (setq SST (ssget "C" pt1 pt2 '((0 . "MTEXT") (8 . "APS-LNDLN")))) (= (sslength SST) 1)) (setq lot (cdr (assoc 1 (entget (ssname SST 0))))) ) (if lot (progn) (setq lot (getstring "\nLot Number Not found Please Input: ")) ;this will ask if lot number wasnt found when picking the polyline ) (cond ((and (eq xfmr "25") (<= len (read 25M10))) (setq wire "WIRE 1/0") ) ((and (eq xfmr "25") (<= len (read 25M40))) (setq wire "WIRE 4/0") ) ((and (eq xfmr "25") (> len (read 25M40))) (setq wire "ERROR") ) ((and (eq xfmr "50") (<= len (read 50M10))) (setq wire "WIRE 1/0") ) ((and (eq xfmr "50") (<= len (read 50M40))) (setq wire "WIRE 4/0") ) ((and (eq xfmr "50") (> len (read 50M40))) (setq wire "ERROR") ) ((and (eq xfmr "75") (<= len (read 75M10))) (setq wire "WIRE 1/0") ) ((and (eq xfmr "75") (<= len (read 75M40))) (setq wire "WIRE 4/0") ) ((and (eq xfmr "75") (> len (read 75M40))) (setq wire "ERROR") ) ) (if (setq blk (vlax-ename->vla-object (car (entsel "\nSelect Block: ")))) (progn (LM:vl-setattributevalue blk "FOOTAGE" (strcat (itoa len) "'")) (LM:vl-setattributevalue blk "WIRE" wire) (LM:vl-setattributevalue blk "LOT_NUM" lot) ) ) (sssetfirst nil (ssadd e)) (mapcar 'set '(poly e len spt pt1 pt2 SST lot SSX ept wire) '(nil nil nil nil nil nil nil nil nil nil nil)) ) (princ) ) ;; Get Attribute Value - Lee Mac ;; Returns the value held by the specified tag within the supplied block, if present. ;; blk - [vla] VLA Block Reference Object ;; tag - [str] Attribute TagString ;; Returns: [str] Attribute value, else nil if tag is not found. (defun LM:vl-getattributevalue (blk tag) (setq tag (strcase tag)) (vl-some '(lambda (att) (if (= tag (strcase (vla-get-tagstring att))) (vla-get-textstring att))) (vlax-invoke blk 'getattributes)) ) ;; Set Attribute Value - Lee Mac ;; Sets the value of the first attribute with the given tag found within the block, if present. ;; blk - [vla] VLA Block Reference Object ;; tag - [str] Attribute TagString ;; val - [str] Attribute Value ;; Returns: [str] Attribute value if successful, else nil. (defun LM:vl-setattributevalue (blk tag val) (setq tag (strcase tag)) (vl-some '(lambda (att) (if (= tag (strcase (vla-get-tagstring att))) (progn (vla-put-textstring att val) val ) ) ) (vlax-invoke blk 'getattributes) ) )

; 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))

How is your LISP programming? Would I be telling you what you know if I wrote this all out fully or would it all be new to you? I'll meet you half way and give you the basics of what I think you'll need - mostly because the other night I posted what is below (plus a few other bits) just deleted what you don't want so try this (from try this: (defun c:testthis ( / a b c d scpt1 mywidth myheight) (setq spt1 (getpoint "\nPick the first point") spt3 (getcorner "\Pick the next corner" spt1) a (if (< (car spt1)(car spt3))(car spt1)(car spt3)) ;;Lower Left X coord b (if (> (car spt1)(car spt3))(car spt1)(car spt3)) ;;Upper Right X coord c (if (< (cadr spt1)(cadr spt3))(cadr spt1)(cadr spt3)) ;;Lower Left y Coord d (if (> (cadr spt1)(cadr spt3))(cadr spt1)(cadr spt3)) ;;Upper Right Y Coord ) (setq mywidth (abs (- a b))) (setq myheight (abs (- c d))) ;;center points (setq scpt1 (list (/ (+ a b) 2) (/ (+ c d) 2)) ) (command "text" scpt1 2.5 0 "Text Here" "") ) You'll need to work out the text input yourself and the final text but this will give you the basics - if you struggle with the other parts just shout and we can fill in the rest of the details

; 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

; 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

my drawing is like to this drawing , many cbw need to show, how can i align angle and heignt all leader easily