Leaderboard

You can use it with while function with getpoint function. (if (setq p1 (getpoint "\nSpecify a point : ")) (while (setq p2 (getpoint "\nNext point : " p1)) (entmake (list '(0 . "LINE") (cons 10 p1) (cons 11 p2))) (setq p1 p2) ) )

Hello, something from me . (defun c:kk (/ PT1 PT2 lower-left upper-right upper-left lower-right) (setq PT1 (getpoint "Select first point: ")) (setq PT2 (getcorner PT1 "\nSelect second point: ")) (setq lower-left (list (apply 'min (list (car PT1) (car PT2))) (apply 'min (list (cadr PT1) (cadr PT2))))) (setq upper-right (list (apply 'max (list (car PT1) (car PT2))) (apply 'max (list (cadr PT1) (cadr PT2))))) (setq lower-right (list (nth 0 upper-right) (nth 1 lower-left))) (setq upper-left (list (nth 0 lower-left) (nth 1 upper-right))) (princ (strcat "\nLower-left--> "(rtos (car lower-left) 2 3) " "(rtos (cadr lower-left) 2 3))) (princ (strcat "\nUpper-left--> "(rtos (car upper-left) 2 3)" "(rtos (cadr upper-left) 2 3))) (princ (strcat "\nUpper-right--> "(rtos (car upper-right) 2 3)" "(rtos (cadr upper-right) 2 3))) (princ (strcat "\nLower-right--> "(rtos (car lower-right) 2 3)" "(rtos (cadr lower-right) 2 3))) (princ) )

My $0.05 just ssget text, then make a list as suggested maybe sort the list so always 1 2 3 4 then just use a while/repeat/foreach select destination text it will update as 1 2 3 4. This is very rough maybe needs sort and a proper exit when pick less than selection set. (defun c:mattext ( / ss lst x ent) (setq ss (ssget '((0 . "TEXT")))) (setq lst '()) (repeat (setq x (sslength ss)) (setq lst (cons (cdr (assoc 1 (entget (ssname ss (setq x (1- x)))))) lst)) ) (setq lst (reverse lst)) (setq x -1) (repeat (length lst) (setq ent (entget (car (entsel "\nPick text ")))) (entmod (subst (cons 1 (nth (setq x (1+ x)) lst)) (assoc 1 ent) ent)) ) (princ) )

Another way (command "line" (while (< 0 (getvar 'CMDACTIVE)) (command pause)) )

This will give you the length and width from two points UR (4 6) LL (2 2) (setq L&W (mapcar '- UR LL)) L&W = (2 4) lenght = (car L&W) width = (cadr L&W) or pull x and y from defined points (setq UL (list (car LL) (cadr UR))) UL = (2 6) (setq LR (list (car UR) (cadr LL))) LR = (4 2)

Actually it works with "n" because opening the dwg using the script file the prompt is "do you want to discard the changes"?

Here's another way which works but after I right click to exit it gives this error. Unknown command "S". Press F1 for help. I wouldn't mind doing it this way as I would like to omit XLINEs and HATCH entities from the stretch. ;; Repeat stretch command that doesn't select xLINES or HATCH entities. (defun c:S (/) (while (= 0 (logand 0 (getvar 'cmdactive))) (command "_.stretch" (ssget '((0 . "~XLINE") (0 . "~HATCH"))) "" pause) (vl-cmdf "\\") ) )

Maybe for future when you do close it can ask save Y or N so (write-line "n" f) ;;'n' to save the drawing (change this about later) I am pretty sure will discard changes. need "Y"

Hehe I tell people to always defined local variables. makes me wonder what "(command" is doing if not outputting directly to the command line.

Yeah its kinda strange that (command "_.Multiple") returns nil Was going to see if a keybinding in CUI was going to do the trick but this works well. little tweak (defun c:foofighters () (vla-SendCommand (vla-get-ActiveDocument (vlax-get-acad-object)) "MULTIPLE STRETCH ") )

Here is another option, copy and pasted from what I have, not perfect though (defun c:MSCTX ( / MySS MySS2 acount entcodes ent1 ent2 entlist1 entlist2 text01 text02 text11 text12 entcodes1 entcodes2 acount acounter explist ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun deletelistitem (mylist itemtodelete / acounter nextitem) ;;delete a list item (setq acounter 0) (while (< acounter (length mylist) ) (setq nextitem (car mylist)) (setq mylist (cdr mylist)) ;;chop off first element (if (/= nextitem itemtodelete) (progn (setq mylist (append mylist (list nextitem))) ;stick next item to the back );end progn );end if (setq acounter (+ acounter 1)) );end while (setq nextitem (car mylist)) (setq mylist (cdr mylist)) (setq mylist (append mylist (list nextitem))) mylist ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun deletedxfdata ( delent delentlist entcodes / acount acounter ) (setq acounter 0) (setq acount 0) (while (< acount (length entcodes)) (while (< acounter (length delentlist)) (if (= (car (nth acounter delentlist) ) (nth acount entcodes) ) (progn (entmod (setq delentlist (subst (cons (nth acount entcodes) "") (nth acounter delentlist) delentlist))) (entupd delent) ) ) (setq acounter (+ acounter 1)) );end while (setq acount (+ acount 1)) );end while delentlist ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun getfroment (ent listorstring entcodes / acount acounter mytext newtext stringtext) ;;get dotted pairs list (setq entlist (entget ent)) (setq enttype (cdr (assoc 0 entlist))) (setq acount 0) (while (< acount (length entlist)) (setq acounter 0) (while (< acounter (length entcodes)) (setq entcode (nth acounter entcodes)) (if (= (car (nth acount entlist)) entcode ) (progn (setq newtext (cdr (nth acount entlist))) (if (numberp newtext)(setq newtext (rtos newtext))) ;fix for real numbers (setq mytext (append mytext (list (cons (car (nth acount entlist)) newtext) )) ) );end progn );end if (setq acounter (+ acounter 1)) );end while (setq acount (+ acount 1)) );end while ;;get string from dotted pair lists (if (= listorstring "astring") ;convert to text (progn (if (> (length mytext) 0) (progn (setq acount 0) (setq temptext "") (while (< acount (length mytext)) (setq temptext (cdr (nth acount mytext)) ) (if (= (wcmatch temptext "LEADER_LINE*") nil)()(setq temptext "")) ;;Fix for Multileader 'Leader_Line' Text (if (= stringtext nil) (setq stringtext temptext) (setq stringtext (strcat stringtext temptext )) );end if (setq acount (+ acount 1)) );end while );end progn );end if (if (= stringtext nil)(setq stringtext "")) (setq mytext stringtext) );end progn );end if mytext ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;get text as a string (defun gettextasstring ( enta entcodes / texta ) (if (= (getfroment enta "astring" entcodes) "") () (setq texta (getfroment enta "astring" entcodes)) ) texta ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun addinnewtext (newtext newentlist newent / ) (if (/= newtext nil) (progn (if (= (cdr (assoc 0 newentlist)) "DIMENSION") (progn ;;ent mod method, stops working at 2000-ish characters (entmod (setq newentlist (subst (cons 1 newtext) (assoc 1 newentlist) newentlist))) (entupd newent) );end progn (progn ;;vla-put-text string for large text blocks + 2000 characters? (vla-put-textstring (vlax-ename->vla-object newent) newtext) );end progn ) ;end if ) ;end progn (princ "\nSource text is not 'text'") );end if ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:MSCTX ( / MySS MySS2 acount entcodes ent1 ent2 entlist1 entlist2 text01 text02 text11 text12 entcodes1 entcodes2 acount acounter explist ) ;;get text 1 (setq MySS (ssget '((0 . "*TEXT")))) (setq acount 0) (while (< acount (sslength MySS)) (setq ent1 (ssname MySS acount)) (setq entlist1 (entget ent1)) (setq entcodes1 (list 3 4 1 172 304) ) (setq text01 (gettextasstring ent1 entcodes1) ) ;Text as string (princ (strcat "\nSelect Text to change to " text01 " or press ENTER to move on: ")) ;;loop till cancelled (while (/= nil (setq MySS2 (ssget "_:S" '((0 . "*TEXT"))))) (setq ent2 (ssname MySS2 0 )) ;;get text 2 (setq entlist2 (entget ent2)) (setq entcodes2 (list 3 4 1 172 304) ) (setq text02 (gettextasstring ent2 entcodes2) ) (setq entcodes2 (deletelistitem entcodes2 '1)) (setq entlist2 (deletedxfdata ent2 entlist2 entcodes2)) ;;put in new text (addinnewtext text01 entlist2 ent2) (princ (strcat "\nSelect Text to change to " text01 " or press ENTER to move on: ")) );end while (setq acount (+ acount 1)) ) (princ) )

command: dx DIM-XL(dx).lsp