Leaderboard

Example: (alert (menucmd "M=$(edtime,$(getvar,date),MO/DD/YY)"))

My attempt. (defun c:Apex ( / sel pts pt1 pt2 pt3 pt4 pt5 pt6 sg1 sg2) ;; Tharwat - 5.Mar.2022 ;; (and (princ "\nSelect LWpolyline : ") (setq sel (ssget "_+.:S:E" '((0 . "LWPOLYLINE")))) (mapcar '(lambda (q) (and (= (car q) 10) (setq pts (cons (cdr q) pts)))) (reverse (entget (ssname sel 0)))) (or (< 5 (length pts)) (alert "Polyline should have at least 6 vertices to continue <!>") ) (mapcar 'set '(pt1 pt2 pt3 pt4 pt5 pt6) pts) (setq sg1 (distance pt1 (inters pt1 pt2 pt4 pt3 nil)) g2 (+ (distance pt1 pt2) (distance pt3 (inters pt3 pt4 pt6 pt5 nil))) ) ) (list sg1 sg2) )

Just for fun... or like this if your lines are not polylines? (defun c:testthis ( / ) (setq frad (getvar 'filletrad)) (setq line1 (car (entsel "\nSelect Line 1"))) (setq line2 (car (entsel "\nSelect Line 2"))) (setq pta (cdr (assoc 10 (entget line1))) ) (setq ptb (cdr (assoc 11 (entget line1))) ) (setq ptc (cdr (assoc 10 (entget line2))) ) (setq ptd (cdr (assoc 11 (entget line2))) ) (command "pline" pta ptb "") (setq pline1 entlast) (command "pline" ptc ptd "") (setq pline2 entlast) (setvar 'filletrad 5) (command "fillet" pta ptc) (setvar 'filletrad frad) (setq pline3 (entlast)) (setq length1 (vlax-curve-getDistAtParam pline3 (vlax-curve-getEndParam pline3 )) ) (entdel pline3) (princ "\Length: ") (princ length1) (princ) )

As Paper Space was introduced over 30 years ago and advances like multiple layouts, Publish command and Sheet Sets that have made output tasks like this so simple. I've got to ask why???

You can add modes to SSGET to make it look and act like you'd expect selecting a single object. (sssetfirst nil (ssget "+.:E:S")) Code reference by Lee Mac: http://www.lee-mac.com/ssget.html

;;----------------------------------------------------------------------------;; ;; Dump all DXF Group Data (defun c:DumpIt (/ e) (if (setq SS (ssget)) (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) ;list and steps through all entitys in selection set (mapcar 'print (entget ent '( "*"))) ) ) (textscr) (princ) ) This pulls the entity name of anything you select with the mouse. (setq blk (car (entsel "\nSelect Block"))) sssetfirst highlights selection set but you can just pick one entity (sssetfirst nil (ssget)) or by ssname (sssetfirst nil SS)

Yes, thats quick and clean. Thanks. (alert (menucmd "M=$(edtime,$(getvar,tdindwg),HH:MM:SS)"))

Hi @mhupp , sorry for uncompleted code. Because, I am learning Lisp code by myself. Your reply helpful for me. Thank you so much. reason for turn off snaps, " -INSERT" command. (command "-INSERT" "donut" pnt 0.0002 0.0002 0) corrected code here.... (defun c:bi (/ ss ent itm val pnt svr) (setq lst (list 'cmdecho 'osmode) svr (mapcar 'getvar lst) ) (mapcar 'setvar lst '(0 0)) (setvar 'clayer "CAO DO") (setq ss (ssget (list (cons 0 "TEXT,INSERT") (cons 8 "CAO DO")))) (repeat (setq x (sslength ss)) (setq ent (ssname ss (setq x (- x 1)))) (setq itm (cdr (assoc 0 (entget ent)))) (if (eq itm "TEXT") (progn (setq ins (cdr (assoc 11 (entget ent)))) (setq val (cdr (assoc 1 (entget ent)))) (setq pnt (list (car ins) (cadr ins) (atof val))) (command "-INSERT" "donut" pnt 0.0002 0.0002 0) (entmod (subst (list 10 (car ins) (cadr ins) (atof val)) (assoc 10 (entget ent)) (entget ent))) ) ) (if (eq itm "INSERT") (entdel ent)) ) (mapcar 'setvar lst svr) (princ) )

;; RETABLE - 2022.03.04 exceed ;; https://www.cadtutor.net/forum/topic/74577-redraw-table-line-for-old-table-texts-and-lines/ (defun C:RETABLE ( / *error* x_tol text_size_sample text_ss text_size y_tol text_ss_length text_ss_index text_data_list text_ent text_ent_name text_box text_box_min_x text_box_min_y text_box_max_x text_box_max_y text_data tdll tdllindex memory_min_x memory_min_y memory_max_x memory_max_y now_min_y now_max_y mid_y now_min_x now_max_x mid_y_stack mysl mysindex memory_mys filtered_mys now_mys gap_mys pt1 pt2 first_y last_y first_x mid_x_stack mid_x mxsl mxsindex memory_mxs filtered_mxs now_mxs gap_mxs mid_x_stack pt3 pt4 last_x ) (LM:startundo (LM:acdoc)) (setvar "cmdecho" 0) (defun *error* ( msg ) (LM:endundo (LM:acdoc)) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\nError: " msg)) ) (princ) ) (setq x_tol 0) (setq y_tol 0) (setq text_size 0) (setq text_ss_length 0) (princ "\n RETABLE - Select Texts to Remake Table Line") (setq text_ss (ssget ":L" '((0 . "*TEXT")) ) ) (initget 4) (setq x_tol (getreal "\n Input X-axis tolerance < 0 >")) (if (= x_tol nil) (setq x_tol 0)) (setq text_size_sample (entget (ssname text_ss 0))) (setq text_size (cdr (assoc 40 text_size_sample))) ;(princ "\n text_size - ") ;(princ text_size) (initget 4) (setq y_tol (getreal (strcat "\n Input Y-axis tolerance < " (vl-princ-to-string text_size) " >"))) (if (= y_tol nil) (setq y_tol text_size)) (setq text_ss_length (sslength text_ss)) (setq text_ss_index 0) (setq text_data_list nil) (setq text_ent nil) (repeat text_ss_length (setq text_ent (entget (ssname text_ss text_ss_index))) (setq text_ent_name (cdr (assoc -1 text_ent))) (setq text_box (text-box-off text_ent 0)) (setq text_box_min_x (car (car text_box))) (setq text_box_min_y (cadr (car text_box))) (setq text_box_max_x (car (caddr text_box))) (setq text_box_max_y (cadr (caddr text_box))) (setq text_data (list text_box_min_x text_box_min_y text_box_max_x text_box_max_y)) ;text_ent_name)) (setq text_data_list (cons text_data text_data_list)) (setq text_ss_index (+ text_ss_index 1)) ) ;(princ text_data_list) (setq text_data_list (vl-sort text_data_list (function (lambda (x1 x2)(< (cadr x1) (cadr x2))) ) ) ) ;(princ "\n sorted by min_y list =") ;(princ text_data_list) (setq tdll (length text_data_list)) (setq tdlindex 0) (setq memory_min_x (car (nth 0 text_data_list))) (setq memory_min_y (cadr (nth 0 text_data_list))) (setq memory_max_x (caddr (nth 0 text_data_list))) (setq memory_max_y (cadddr (nth 0 text_data_list))) (setq mid_y_stack nil) (repeat (- tdll 1) (setq now_min_y (cadr (nth tdlindex text_data_list))) (setq now_max_y (cadddr (nth tdlindex text_data_list))) (if (> now_min_y memory_max_y) (progn (setq mid_y (/ (+ now_min_y memory_max_y) 2)) (setq memory_max_y now_max_y) (setq memory_min_y now_min_y) ) (progn (setq memory_max_y now_max_y) ) ) ;(princ "\n mid_y : ") ;(princ mid_y) (setq mid_y_stack (cons mid_y mid_y_stack)) (setq tdlindex (+ tdlindex 1)) ) (setq tdlindex 0) (repeat tdll (setq now_min_x (car (nth tdlindex text_data_list))) (setq now_max_x (caddr (nth tdlindex text_data_list))) (if (< now_min_x memory_min_x) (progn (setq memory_min_x now_min_x) ) ) (if (> now_max_x memory_max_x) (progn (setq memory_max_x now_max_x) ) ) (setq tdlindex (+ tdlindex 1)) ) (setq mid_y_stack (LM:Unique mid_y_stack)) (setq mid_y_stack (cdr (vl-sort mid_y_stack '<))) ;(princ "\n mid_y_stack : ") ;(princ mid_y_stack) (setq mysl (length mid_y_stack)) (setq mysindex 1) (setq memory_mys (car mid_y_stack)) (setq filtered_mys (list (car mid_y_stack))) (repeat (- mysl 1) (setq now_mys (nth mysindex mid_y_stack)) (setq gap_mys (- now_mys memory_mys)) ;(princ "\n gap_mys - ") ;(princ gap_mys) (if (> gap_mys y_tol) (setq filtered_mys (cons now_mys filtered_mys)) ) (setq memory_mys now_mys) (setq mysindex (+ mysindex 1)) ) (setq mid_y_stack (reverse filtered_mys)) ;(princ "\n filtered mid_y_stack - ") ;(princ mid_y_stack) ;(princ "\n min_x : ") ;(princ memory_min_x) ;(princ "\n max_x : ") ;(princ memory_max_x) (setq last_x (+ memory_max_x (atoi (rtos (/ text_size 2) 2 0))) ) (setq text_data_list (vl-sort text_data_list (function (lambda (x1 x2)(< (car x1) (car x2))) ) ) ) (setq memory_min_x (car (nth 0 text_data_list))) (setq first_x (- memory_min_x (atoi (rtos (/ text_size 2) 2 0)))) (setq mysl (length mid_y_stack)) (setq mysindex 0) (repeat mysl (setq pt1 (list first_x (nth mysindex mid_y_stack))) (setq pt2 (list last_x (nth mysindex mid_y_stack))) ;(princ "\n pt1 : ") ;(princ pt1) ;(princ "\n pt2 : ") ;(princ pt2) (entmake (list '(0 . "LINE") (cons 10 pt1) (cons 11 pt2) ) ) (setq mysindex (+ mysindex 1)) ) ;draw outline (setq first_y 0) (setq last_y 0) (setq first_y (+ (nth (- mysl 1) mid_y_stack) (- (nth (- mysl 1) mid_y_stack) (nth (- mysl 2) mid_y_stack)) ) ) (setq last_y (- (car mid_y_stack) (- (cadr mid_y_stack) (car mid_y_stack)) ) ) ;(princ "\n first_y : ") ;(princ first_y) ;(princ "\n last_y : ") ;(princ last_y) (entmake (list '(0 . "LINE") (cons 10 (list first_x first_y)) (cons 11 (list last_x first_y)) ) ) (entmake (list '(0 . "LINE") (cons 10 (list first_x last_y)) (cons 11 (list last_x last_y)) ) ) ;draw x line (setq tdlindex 0) (setq memory_max_x (caddr (nth 0 text_data_list))) (setq mid_x_stack '()) (repeat (- tdll 1) (setq now_min_x (car (nth tdlindex text_data_list))) (setq now_max_x (caddr (nth tdlindex text_data_list))) (if (> now_min_x memory_max_x) (progn (setq mid_x (/ (+ now_min_x memory_max_x) 2)) (setq memory_max_x now_max_x) (setq memory_min_x now_min_x) ) (progn (setq memory_max_x now_max_x) ) ) ;(princ "\n mid_x : ") ;(princ mid_x) (setq mid_x_stack (cons mid_x mid_x_stack)) (setq tdlindex (+ tdlindex 1)) ) (setq mid_x_stack (LM:Unique mid_x_stack)) (setq mid_x_stack (cdr (vl-sort mid_x_stack '<))) ;(princ "\n mid_x_stack - ") ;(princ mid_x_stack) (setq mxsl (length mid_x_stack)) (setq mxsindex 1) (setq memory_mxs (car mid_x_stack)) (setq filtered_mxs (list (car mid_x_stack))) (repeat (- mxsl 1) (setq now_mxs (nth mxsindex mid_x_stack)) (setq gap_mxs (- now_mxs memory_mxs)) ;(princ "\n gap_mxs - ") ;(princ gap_mxs) (if (> gap_mxs x_tol) (setq filtered_mxs (cons now_mxs filtered_mxs)) ) (setq memory_mxs now_mxs) (setq mxsindex (+ mxsindex 1)) ) (setq mid_x_stack (reverse filtered_mxs)) ;(princ "\n filtered mid_x_stack - ") ;(princ mid_x_stack) (setq mxsl (length mid_x_stack)) (setq mxsindex 0) (repeat mxsl (setq pt3 (list (nth mxsindex mid_x_stack) last_y)) (setq pt4 (list (nth mxsindex mid_x_stack) first_y)) ;(princ "\n pt3 : ") ;(princ pt3) ;(princ "\n pt4 : ") ;(princ pt4) (entmake (list '(0 . "LINE") (cons 10 pt3) (cons 11 pt4) ) ) (setq mxsindex (+ mxsindex 1)) ) (entmake (list '(0 . "LINE") (cons 10 (list first_x first_y )) (cons 11 (list first_x last_y)) ) ) (entmake (list '(0 . "LINE") (cons 10 (list last_x first_y)) (cons 11 (list last_x last_y)) ) ) (princ "\n RETABLE - done.") (LM:endundo (LM:acdoc)) (setvar "cmdecho" 1) (princ) ) ;; Text Box - gile / Lee Mac ;; Returns an OCS point list describing a rectangular frame surrounding ;; the supplied text or mtext entity with optional offset ;; enx - [lst] Text or MText DXF data list ;; off - [rea] offset (may be zero) (defun text-box-off ( enx off / bpt hgt jus lst ocs org rot wid ) (cond ( (= "TEXT" (cdr (assoc 00 enx))) (setq bpt (cdr (assoc 10 enx)) rot (cdr (assoc 50 enx)) lst (textbox enx) lst (list (list (- (caar lst) off) (- (cadar lst) off)) (list (+ (caadr lst) off) (- (cadar lst) off)) (list (+ (caadr lst) off) (+ (cadadr lst) off)) (list (- (caar lst) off) (+ (cadadr lst) off)) ) ) ) ( (= "MTEXT" (cdr (assoc 00 enx))) (setq ocs (cdr (assoc 210 enx)) bpt (trans (cdr (assoc 10 enx)) 0 ocs) rot (angle '(0.0 0.0) (trans (cdr (assoc 11 enx)) 0 ocs)) wid (cdr (assoc 42 enx)) hgt (cdr (assoc 43 enx)) jus (cdr (assoc 71 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 (list (- (car org) off) (- (cadr org) off)) (list (+ (car org) wid off) (- (cadr org) off)) (list (+ (car org) wid off) (+ (cadr org) hgt off)) (list (- (car org) off) (+ (cadr org) hgt off)) ) ) ) ) (if lst ( (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) ) ) ) ) ;; Unique - Lee Mac ;; Returns a list with duplicate elements removed. (defun LM:Unique ( l ) (if l (cons (car l) (LM:Unique (vl-remove (car l) (cdr l))))) ) ;; Matrix x Vector - Vladimir Nesterovsky ;; Args: m - nxn matrix, v - vector in R^n (defun mxv ( m v ) (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m) ) ;; Start Undo - Lee Mac ;; Opens an Undo Group. (defun LM:startundo ( doc ) (LM:endundo doc) (vla-startundomark doc) ) ;; End Undo - Lee Mac ;; Closes an Undo Group. (defun LM:endundo ( doc ) (while (= 8 (logand 8 (getvar 'undoctl))) (vla-endundomark doc) ) ) ;; Active Document - Lee Mac ;; Returns the VLA Active Document Object (defun LM:acdoc nil (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object)))) (LM:acdoc) ) redraw lines for texts, which are arranged like old-style tables with texts and lines. this lisp can use when they are lost lines, or a part of the line is in the xref, or lost xref files or etc.... there are many Lisp, that turns old tables into tables but generally for that lisp need these lines or that ignores blank cells by outputting only the position of the text. this is not complete routine. it may not calculate the left and right widths properly but it can enough to use it for conversion lisp. i think command : RETABLE (minimum table size = 2 column x 3 row) I used a text box to resolve the different alignment points. and there may be texts with slightly different x values, slightly different y values, or overlapping texts in real work, so I put a tolerance value that ignores them. x tol - x length to ignore (default: 0) y tol - y length to ignore (default: font size) - different access. I have been trying to compare the textbox and basepoint to measure the max number of rows and columns. and calculate which column is close to the empty cells. but I still have a long way to go.

I'm sure their is a better way to do this. (defun C:ETIME (/ time D H M S) (setq time (getvar 'tdindwg) D (fix time) H (fix (setq time (* (- time D) 24))) M (fix (setq time (* (- time H) 60))) S (rtos (* (- time M) 60) 2 3) ) (alert (strcat "Edit Time: " (itoa D) " Days " (itoa H) " Hours " (itoa M) " Minutes " S " Seconds")) ) Also the Time command displays Total edited time.

Another way to do this is set ATTREQ to 0 then fill in the attributes after insertion: (defun _putatt (e tag val) (vl-catch-all-apply 'setpropertyvalue (list e tag val)) ) (_putatt (entlast) "XYZ" "123")

@Kajanthan Its always best to leave command as the last choice if you can do it another way. (setvar 'clayer "CAO DO") ;set current layer to No real reason to turn off snaps since your pulling points from entget and using entmod to update the text. especially if your not restoring them to the old value. user will start to question why their snaps are randomly getting turned off. Also prob also want to turn cmdecho back on before exit. Saw this for setting & restoring values after lisp is done. (setq lst (list 'cmdecho 'osmode) val (mapcar 'getvar lst) ) (mapcar 'setvar lst '(0 0)) ..... (mapcar 'setvar lst val) or old reliable (setq oldsnap (getvar 'osmode)) (setvar 'osmode 0) ..... (setvar 'osmode oldsnap)

Another approach. It is not tested if the blocks are referred in the drawing, but only if they are defined! (vlax-for el (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (setq $name (vla-get-name el)) (if (/= (substr $name 1 1) "*") ;;Filter out anonymous blocks (setq LS_BLOCK_NAMES (cons $name LS_BLOCK_NAMES)) ) )

(setq lst '( "name2" "name3" "name1")) (acad_strlsort) (acad_strlsort lst) ("name1" "name2" "name3") (vl-sort) (vl-sort lst '>) ("name3" "name2" "name1") (vl-sort lst '<) ("name1" "name2" "name3")