Leaderboard

After seeing @BIGAL's suggestion, I'm wondering if I understood correctly what you're asking, Vica. Anyway, I'm attaching a short clip of what I'm talking about. FACTVM de ARCTIS.mp4 I’ve implemented a small emulator of the "pline" command in the base code, but each user should implement the code they need for their specific task instead. Basically, the distance variation from the last stored point in LASTPOINT is displayed above the cursor (though this can be easily changed by modifying the textoGR1 function). Below the cursor, any desired information about the object under it will be shown (or not, if visibility is toggled by pressing the F10 key). This information must be passed to the textoGR2 function as a list of (Property_Name StringValue) pairs. The main code must be implemented in the 'FuncionPrincipal' function.

did a little cleaning & tweaking and added a (grdraw) background to give it just a tiny bit more spunk ... enjoy ;;; RlxGrMenu - 2025-07-09 - Just a funny / basic / tiny 'toolbar' ;;; It draws a column on the right of your screen with 12 rows. ;;; Config is not working yet and I'm not sure it's worth the effort because its only meant as a lisp launcher. ;;; Quit by click on QUIT in toolbar or by typing Q , q or space, zoom in / out with +/-/z ;;; I've run a little out of button-space so wanted an out of the box solution to this problem. ;;; this is just a way to run my 10 most used lisp routines, nothing more , nothing less. ;;; Substitute the names in app-list (setq app-list (list "LC" "VT"...) with names from your own favorite apps ;;; Apps (lisps) have to be in search path so (findfile (strcat "MyApp" ".lsp") should work. ;;; Also apps should not be self executing and the start command should be same as app name. ;;; If your app is named "MyApp" this routine loads the app if found and starts it with (eval (read (strcat "C:" "Myapp"))) ;;; have fun ;;; ------------------------------ ;;; ;;; |S1 S2| ;;; ;;; | -------------- ----- [a]| ;;; ;;; | |E1 E2| [b]| ;;; ;;; | | | [c]| ;;; ;;; | | | [d]| ;;; ;;; | |E3 E4| [e]| ;;; ;;; | -------------------- [f]| ;;; ;;; |S3 S4| ;;; ;;; ------------------------------ ;;; ;;; (count_calcula) : run time values for viewsize / viewcenter etc ;;; values are effected by resize window : vc , vs , ss , x+ , x- , y+ , y- , P1-P4 ;;; screen corner points : S1 = (x- y+) , S2 (x+ y+) , S3 (x- y-) , S4 (x+ y-) ;;; extents corner points : E1 - E5 extmin / extmax ;;; viewsize : vs - height current viewport (drawing units) (i.e. 300 / 386 after resize) ;;; screen size : ss (1187 532) (pixels) after max acad window : vs = 386 , ss = (1840 685) ;;; - 12 rows, 1-10 for user , 11 for config , 12 for exit ;;; - height each row = viewsize / 12, row width = 2 x row height ;;; cell-ip = (list (- (fix x+) cell-size) (fix y+)) ;;; vector draw cell-ip -> cell-size<0, (* cell-size 12)<270 , cell-size<180 , (* cell-size 12)<90 (defun draw_menu ( / ip-x ip-y cell-h cell-w cell-ul cell-ll cell-ur cell-lr y-list ctr-x app-list app gr-loop tblc tbtc tbbc start-viewsize) (setq app-list (list "LC" "VT" "RlxBatch" "USB" "FX" "FIP" "LspUser1" "LspUser2" "LspUser2" "Spare" "Config" "Quit")) ;;; toolbar line color / toolbar text color / toolbar background color (setq gr-loop T tblc 7 tbtc 7 tbbc 8) ;;; when zooming in/out it messes up back ground fill so have to compensate for that (setq start-viewsize (getvar "viewsize")) (redraw_menu) ;;; launch app (if app (RlxGrMenu_Start_App app)) ) (defun redraw_menu () (redraw) ;;; get live screen data (count_calcula) (setq cell-h (/ (- y+ y-) 12) cell-w (* cell-h 2)) ;;; corner points (setq cell-ul (list (- x+ cell-w) y+) cell-ur (list x+ y+) cell-ll (list (- x+ cell-w) y-) cell-lr (list x+ y-)) ;;; get y values for all horizontal separators (setq x-list (list (car cell-ll) (car cell-lr)) y-list (gnl- (- (fix y+) cell-h) 11 cell-h)) ;;; fill the backgrounds (setq yy y-) (while (< yy y+) (grdraw (list (car cell-ll) yy) (list (car cell-lr) yy) tbbc) ;;; next y depends on zoom factor (viewsize) , 0.25 is emperical, bigger means bigger linespacing (setq yy (+ yy (* 0.25 (/ (getvar "viewsize") start-viewsize)))) ) ;;; draw the outlines (grdraw cell-ll cell-ul tblc)(grdraw cell-ul cell-ur tblc)(grdraw cell-ur cell-lr tblc)(grdraw cell-lr cell-ll tblc) ;;; drawn separators (foreach y y-list (grdraw (list (car cell-ll) y) (list (car cell-lr) y) tblc)) ;;; label the cell (setq ctr-x (+ (car cell-ll) (* cell-w 0.5))) (mapcar '(lambda (s y)(grtxt (strcase s) (list ctr-x (+ y (* cell-h 0.5))) tbtc 0 "M")) app-list (append y-list (list (- (last y-list) cell-h)))) (if gr-loop (RlxGrMenu_Get_Cell_ID x-list y-list)) ) ;;; fill cell with cell background color , use offset of 0.5 unit so outlines remain visible (defun fill_cell (x y w h / x2 y2 w2 h2 x3) (setq x2 (+ x 0.5) y2 (+ y 0.5) w2 (- w 1) h2 (- h 1) x3 (+ x2 w2)) ;(repeat (* (fix h2) 2) (grdraw (list x2 y2) (list x3 y2) tbbc)(setq y2 (+ y2 0.5))) (while (< y2 (cadr cell-ul)) (grdraw (list x2 y2) (list x3 y2) tbbc)(setq y2 (+ y2 0.5))) ) ;;; (re) calculate display parameters (count_calcula) (defun count_calcula () (setq vc (getvar "VIEWCTR") vs (getvar "VIEWSIZE") ss (getvar "SCREENSIZE") dx (* vs (/ (car ss) (cadr ss)) 0.5) dy (* vs 0.5) x- (- (car vc) dx) y- (- (cadr vc) dy) x+ (+ (car vc) dx) y+ (+ (cadr vc) dy) ip (getvar "viewctr") vc-x (car ip) vc-y (cadr ip) txt-h (/ (getvar "VIEWSIZE") 100.0))) ;;; (getvar "extmin") (getvar "extmax") (setq dvx (- x+ x-) dvy (- y+ y-)) (defun screen_res (/ s i is) (setq s (vlax-invoke (vlax-create-object "WbemScripting.SWbemLocator") 'ConnectServer nil nil nil nil nil nil nil) is (vlax-invoke s 'ExecQuery "SELECT CurrentHorizontalResolution, CurrentVerticalResolution FROM Win32_VideoController")) (vlax-for i is (vlax-get i 'CurrentHorizontalResolution))) ;;; generate number (gnum 1 5) -> '(1 2 3 4 5) (defun gnum (s e / i l) (and (numberp s)(numberp e)(setq i s)(while (<= i e)(setq l (cons i l) i (1+ i)))) (reverse l)) ;;; i = startnumber n = number of numbers , d = difference (gnl- 100 6 12) -> (100 88 76 64 52 40) (defun gnl- (i n d / l) (setq l (list i))(repeat (1- n)(setq l (cons (setq i (- i d)) l)))(reverse l)) ;;; found this old lisp (grtxt.lsp) , don't know author but all credits are for this human from earth ;;; text string / coordinate point / color / angle justificationz ;;; *** UPPER CASE ONLY *** (grtxt (STRCASE "Rob") (getvar "viewctr") 1 0 "M") (defun grtxt (ts cp cl a j / vp ltb i xp z c p1 p2 lp ld n al) ;;; vertex points (setq vp '(( 1 ( 0.50 0.25))( 2 ( 0.50 0.55))( 3 ( 0.50 0.85))( 4 ( 0.50 1.00))( 5 ( 0.25 1.00)) ( 6 ( 0.00 1.00))( 7 (-0.25 1.00))( 8 (-0.50 1.00))( 9 (-0.50 0.85))(10 (-0.50 0.55)) (11 (-0.50 0.25))(12 (-0.50 0.10))(13 (-0.25 0.10))(14 ( 0.00 0.10))(15 ( 0.25 0.10)) (16 ( 0.50 0.10))(17 ( 0.50 -0.05))(18 ( 0.50 -0.45))(19 ( 0.50 -0.85))(20 ( 0.50 -1.00)) (21 ( 0.25 -1.00))(22 ( 0.00 -1.00))(23 (-0.25 -1.00))(24 (-0.50 -1.00))(25 (-0.50 -0.85)) (26 (-0.50 -0.40))(27 (-0.50 -0.05))(30 ( 0.35 0.85))(31 (-0.35 0.85))(32 (-0.35 -0.85)) (33 ( 0.35 -0.85))(40 ( 0.25 0.35))(41 (-0.25 0.35))(42 ( 0.25 -0.15))(43 (-0.25 -0.15)) (44 ( 0.00 0.45))(45 ( 0.00 -0.25))(50 ( 0.30 0.20))(51 ( 0.30 0.35))(52 ( 0.20 0.35)) (53 ( 0.20 0.20))(54 ( 0.30 0.10))(55 ( 0.30 -0.10))(56 ( 0.20 -0.10))(57 ( 0.20 0.10)) (60 (-0.30 0.20))(61 (-0.30 0.35))(62 (-0.20 0.35))(63 (-0.20 0.20))(64 (-0.30 0.10)) (65 (-0.30 -0.10))(66 (-0.20 -0.10))(67 (-0.20 0.10)))) ;;; letter table (setq ltb '(("A" 24 9 7 5 3 20 16 12) ("B" 12 15 1 3 5 8 24 21 19 17 15) ("C" 3 5 7 9 25 23 21 19) ("D" 3 5 8 24 21 19 3) ("E" 4 8 12 15 12 24 20) ("F" 4 8 12 15 12 24) ("G" 3 5 7 9 25 23 21 19 16 14) ("H" 20 -4 8 -24 16 12) ("I" 7 5 6 22 23 21) ("J" 4 19 21 23 25) ("K" 8 24 12 13 4 13 20) ("L" 8 24 20) ("M" 24 8 14 4 20) ("N" 24 8 20 4) ("O" 3 5 7 9 25 23 21 19 3) ("P" 12 15 1 3 5 8 24) ("Q" 3 5 7 9 25 23 21 19 3 -19 20 45) ("R" 20 14 12 15 1 3 5 8 24) ("S" 3 5 7 9 11 13 15 17 19 21 23 25) ("T" 4 8 6 22) ("U" 8 25 23 21 19 4 20) ("V" 8 22 4) ("W" 8 23 14 21 4) ("X" 4 -24 8 20) ("Y" 8 14 22 14 4) ("Z" 8 4 24 20) ("0" 3 5 7 9 25 23 21 19 -3 4 24) ("1" 31 7 6 22 21 23) ("2" 9 7 5 3 1 15 13 27 24 20) ("3" 9 7 5 3 1 15 13 15 17 19 21 23 25) ("4" 8 12 16 15 5 21) ("5" 4 8 12 15 17 19 21 23 25) ("6" 3 5 7 9 25 23 21 19 17 15 12) ("7" 8 4 22) ("8" 3 5 7 9 11 13 27 25 23 21 19 17 15 13 15 1 3) ("9" 25 23 21 19 3 5 7 9 11 13 16) ("<" 4 12 20) (">" 8 16 24) ("," 33 21) ("." 19 20 21 33 19) ("\'" 4 30) ("\"" 4 -30 7 31) (";" 50 51 52 53 -50 54 55 56 57 55 45) (":" 50 51 52 53 -50 54 55 56 57 55) ("\\" 8 20) ("/" 4 24) ("?" 11 10 7 5 2 1 45 22) ("|" 6 -44 45 22) ("+" 44 -45 13 15) ("=" 40 -41 43 42) ("-" 13 15) ("_" 20 24) (")" 6 2 18 22) ("(" 6 10 26 22) ("*" 40 -43 41 -42 45 44) ("&" 21 31 7 6 26 25 23 16) ("^" 10 6 2) ("%" 57 54 55 56 -57 63 60 61 62 -63 5 24) ("$" 3 5 7 9 11 13 15 17 19 21 23 25 -26 22 6) ("#" 24 -6 22 -4 1 -11 17 27) ("@" 42 15 40 44 41 13 43 45 42 17 3 5 7 9 25 23 21 19) ("!" 6 -45 22 22) ("~" 9 31 44 40 2) ("`" 8 31) ("[" 6 8 24 22) ("]" 6 4 20 22) ("{" 6 7 41 12 43 23 22) ("}" 6 5 40 16 42 21 22) (""))) ;;; text height (setq z (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE")) 0.2)) (cond ;;; left justification ((eq (strcase (substr j 1 1)) "L") (setq xp (list (+ (car cp) z) (cadr cp)) i 1)) ;;; middle justification ((eq (strcase (substr j 1 1)) "M") (setq xp (list (- (car cp) (* z (strlen ts) 0.5)) (cadr cp)) i 1)) ;;; right justification ((eq (strcase (substr j 1 1)) "R") (setq xp (list (- (car cp) (* z (strlen ts) 1.5)) (cadr cp)) i 1)) ) (repeat (strlen ts) ;;; each charachter / line point list / letter point def (setq c (substr ts i 1) lp '() ld (cdr (assoc c ltb))) (while (> (length ld) 1) (setq p1 (cadr (assoc (abs (nth 0 ld)) vp)) p2 (cadr (assoc (abs (nth 1 ld)) vp)) p1 (mapcar '* (list z z) p1) p2 (mapcar '* (list z z) p2) p1 (mapcar '+ xp p1) p2 (mapcar '+ xp p2) lp (append lp (list (if (minusp (nth 0 ld)) 0 cl) p1 p2)) ld (cdr ld)) ) ;;; add rotation angle (setq n 0 al nil) (repeat (/ (length lp) 3) (setq al (cons (nth n lp) al) al (cons (polar cp (+ a (angle cp (nth (+ n 1) lp))) (distance cp (nth (+ n 1) lp))) al) al (cons (polar cp (+ a (angle cp (nth (+ n 2) lp))) (distance cp (nth (+ n 2) lp))) al)) (setq n (+ n 3)) ) (and al (grvecs (reverse al))) (setq xp (list (+ (car xp) (* z 1.5)) (cadr xp)) i (1+ i)) ) (prin1) ) ;;; probably won't need tracking mode (cut-copy-paste you know...) (defun RlxGrMenu_Get_Cell_ID (xl yl / inp dev tpt prev-tpt mark-current-tracking-point cell-id prev-cell-id prev-view-size cur-view-size rtn) (princ "\nEsc/Q/Rmouse to cancel, zoom with E(extend), Z(oom) or + / -") (setq prev-view-size (getvar "viewsize")) (while gr-loop (setq cur-view-size (getvar "viewsize")) (setq inp (vl-catch-all-apply 'grread (list T 8 1))) (if (vl-catch-all-error-p inp) (progn (setq gr-loop nil inp nil)(redraw)) (progn (setq dev (car inp) tpt (cadr inp)) (cond ;;; space , q or Q (Quit) ((and (= dev 2) (member (last inp) '(32 113 81))) (redraw)(setq gr-loop nil) ) ;;; point selection (3 (221.882 173.853 0.0)) ((= dev 3) (if (setq rtn (find_cell tpt xl yl)) (progn ;(alert (setq app (nth (1- (atoi rtn)) app-list))) (princ (strcat "\nLaunching : " (setq app (nth (1- (atoi rtn)) app-list)))) (setq gr-loop nil) ) ) ) ;;; device tracking point (probably don't need tracking mode) ((= dev 5) ;;; if mouse moved (if (or (/= (car prev-tpt)(car tpt)) (/= (cadr prev-tpt)(cadr tpt))) (progn (setq prev-tpt tpt ))) (if (not (equal cur-view-size prev-view-size)) (progn (setq prev-view-size cur-view-size) (redraw_menu) ) ) ) ; user pressed E of e ((member inp '((2 69)(2 101))) (command "zoom" "e")) ; user clicked R-mouse button, pressed enter or space (done selecting) ((or (equal (car inp) 25)(member inp '((2 13)(2 32)))) (setq gr-loop nil)) ; user pressed + ((equal inp '(2 43)) (vl-cmdf "zoom" "2x")) ; user pressed - ((equal inp '(2 45)) (vl-cmdf "zoom" ".5x")) ; user pressed z or Z ((member inp '((2 122)(2 90))) (vl-cmdf "'zoom" "")) ) ) ) ) (princ) ) ;;; pt = point , xl = x-list , yl = y-list ;;; scribble : (< 1 2 3) , (> 3 2 1) , (cdr (vl-sort '(1 2 3 4 5) '>)) -> '(4 3 2 1) (defun find_cell ( pt xl yl / ptx pty y-lst l n hit) (setq n nil hit nil ptx (car pt) pty (cadr pt) y-list (vl-sort (append yl (list 0)) '>)) (if (< (car xl) ptx (cadr xl)) (mapcar '(lambda (y)(if (and (not hit) (> pty y)) (setq hit T n (vl-position y y-list)))) y-list)) (if n (itoa (1+ n))) ) ;;; program assumes no self starting routines and start command is "C:" + app name (defun RlxGrMenu_Start_App (app / fn) (cond ((setq fn (findfile (strcat app ".lsp"))) (redraw)(load fn)(eval (read (strcat "(C:" app ")")))) ((wcmatch (strcase app) "QUIT")(princ "\nBye bye")(redraw)) ((wcmatch (strcase app) "CONFIG")(princ "\nUnder construction")(redraw)) (t (redraw)(princ (strcat "\nUnable to load " (vl-princ-to-string app) " ...bye"))) ) ) ;;; future... ;;; RlxGrMenu - Rlx Jul/25 (defun RlxGrMenu_future ( / ;;; global variables scr-res cell-rows cell-cols cell-col cell-id app-list ;;; display parameters like viewctr/viewsize/screensize (count_calcula) vc vs ss dx dy x- x+ y- y+ ip vc-x vc-y txt-h ;;; registry variables RlxGrMenu-nof-cell-rows RlxGrMenu-nof-cell-cols RlxGrMenu-app-list ) ;;; mostly not used because for now I just just one column with 10 rows (setq scr-res (screen_res) rows 3 cols 3 cell-col 141 cell-id 1) (count_calcula) (setq app-list (list "LC" "VT" "RlxBatch" "USB" "FX" "FIP" "LspUser1" "LspUser2" "LspUser2" "Spare")) (RlxGrMenu_Init) (RlxGrMenu_Doit) (RlxGrMenu_Exit) (princ) ) (defun RlxGrMenu_Init ()(princ "\nUnder construction - RlxGrMenu_Init ")) (defun RlxGrMenu_Doit ()(princ "\nUnder construction - RlxGrMenu_Doit ")) (defun RlxGrMenu_Exit ()(princ "\nUnder construction - RlxGrMenu_Exit ")) (defun c:RlxGrMenu ()(draw_menu)) (defun c:t1 ()(draw_menu)) (defun t1 ()(draw_menu))

I wanted more buttons but ran out of space so just created an alternative reallity for myself. It's very basic / simple and still a work in progress but as usual time is not on my side especially now my boss in away for 4 weeks and he probably was afraid I would get bored and start to play with myself so he left me with a load of work. Update : because this routine uses grread you can't run any other (transparent) commands. Thats why I added 'hot' keys for zoom. E for extents, Z for zoom , + & - for zooming in & out. Maybe it's useful , maybe it's not...bite me. ;;; RlxGrMenu - 2025-07-09 - Just a funny / very basic little 'toolbar' ;;; It draws a column with 12 rows. Config is not working yet, quit by click or by typing Q or q. ;;; I've run a little out of button-space so wanted an out of the box solution to this problem. ;;; this is just a way to run my 10 most used lisp routines, nothing more , nothing less. ;;; Substitute the names in app-list (setq app-list '("LC" "VT" ...) with names from your own favorite apps ;;; apps have to be in search path so (findfile (strcat "MyApp" ".lsp") should work'. ;;; Also app should not be self executing and the start command should be same as app name ;;; If your app is named "MyApp" this routine loads app if found and starts it with (eval (read (strcat "C:" "Myapp"))) ;;; have fun ;;; ------------------------------ ;;; ;;; |S1 S2| ;;; ;;; | -------------- ----- [a]| ;;; ;;; | |E1 E2| [b]| ;;; ;;; | | | [c]| ;;; ;;; | | | [d]| ;;; ;;; | |E3 E4| [e]| ;;; ;;; | -------------------- [f]| ;;; ;;; |S3 S4| ;;; ;;; ------------------------------ ;;; ;;; (count_calcula) : ;;; values are effected by resize window : vc , vs , ss , x+ , x- , y+ , y- , P1-P4 ;;; screen corner points : S1 = (x- y+) , S2 (x+ y+) , S3 (x- y-) , S4 (x+ y-) ;;; extents corner points : E1 - E5 extmin / extmax ;;; viewsize : vs - height current viewport (drawing units) (i.e. 300 / 386 after resize) ;;; screen size : ss (1187 532) (pixels) after max acad window : vs = 386 , ss = (1840 685) ;;; - 12 rows, 1-10 for user , 11 for confid , 12 for exit ;;; - height each row = (fix (/ (- y+ y-) 12)) , for example 25 ;;; - row width = row height , lets call it cell-size ;;; cell-ip = (list (- (fix x+) cell-size) (fix y+)) ;;; vector draw cell-ip -> cell-size<0, (* cell-size 12)<270 , cell-size<180 , (* cell-size 12)<90 (defun draw_menu ( / ip-x ip-y cell-h cell-w cell-ul cell-ll cell-ur cell-lr y-list ctr-x app-list app gr-loop tblc tbtc) (setq app-list (list "LC" "VT" "RlxBatch" "USB" "FX" "FIP" "LspUser1" "LspUser2" "LspUser2" "Spare" "Config" "Quit")) (setq gr-loop T tblc 7 tbtc 7) ;;; toolbar line color / toolbar text colot (redraw_menu) ;;; launch app (if app (RlxGrMenu_Start_App app)) ) (defun redraw_menu () (redraw) ;;; get live screen data (count_calcula) ;(setq app-list (list "LC" "VT" "RlxBatch" "USB" "FX" "FIP" "LspUser1" "LspUser2" "LspUser2" "Spare" "Config" "Quit")) ;(setq cell-h (fix (/ (- y+ y-) 12)) cell-w (* cell-h 2)) ;;;; corner points ;(setq cell-ul (list (- (fix x+) cell-w) (fix y+)) cell-ur (list (fix x+) (fix y+)) ; cell-ll (list (- (fix x+) cell-w) (fix y-)) cell-lr (list (fix x+) (fix y-))) (setq cell-h (/ (- y+ y-) 12) cell-w (* cell-h 2)) ;;; corner points (setq cell-ul (list (- x+ cell-w) y+) cell-ur (list x+ y+) cell-ll (list (- x+ cell-w) y-) cell-lr (list x+ y-)) ;;; draw the outlines (grdraw cell-ll cell-ul tblc)(grdraw cell-ul cell-ur tblc)(grdraw cell-ur cell-lr tblc)(grdraw cell-lr cell-ll tblc) ;;; get y values for all horizontal separators (setq x-list (list (car cell-ll) (car cell-lr)) y-list (gnl- (- (fix y+) cell-h) 11 cell-h)) (foreach y y-list (grdraw (list (car cell-ll) y) (list (car cell-lr) y) tblc)) ;;; label the cell (setq ctr-x (+ (car cell-ll) (* cell-w 0.5))) (mapcar '(lambda (s y) (grtxt (strcase s) (list ctr-x (+ y (* cell-h 0.5))) tbtc 0 "M")) app-list (append y-list (list (- (last y-list) cell-h)))) (if gr-loop (RlxGrMenu_Get_Cell_ID x-list y-list)) (princ) ) ;;; (re) calculate display parameters (count_calcula) (defun count_calcula () (setq vc (getvar "VIEWCTR") vs (getvar "VIEWSIZE") ss (getvar "SCREENSIZE") dx (* vs (/ (car ss) (cadr ss)) 0.5) dy (* vs 0.5) x- (- (car vc) dx) y- (- (cadr vc) dy) x+ (+ (car vc) dx) y+ (+ (cadr vc) dy) ip (getvar "viewctr") vc-x (car ip) vc-y (cadr ip) txt-h (/ (getvar "VIEWSIZE") 100.0))) ;;; (getvar "extmin") (getvar "extmax") (setq dvx (- x+ x-) dvy (- y+ y-)) (defun screen_res (/ s i is) (setq s (vlax-invoke (vlax-create-object "WbemScripting.SWbemLocator") 'ConnectServer nil nil nil nil nil nil nil) is (vlax-invoke s 'ExecQuery "SELECT CurrentHorizontalResolution, CurrentVerticalResolution FROM Win32_VideoController")) (vlax-for i is (vlax-get i 'CurrentHorizontalResolution))) ;;; get aspect ratio current screen (defun asp_rat () (rtos (* 1.5 (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE")))))) ;;; determine status caps lock for when typing filter (even though filter uses strcase) (defun case (s) (cond ((null s) "") ((not (eq (type s) 'STR)) "") ((null capslock) s) (t (if (= (acet-sys-keystate 20) 0) (strcase s t) (strcase s))))) ;;; generate number (gnum 1 5) -> '(1 2 3 4 5) (defun gnum (s e / i l) (and (numberp s)(numberp e)(setq i s)(while (<= i e)(setq l (cons i l) i (1+ i)))) (reverse l)) ;;; i = startnumber n = number of numbers , d = difference (gnl- 100 6 12) -> (100 88 76 64 52 40) (defun gnl- (i n d / l) (setq l (list i))(repeat (1- n)(setq l (cons (setq i (- i d)) l)))(reverse l)) ;;; found this old lisp (grtxt.lsp) , don't know author but all credits are for this human from earth ;;; text string / coordinate point / color / angle justificationz ;;; *** UPPER CASE ONLY *** (grtxt (STRCASE "Rob") (getvar "viewctr") 1 0 "M") (defun grtxt (ts cp cl a j / vp ltb i xp z c p1 p2 lp ld n al) ;;; vertex points (setq vp '(( 1 ( 0.50 0.25))( 2 ( 0.50 0.55))( 3 ( 0.50 0.85))( 4 ( 0.50 1.00))( 5 ( 0.25 1.00)) ( 6 ( 0.00 1.00))( 7 (-0.25 1.00))( 8 (-0.50 1.00))( 9 (-0.50 0.85))(10 (-0.50 0.55)) (11 (-0.50 0.25))(12 (-0.50 0.10))(13 (-0.25 0.10))(14 ( 0.00 0.10))(15 ( 0.25 0.10)) (16 ( 0.50 0.10))(17 ( 0.50 -0.05))(18 ( 0.50 -0.45))(19 ( 0.50 -0.85))(20 ( 0.50 -1.00)) (21 ( 0.25 -1.00))(22 ( 0.00 -1.00))(23 (-0.25 -1.00))(24 (-0.50 -1.00))(25 (-0.50 -0.85)) (26 (-0.50 -0.40))(27 (-0.50 -0.05))(30 ( 0.35 0.85))(31 (-0.35 0.85))(32 (-0.35 -0.85)) (33 ( 0.35 -0.85))(40 ( 0.25 0.35))(41 (-0.25 0.35))(42 ( 0.25 -0.15))(43 (-0.25 -0.15)) (44 ( 0.00 0.45))(45 ( 0.00 -0.25))(50 ( 0.30 0.20))(51 ( 0.30 0.35))(52 ( 0.20 0.35)) (53 ( 0.20 0.20))(54 ( 0.30 0.10))(55 ( 0.30 -0.10))(56 ( 0.20 -0.10))(57 ( 0.20 0.10)) (60 (-0.30 0.20))(61 (-0.30 0.35))(62 (-0.20 0.35))(63 (-0.20 0.20))(64 (-0.30 0.10)) (65 (-0.30 -0.10))(66 (-0.20 -0.10))(67 (-0.20 0.10)))) ;;; letter table (setq ltb '(("A" 24 9 7 5 3 20 16 12) ("B" 12 15 1 3 5 8 24 21 19 17 15) ("C" 3 5 7 9 25 23 21 19) ("D" 3 5 8 24 21 19 3) ("E" 4 8 12 15 12 24 20) ("F" 4 8 12 15 12 24) ("G" 3 5 7 9 25 23 21 19 16 14) ("H" 20 -4 8 -24 16 12) ("I" 7 5 6 22 23 21) ("J" 4 19 21 23 25) ("K" 8 24 12 13 4 13 20) ("L" 8 24 20) ("M" 24 8 14 4 20) ("N" 24 8 20 4) ("O" 3 5 7 9 25 23 21 19 3) ("P" 12 15 1 3 5 8 24) ("Q" 3 5 7 9 25 23 21 19 3 -19 20 45) ("R" 20 14 12 15 1 3 5 8 24) ("S" 3 5 7 9 11 13 15 17 19 21 23 25) ("T" 4 8 6 22) ("U" 8 25 23 21 19 4 20) ("V" 8 22 4) ("W" 8 23 14 21 4) ("X" 4 -24 8 20) ("Y" 8 14 22 14 4) ("Z" 8 4 24 20) ("0" 3 5 7 9 25 23 21 19 -3 4 24) ("1" 31 7 6 22 21 23) ("2" 9 7 5 3 1 15 13 27 24 20) ("3" 9 7 5 3 1 15 13 15 17 19 21 23 25) ("4" 8 12 16 15 5 21) ("5" 4 8 12 15 17 19 21 23 25) ("6" 3 5 7 9 25 23 21 19 17 15 12) ("7" 8 4 22) ("8" 3 5 7 9 11 13 27 25 23 21 19 17 15 13 15 1 3) ("9" 25 23 21 19 3 5 7 9 11 13 16) ("<" 4 12 20) (">" 8 16 24) ("," 33 21) ("." 19 20 21 33 19) ("\'" 4 30) ("\"" 4 -30 7 31) (";" 50 51 52 53 -50 54 55 56 57 55 45) (":" 50 51 52 53 -50 54 55 56 57 55) ("\\" 8 20) ("/" 4 24) ("?" 11 10 7 5 2 1 45 22) ("|" 6 -44 45 22) ("+" 44 -45 13 15) ("=" 40 -41 43 42) ("-" 13 15) ("_" 20 24) (")" 6 2 18 22) ("(" 6 10 26 22) ("*" 40 -43 41 -42 45 44) ("&" 21 31 7 6 26 25 23 16) ("^" 10 6 2) ("%" 57 54 55 56 -57 63 60 61 62 -63 5 24) ("$" 3 5 7 9 11 13 15 17 19 21 23 25 -26 22 6) ("#" 24 -6 22 -4 1 -11 17 27) ("@" 42 15 40 44 41 13 43 45 42 17 3 5 7 9 25 23 21 19) ("!" 6 -45 22 22) ("~" 9 31 44 40 2) ("`" 8 31) ("[" 6 8 24 22) ("]" 6 4 20 22) ("{" 6 7 41 12 43 23 22) ("}" 6 5 40 16 42 21 22) (""))) ;;; text height (setq z (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE")) 0.2)) (cond ;;; left justification ((eq (strcase (substr j 1 1)) "L") (setq xp (list (+ (car cp) z) (cadr cp)) i 1)) ;;; middle justification ((eq (strcase (substr j 1 1)) "M") (setq xp (list (- (car cp) (* z (strlen ts) 0.5)) (cadr cp)) i 1)) ;;; right justification ((eq (strcase (substr j 1 1)) "R") (setq xp (list (- (car cp) (* z (strlen ts) 1.5)) (cadr cp)) i 1)) ) (repeat (strlen ts) ;;; each charachter / line point list / letter point def (setq c (substr ts i 1) lp '() ld (cdr (assoc c ltb))) (while (> (length ld) 1) (setq p1 (cadr (assoc (abs (nth 0 ld)) vp)) p2 (cadr (assoc (abs (nth 1 ld)) vp)) p1 (mapcar '* (list z z) p1) p2 (mapcar '* (list z z) p2) p1 (mapcar '+ xp p1) p2 (mapcar '+ xp p2) lp (append lp (list (if (minusp (nth 0 ld)) 0 cl) p1 p2)) ld (cdr ld)) ) ;;; add rotation angle (setq n 0 al nil) (repeat (/ (length lp) 3) (setq al (cons (nth n lp) al) al (cons (polar cp (+ a (angle cp (nth (+ n 1) lp))) (distance cp (nth (+ n 1) lp))) al) al (cons (polar cp (+ a (angle cp (nth (+ n 2) lp))) (distance cp (nth (+ n 2) lp))) al)) (setq n (+ n 3)) ) (and al (grvecs (reverse al))) (setq xp (list (+ (car xp) (* z 1.5)) (cadr xp)) i (1+ i)) ) (prin1) ) ;;; probably won't need tracking mode (cut-copy-paste you know...) (defun RlxGrMenu_Get_Cell_ID (xl yl / inp dev tpt prev-tpt mark-current-tracking-point cell-id prev-cell-id prev-view-size cur-view-size rtn) (princ "\rEsc/Q/Rmouse to cancel, zoom with E(extend), Z(oom) or + / -") (setq prev-view-size (getvar "viewsize")) (while gr-loop (setq cur-view-size (getvar "viewsize")) (setq inp (vl-catch-all-apply 'grread (list T 8 1))) (if (vl-catch-all-error-p inp) (progn (setq gr-loop nil inp nil)(redraw)) (progn (setq dev (car inp) tpt (cadr inp)) (cond ;;; space , q or Q (Quit) ((and (= dev 2) (member (last inp) '(32 113 81))) (redraw)(setq gr-loop nil) ) ;;; point selection (3 (221.882 173.853 0.0)) ((= dev 3) (if (setq rtn (find_cell tpt xl yl)) (progn ;(alert (setq app (nth (1- (atoi rtn)) app-list))) (princ (strcat "\nLaunching : " (setq app (nth (1- (atoi rtn)) app-list)))) (setq gr-loop nil) ) ) ) ;;; device tracking point (probably don't need tracking mode) ((= dev 5) ;;; if mouse moved (if (or (/= (car prev-tpt)(car tpt)) (/= (cadr prev-tpt)(cadr tpt))) (progn (setq prev-tpt tpt ))) (if (not (equal cur-view-size prev-view-size)) (progn (setq prev-view-size cur-view-size) (redraw_menu) ) ) ) ; user pressed E of e ((member inp '((2 69)(2 101))) (command "zoom" "e")) ; user clicked R-mouse button, pressed enter or space (done selecting) ((or (equal (car inp) 25)(member inp '((2 13)(2 32)))) (redraw)(setq gr-loop nil app "Quit")) ; user pressed + ((equal inp '(2 43)) (vl-cmdf "zoom" "2x")) ; user pressed - ((equal inp '(2 45)) (vl-cmdf "zoom" ".5x")) ; user pressed z or Z ((member inp '((2 122)(2 90))) (vl-cmdf "'zoom" "")) ) ) ) ) (princ) ) ;;; pt = point , xl = x-list , yl = y-list ;;; scribble : (< 1 2 3) , (> 3 2 1) , (cdr (vl-sort '(1 2 3 4 5) '>)) -> '(4 3 2 1) (defun find_cell ( pt xl yl / ptx pty y-lst l n hit) (setq n nil hit nil ptx (car pt) pty (cadr pt) y-list (vl-sort (append yl (list 0)) '>)) (if (< (car xl) ptx (cadr xl)) (mapcar '(lambda (y)(if (and (not hit) (> pty y)) (setq hit T n (vl-position y y-list)))) y-list)) (if n (itoa (1+ n))) ) ;;; program assumes no self starting routines and start command is "C:" + app name (defun RlxGrMenu_Start_App (app / fn) (cond ((setq fn (findfile (strcat app ".lsp"))) (redraw)(load fn)(eval (read (strcat "(C:" app ")")))) ((wcmatch (strcase app) "QUIT")(princ "\nBye bye")(redraw)) ((wcmatch (strcase app) "CONFIG")(princ "\nUnder construction")(redraw)) (t (redraw)(princ (strcat "\nUnable to load " (vl-princ-to-string app) " ...bye"))) ) (princ) ) ;;; future... ;;; RlxGrMenu - Rlx Jul/25 (defun RlxGrMenu_future ( / ;;; global variables scr-res cell-rows cell-cols cell-col cell-id app-list ;;; display parameters like viewctr/viewsize/screensize (count_calcula) vc vs ss dx dy x- x+ y- y+ ip vc-x vc-y txt-h ;;; registry variables RlxGrMenu-nof-cell-rows RlxGrMenu-nof-cell-cols RlxGrMenu-app-list ) ;;; mostly not used because for now I just just one column with 10 rows (setq scr-res (screen_res) rows 3 cols 3 cell-col 141 cell-id 1) (count_calcula) (setq app-list (list "LC" "VT" "RlxBatch" "USB" "FX" "FIP" "LspUser1" "LspUser2" "LspUser2" "Spare")) (RlxGrMenu_Init) (RlxGrMenu_Doit) (RlxGrMenu_Exit) (princ) ) (defun RlxGrMenu_Init ()(princ "\nUnder construction - RlxGrMenu_Init ")) (defun RlxGrMenu_Doit ()(princ "\nUnder construction - RlxGrMenu_Doit ")) (defun RlxGrMenu_Exit ()(princ "\nUnder construction - RlxGrMenu_Exit ")) (defun c:RlxGrMenu ()(draw_menu)) (defun c:t1 ()(draw_menu)) (defun t1 ()(draw_menu))

oh yeah , the good ol' days of AutoCad , think I started around version 2.22 , 1987/88 or something. In that time only pull down & screen menu's , no xrefs , no model / paper space yet, IBM screens and keyboards you could knock out T-Rex with. Downside is , part of you will always be stucked in the good old days. I probably know only a couple % there is to know about AutoCad , maybe even less. I still go back to the old *mnu files for my toolbars because I still don't like ribbons. I want my buttons simple and always on the same location. But I do like colored buttons so now & again I upgrade one of my apps , this one is almost 30 years old and I couldn't live without it

Incremental Numbering Suite Version 4.0 Released. The main feature of the new version is the introduction of a dedicated 'Content Builder' to facilitate the construction of an incrementing string from an arbitrary number of incrementing and/or static components. With this feature, the user now has the ability to independently control the increment amount and increment frequency for each component of the string, enabling multiple sections of the string to increment by different amounts and at different rates to one another. The new version also introduces the ability to load & save application configurations, streamlining the operation of the program for multiple numbering systems.

This reminds me on SCREENMENU (picture 1), but you're solution are better . One old programmer with a lot experience in programming, in AutoCAD, told me about SCREENMENU when I tried to do something. And I forget to mention, I have never done anything with SCREENMENU .

That looks good. Years ago I had FastCAD which had a menu very similar for inserting blocks. My current LISP to try to do similar used DCL and buttons, however a couple of tweaks this could (pretty much) copy what was in FastCAD (it was about the best bit of FastCAD). Example call say 'Doors', your pop-up menu appears and instead of text an image of the block to insert (can make a simplified block using vector graphics, same way as your text). I'll add another line to my to-do list. EDIT. A comment I was going to make last night. You reminded me. The vector letters are handy to keep somewhere - in a DCL for example you can create an image (or image button), using vector letters but add colours to highlight text:

Here is a version that only uses lisp. You will have to download grsnap: https://www.lee-mac.com/grsnap.html It does flicker when I am preventing it from snapping to itself, rest seems to work fine. Keyboard input works a s well. Give it a try: offset.lsp

have done a sort of messenger in the past with (m)text so just wanted to try something else. With vectors a simple redraw and your plate is clean again. I was / am considering adding background but for now wanted to keep it fast & furious due to workload (turning my boss's promises into reality)

Hi I’m attaching the code. But first, a brief explanation of how it works. The function is implemented by calling MiGRTexto with one parameter: the desired height for the real-time texts (this should be a value between 0.5 and 1) Therefore, it can be placed inside a main function that can be called from the command line (e.g., (defun c:myCommand)). As for the code that provides functionality, it's actually very simple: it consists of a text next to the right CROSSHAIR and an MTEXT below it. These must be properly managed so that they dynamically update their size, location and content—it's that straightforward. From there, it’s just a matter of adding code to achieve whatever final functionality the user needs. In the attached code, a small emulator for the "pline" command is implemented, triggered by a LEFT CLICK event. This event calls funcionPrincipal, which is provided with two arguments: the screen point indicated and the entity name (or nil) of the object under the PICKBOX at that location. These two arguments should be enough to enable any subsequent operation. It’s important to note that the entire behavior relies on GRREAD, and therefore on mouse and keyboard events. These events are handled using several clauses within a cond expression, which can be extended or modified by the user. I haven’t implemented any code to add object snap functionality. Doing so would considerably complicate the code, and for some users, it may not be necessary. In any case, suggestions and improvements (regarding snapping or any other proposals) are welcome in this thread—for those (myself included) who may want to improve or add new features. I won’t go on any further. Now, the code... ;******************* p o r d e s í a r g o ******************** ;************************ G L A V C V S ************************* ;************************** F E C I T *************************** (defun MiGRTexto (factor / l se e le txTmp txTmp1 txOk tam p pa pt pt1 i? v1 polil alt tx para erroria errores error0 textoGR1 textoGR2 funcionPrincipal) (defun erroria () (defun errores (mens) (setq *error* error0) (vla-delete txTmp) (vla-delete txTmp1) (redraw) (if e (redraw e 4)) (prin1) ) (setq error0 *error* *error* errores ) ) (defun funcionPrincipal (pt e) (setvar 'LASTPOINT pt) ;;;INICIO(START) EMULAD(T)OR "pline" (if polil (entmod (append (entget polil) (list (cons 10 pt)))) (if (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 8 "0") (cons 90 2) '(70 . 128) '(62 . 256) (cons 10 pa) (cons 10 pt) ) ) (setq polil (entlast)) ) ) (setq pa pt) ;;;FIN(END) EMULAD(T)OR "pline" ) (defun textoGR1 () ;THIS FUNCTION RETURN TEXT STRING TO DISPLAY ABOVE CURSOR. ADJUST IT TO SUIT YOUR NEEDS ;ESTA FUNCIÓN DEVUELVE EL TEXTO A MOSTRAR SOBRE EL CURSOR. MIDIFÍCALA SEGÚN LO NECESITES (rtos (distance (getvar 'LASTPOINT) p) 2 3) ) (defun textoGR2 (lp / lp MT) ;ESTA FUNCIÓN DA EL FORMATO NECESARIO AL MTEXT QUE SE MOSTRARÁ BAJO EL CURSOR (foreach l lp (if MT (setq MT (strcat MT (car l) " {\\fLucida Sans Unicode|b0|i0|c0|p34;\\C4;" (cadr l) "}")) (setq MT (strcat (car l) " {\\fLucida Sans Unicode|b0|i0|c0|p34;\\C4;" (cadr l) "}")) ) (setq MT (if (equal l (last lp)) MT (strcat MT "\\P"))) ) ) (defun dameGRT2 (le / cl to) ;THIS FUNCTION RETURN THE LIST OF PAIRS THAT textoGR2 NEEDS TO FORMAT CONTENTS OF MTEXT. ADJUST IT TO SUIT YOUR NEEDS ;ESTA FUNCIÓN DEVUELVE LA LISTA DE PARES QUE NECESITA textoGR2 PARA GENERAR LA CADENA DE TEXTO QUE NECESITA EL MTEXT (list (list "Object" (setq to (cdr (assoc 0 le)))) (list "Layer" (cdr (assoc 8 le))) (list "Color" (if (setq cl (cdr (assoc 62 le))) (itoa cl) "BYLAYER")) (list "XData?" (if (assoc -3 le) "YES" "NO")) ) ) (erroria) (setq txTmp (vla-AddText (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) "0" (VLAX-3D-POINT '(0 0)) 0.1) txTmp1 (vla-AddMText (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point '(0 0)) 5000 "0") i? T ) (vla-put-color txTmp 1) (vla-put-visible txTmp 0) (vla-put-color txTmp1 2) (vla-put-visible txTmp1 0) (while (and (not para) (setq l (grread nil 13 0))) (setq tam (* (getvar "PICKBOX") (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE"))) 2 factor ) ) (if e (redraw e 4)) (setq e (if (setq se (if (listp (setq p (cadr l))) (nentselp p))) (if (and (not (member (vlax-ename->vla-object (car se)) (list txTmp txTmp1))) (member (cdr (assoc 0 (setq le (entget (car se) '("*"))))) '("LWPOLYLINE" "POLYLINE" "LINE" "SHAPE" "3DFACE" "INSERT" "TEXT" "MTEXT" "ATTRIB") ) ) (car se) ) ) ) (if (and i? e) (vla-put-visible txTmp1 1) (vla-put-visible txTmp1 0)) (prompt (strcat "\rLWPOLYLINE mode: " (if pa "next" "first") " point... (Press \'F10\' for " (if i? "DEACTIVATE" "ACTIVATE") " real-time reporting)")) (cond ((= (car l) 5) (if (not v1) (setq v1 (vla-put-visible txTmp 1) v1 T)) (setq pt (list (+ (car p) (* tam 0.8)) (+ (cadr p) (/ tam 2.2)))) (redraw) (if pa (grvecs (list 7 pa p))); THIS LINE IS PART OF THE "pline" EMULATOR CODE. DISABLE IT IF YOU DONT WANT TO USE THE EMULATOR IMPLEMENTED IN funcionPrincipal ; ESTA LINEA FORMA PARTE DEL EMULADOR "pline". DESACTIVALO SI ELIMINAS EL CÓDIGO EMULADOR IMPLEMENTADO EN funcionPrincipal (vlax-put-property txTmp 'InsertionPoint (vlax-make-variant (vlax-3d-point pt))) (vlax-put txTmp 'Height tam) (vlax-put txTmp 'TextString (textoGR1));<<<-- MODIFICAR ESTA LINEA DE CÓDIGO PARA QUE 'TextString MUESTRE EL TEXTO DESEADO (if (and i? e) (progn (redraw e 3) (setq pt1 (list (car pt) (- (cadr p) (/ tam 2.)))) (vlax-put-property txTmp1 'InsertionPoint (vlax-make-variant (vlax-3d-point pt1))) (vlax-put txTmp1 'Height tam) (vlax-put txTmp1 'TextString (textoGR2 (dameGRT2 le))) ) ) ) ((= (car l) 3) (if pa (funcionPrincipal p (car se)) (setq pa p))); ((= (car l) 25) (setq para T)); BOTON DERECHO = SALIR ((member (cadr l) '(67 99)) (if polil (setq para (entmod (subst (cons 70 1) (assoc 70 (entget polil)) (entget polil)))))); ((= (cadr l) 21) (setq i? (not i?))) ;;; AQUI DEBAJO EL CODIGO PARA GESTIONAR EL RESTO DE OPCIONES ;;; BELOW YOU CAN ADD MORE CLAUSES TO 'cond' TO EXTEND THE CODE FUNCTIONALITY (T ;REST OF CASES: WE DO NOTHING ) ;| .... .... |; ) ) (vla-delete txTmp) (vla-delete txTmp1) (redraw) (if e (redraw e 4)) (princ) )

This returns the serial number of the motherboard. It is more unique than the hard drive's serial number and also more unique than the variant of this same function that uses "Select * from Win32_BaseBoard". (defun obt_UUID (/ LObj SObj OSObj UUID) (setq LObj (vlax-create-object "WbemScripting.SWbemLocator") SObj (vlax-invoke LObj 'ConnectServer nil nil nil nil nil nil nil nil) OSObj (vlax-invoke SObj 'ExecQuery "SELECT UUID FROM Win32_ComputerSystemProduct") ) (vlax-for Obj OSObj (setq UUID (vlax-get Obj 'UUID)) ) (foreach Obj (list LObj SObj OSObj) (and Obj (vlax-release-object Obj)) ) UUID ) This might be a good option if you want your program to continue working when the user changes their hard drive but not their motherboard.

I guess using GRREAD to pick a point in real time and behind the scenes do a search box looking for text and in particular a match say "ABC" in "ABCDEFGH" if yes then zoom in on that text. I am not good at GRREAD code so some one else may be able to help. Search box.part based on a pick point. (setq off 18) ; needs to be changed to suit a dwg. (while (setq pt (getpoint "\nPick point ")) (setq pt1 (polar pt (* 0.25 pi) off)) (setq pt2 (polar pt (* 0.75 pi) off)) (setq pt3(polar pt (* 1.25 pi) off)) (setq pt4 (polar pt (* 1.75 pi) off)) (setq pts (list pt1 pt2 pt3 pt4 pt1)) (setq ss (ssget "CP" pts '((0 . "TEXT")))) (if (= ss nil) (princ "\n nothing found ") (princ (strcat "\n" (cdr (assoc 1 (entget (ssname ss 0)))) " found")) ) )

;| Adapted from an original idea by ElpanovEvgeniy 26.02.2010 https://www.theswamp.org/index.php?topic=30650.msg378483#msg378483 ******************* p o r d e s í a r g o ******************** ************************ G L A V C V S ************************* ************************** F E C I T *************************** |; (defun c:offSetea (/ se e pS c? c?c d dk r r1 pu p0 p1 p2 p3 o pt1 pt2 pt3 px1 px2 pa pb ct-r a42 op lgr bd fe *s* para asr dameCentroRadio erroria errores error0) (defun erroria () (defun errores (mens) (setq *error* error0) (entmod fe) (prin1) ) (setq error0 *error* *error* errores ) ) (defun asr (p1 p2 p3 / a b) (if (> (abs (- (setq a (angle p1 p2)) (setq b (angle p2 p3)))) PI) (if (< a b) (if (> (+ a PI PI) b) - +) (if (> (- a PI PI) b) - +) ) (if (> a b) - +) ) ) (defun dameCentroRadio (pt1 pt2 a42 / d radio h aP th centro) (setq radio (/ (setq d (distance pt1 pt2)) (* 2 (sin (/ (setq th (* 4 (atan a42))) 2)))) ; Radio del arco h ((if (> (abs th) PI) - +) (sqrt (- (* radio radio) (* (/ d 2) (/ d 2))))); Distancia del centro al punto medio aP (+ (angle pt1 pt2) (* (/ pi 2) (if (> a42 0) 1 -1))) ; Ángulo perpendicular centro (list (+ (/ (+ (car pt1) (car pt2)) 2) (* h (cos aP))) (+ (/ (+ (cadr pt1) (cadr pt2)) 2) (* h (sin aP)))) ) (list centro radio) ; Devuelve centro y radio ) (erroria) (if (setq se (entsel "\nSelect LWPOLYLINE...")) (if (= (cdr (assoc 0 (entget (setq e (car se))))) "LWPOLYLINE") (progn (setq c? (= (vla-get-closed (setq o (vlax-ename->vla-object (setq e (car se))))) :vlax-true) c?c (equal (vlax-curve-getPointAtParam o (vlax-curve-getStartParam o)) (vlax-curve-getPointAtParam o (setq pu (vlax-curve-getEndParam o))) 1e-6) p1 (fix (vlax-curve-getParamAtPoint o (vlax-curve-getClosestPointTo o (setq pS (cadr se))))) p2 (if (= p1 (1- pu)) (if c? 0 (1+ p1)) (1+ p1)) p0 (if (zerop p1) (if c? (1- pu)) (1- p1)) p3 (if (= p2 pu) (if (or c? c?c) 1) (1+ p2)) pt1 (vlax-curve-getPointAtParam o p1) pt2 (vlax-curve-getPointAtParam o p2) r (vlax-curve-getPointAtParam e (vlax-curve-getParamAtPoint o (vlax-curve-getClosestPointTo o pS))) pt0 (if p0 (vlax-curve-getPointAtParam o p0) (polar pt1 (+ (angle pt1 pt2) (/ PI 2.)) 100)) pt3 (if p3 (vlax-curve-getPointAtParam o p3) (polar pt2 (+ (angle pt1 pt2) (/ PI 2.)) 100)) a42 (cdr (assoc 42 (member (list 10 (car pt1) (cadr pt1)) (setq fe (entget e))))) ) (while (and (not para) (setq lgr (grread nil 13 0))) (if (or (member (cadr lgr) '(107 75)) (= (car lgr) 25) (not (listp (cadr lgr)))) (if (= (car lgr) 25) (setq para (entmod fe) bd T) (if (member (cadr lgr) '(107 75)) (setq *s* (not *s*)) ) ) (if (zerop a42) (setq d (distance (setq r1 (if *s* (progn (entmod fe) (setq para T dk (getreal "\nType the OFFSET distance (ENTER or RIGHT CLICK to indicate point on screen): ")) (getpoint r (if dk "\nSide to act on... " "\nPick a point on the screen... ")) ) (progn (prompt (strcat "\r " (if d (rtos d 2 3) "0.0") "...Press \'k\' to activate keyboard input...")) (cond ((= (car lgr) 5) (cadr lgr)) ((= (car lgr) 3) (setq para T) (cadr lgr)) ) ) ) ) (setq r (inters pt1 pt2 (polar r1 (setq a (+ (angle pt1 pt2) (/ PI 2.))) 3) (polar r1 (+ a PI) 3) nil)) ) px1 (inters pt0 pt1 (setq pa (polar pt1 (setq a ((asr pt1 r r1) (angle pt1 pt2) (/ pi 2.0))) (if dk dk d))) (setq pb (polar pt2 a (if dk dk d))) nil) px2 (inters pt2 pt3 pa pb nil) ) (setq ct-r (dameCentroRadio pt1 pt2 a42) d (- (distance (if *s* (progn (entmod fe) (setq para T dk (getreal "\nType the OFFSET distance (ENTER or RIGHT CLICK to indicate point on screen): ")) (getpoint r (if dk "\nSide to act on... " "\nPick a point on the screen... ")) ) (progn (prompt (strcat "\r " (if d (rtos (abs d) 2 3) "0.0") "...Press \'k\' to activate keyboard input...")) (cond ((= (car lgr) 5) (cadr lgr)) ((= (car lgr) 3) (setq para T) (cadr lgr)) ) ) ) (setq c (car ct-r)) ) (abs (cadr ct-r)) ) px1 (polar pt1 (angle (if (minusp d) pt1 c) (if (minusp d) c pt1)) (abs (if dk dk d))) px2 (polar pt2 (angle (if (minusp d) pt2 c) (if (minusp d) c pt2)) (abs (if dk dk d))) ) ) ) (if (not bd) (foreach l (list (list p1 (list (car px1) (cadr px1))) (list p2 (list (car px2) (cadr px2)))) (vla-put-coordinate o (car l) (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray 5 '(0 . 1)) (cadr l)))) ) ) ) ) (alert "No LWPOLYLINE selected") ) (alert "NOTHING selected") ) (princ) ) One last small improvement that displays the cursor offset in real time (command line) during the first phase of the command. A very useful little feature, I think.

This weekend I spent some time alone with CrazyHorseSubTangentsArc. I want to share some snapshots of this memorable encounter. Beautiful! But I guess I should be able to show some even better images soon.

i'm also not a fan of ribbon. don't really use buttons either. i use the command line for pretty much everything. ribbon uses too much space and have always found it unnecessary. having it closed ensures i've got maximised screen space for my drawings

You asked in the AutoLISP, Visual LISP & DCL Forum, something like what @mhupp posted is the best solution with FREE LISP, IMO. You need to look at asking this in some .NET forums, though not sure the FREE will happen.

You can use a similar technique to display arbitrary bitmaps in a DCL or at the cursor Interesting ideas rlx

Nice, I can see uses for this. Might add a slight change one day if it works to draw a wipeout under the 'buttons'?

Have you considered replacing grvecs with temporary 'TEXT' objects? It's easier to do this with dynamically sized and positioned text. This makes it easier to create effects such as mouse-over highlighting. @mhupp "It's never too late to return to the old places where you loved life"

Oh , you're not lisping anymore? pitty... you belong to the top lispy's

I think this thread is becoming interesting again. I suppose there will be some updates in the near future — I believe @Dexus has opened the door to some much-needed improvements. As for me, I take up the gauntlet. But I believe the basic rule should be not to rely on third-party libraries/APIs (except those inherent to Windows and AutoCAD).

I use the technique frequently to achieve list box columns - for example, as used by the Content Builder dialog displayed by my Incremental Numbering Suite.

Use the DCL tabs attribute and prefix the list items with a tab character ("\t").

I incorporated nanoflann( https://github.com/jlblancoc/nanoflann) wrappers into PyRx. Although other efficient KD-Tree implementations exist in Python, such as pykdtree, the wrapper is specifically designed for AcGePoint2d/AcGePoint3d, eliminating the need for type conversions. How can these structures be beneficial in CAD? in this example, we search for a phone within a certain radius of each computer. Additionally, we can identify computers that do not have phones. We could also do something like, search all MTexts on the Layer "Employee" to determine whether they are near a chair, phone, or computer. import traceback from pyrx import Ap, Ax, Db, Ed, Ge, Gi, command # radiusSearch @command def doit(): db = Db.curDb() phones, computers = getBlocks(db) result = [] # create the tree of phone locations phonePoints = Ge.Point3dArray() for phone in phones: phonePoints.append(phone[1]) phoneTree = Ge.Point3dTree(phonePoints) # search for nerby phones for computer in computers: idxs, _ = phoneTree.radiusSearch(computer[1], 50 * 50)# sqrd if len(idxs) == 0: print("no phone") continue for idx in idxs: result.append((computer, phones[idx])) for cpu, phn in result: Ed.Core.grDraw(cpu[1], phn[1], 2, 0) # helper, store the id and position def getBlocks(db: Db.Database): phones = [] computers = [] model = Db.BlockTableRecord(db.modelSpaceId()) refs = [Db.BlockReference(id) for id in model.objectIds(Db.BlockReference.desc())] for ref in refs: if ref.getBlockName() == "COMPUTER": computers.append((ref.objectId(), ref.position())) elif ref.getBlockName() == "FNPHONE": phones.append((ref.objectId(), ref.position())) return phones, computers

In lisp there is a function AUTOLOAD that does just that loads a lisp based on a command typed on the command line. So you just need a single lisp that has all the autoload commands in it. That custom lisp is loaded on startup in my case its Appload and add to Startup suite. I called my lisp "Autoload.lsp" Here is sample code. You may need to add the start defun name (c:Yourlisp) as last line in the lisp that is loaded, as the load command can be anything and not necessarily the command to run it. eg ZZZ (autoload "COPY0" '("COPY0")) (autoload "COPYCOMMAND" '("ZZZ")) (autoload "COVER" '("COVER")) (autoload "DIMFLIP" '("DIMFLIP")) (autoload "DRAWXFALL" '("DRAWXFALL")) (autoload "DRAWPIPE" '("DRAWPIPE")) (autoload "EDITRL" '("EDITRL"))

Hi Like @Stevenp, I can't verify exactly what this is about either: I'm not in front of a PC. But it looks like the last SPoint is 'nil' because '(+ Counter ForwardVisDistance)' is a number greater than the length of 'selPline'. There are a few lines of code that are unnecessary, but they don't prevent your routine from working, so just try changing (while (< Counter SelPline_Length) to (while (and (setq EPoint (vlax-curve-getPointAtDist SelPline (+ Counter ForwardVisDistance))) (setq SPoint (vlax-curve-getPointAtDist SelPline Counter))) It looks like you used AI to do this, but you should still be able to remove the excess code after making these changes.

Hi Indeed, any process started from AutoCAD will inherit its privilege level. For example, if AutoCAD opens an instance of Word, that instance will inherit the same privilege level as AutoCAD. However, if a Word instance is already running and AutoCAD starts controlling it, its privilege level might be different. In that case, it might be necessary to check it in order to warn the user. Could your issue be something similar to that? As @mhupp says, there is no direct way to determine this from VLisp. But there are some tricks to achieve it: For example: (defun acadAdmin? (/ arch r ruta ruta1 f sh) (if (findfile (setq ruta1 (strcat (getenv "TEMP") "\\acAdmin.si"))) (vl-file-delete ruta1) ) (if (setq arch (open (setq ruta (strcat (getenv "TEMP") "\\ea.bat")) "w")) (progn (write-line "@echo off net session >nul 2>&1 if %errorlevel% == 0 ( echo SI> \"%temp%\\acAdmin.si\" )" arch ) (close arch) (setq sh (vlax-create-object "WScript.Shell")) (vlax-invoke sh 'Run ruta 0 :vlax-true) (vlax-release-object sh) (vl-file-delete ruta) (if (setq r (findfile ruta1)) (progn (vl-file-delete ruta1) T ) ) ) ) ) This simply writes a .bat that when executed, creates the file "acAdmin.si" only if AutoCAD is running as admin

LT does support ActiveX/COM, but cannot interface with objects outside of the AutoCAD Object Model.

@NanGlase To further assess the possibilities of the "license server" option in real time from AutoCAD, the following needs to be considered: At the code level, you must: Check that both the client PC and your own have the same communication port available, and if not, handle this somehow. Also ensure that the firewall will not block the ports on either the client or the server side. At the infrastructure level, you must: Have a static IP or a domain name on the server side so that your code, when executed by the client, knows where to send the request. In my opinion, although this is an interesting challenge, you should assess whether the effort and investment required are justified by the benefits you may gain. I believe that, considering all of this, the most reasonable options might be those proposed by @Steven P and @BIGAL.

Hi everyone, Semi-long time listener, first time caller. I wanted to say thanks for the help and tips I got from this site over the past 6 months. As I have been working on two autolisps, one called P0 the other P9. The do the same thing, kinda. P0 will pull the dwgname field and save it to the clipboard, allowing me to use it wherever without have to flip to the folders . . pick the file . . . hit F2 . . CTRL+C . . . then go back. P9 does the same thing, but adds dwgprefix + dwgname. I work in a third-party firm that uses several client projects with their different CAD standards. Some forbid using fields in the titleblocks for various reasons and like them hard coded. P9 is useful for when I'm jumping between sub-folders and need to plot to source folders. I can't use the PDFExport feature, as different clients use different standards and I need to make sure everything is good before going for each plot, mostly for peace of mind. I wanted to share these with you guys as a thank you and giving back to the community. My autolisps learning is only about 4 - 5 months old. FYI, I didn't know till literally a few days ago, from this very site, that one can right click the tab for the copy full path. lol P9.lsp P0.lsp

A lisp version hope fully works in LT. Change the xxx and path etc. (setq *files* (vla-get-files (vla-get-preferences (vlax-get-Acad-object)))) (setq paths (vla-get-SupportPath *files*)) (if (wcmatch paths "*XXX*") (princ) (vla-put-SupportPath *files* (strcat "C:\\XXX-CAD-TOOLS" ";" paths)) ) Copy the 1st two lines to the command line as a test in LT. You should see a list of your support paths C:\\Users\\XXXX\\AppData\\Roaming\\Bricsys\\BricsCAD\\V25x64\\en_US\\Support;D:\\Bricsys\\BricsCAD V24 en_US\\Support; Oh yeah if using Autocad need to add trusted paths, Trusted paths is a bit of why ? As you can set the paths so why have it. (if (> (vl-string-search "BricsCAD" (getvar 'acadver)) 0) (princ "Bricscad") (progn (setq oldtrust (getvar 'trustedpaths)) (if (wcmatch oldtrust "*XXX*") (princ) (setvar 'trustedpaths (strcat oldtrust ";" "c:\\XXX-CAD-TOOLS")) ) ) )

Forgive the Python, only trying to illustrate one possibility. This code creates a spatial filter for a block reference, to simulate a detail. In the image, I created a block of the room, with two references. One has a spatial filter applied and is scaled. You can do the same in lisp, or by hand, make a copy of the block, run the xclip command, draw your polyline perimeter, set XCLIPFRAME to 1 so you can see your frame. instead of a circle, use a polygon with a shape to your liking. My code still needs work as my transformby is wonky(not centered correctly) and I hand drew the leader line lol import traceback from pyrx import Rx, Ge, Gi, Db, Ap, Ed ACDB_INFINITE_XCLIP_DEPTH = 1.0e300 def addFilter_getmat(refid, filter): ref = Db.BlockReference(refid, Db.OpenMode.kForWrite) Db.IndexFilterManager.addFilter(ref, filter) return ref.blockTransform() @Ap.Command() def doit(): try: db = Db.curDb() _ps, refid, _ = Ed.Editor.entSel("\nSelect ", Db.BlockReference.desc()) _ps, cen = Ed.Editor.getPoint("\nGet center: ") _ps, rad = Ed.Editor.getDist(cen, "\nGet radius: ") carc = Ge.CircArc3d(cen, Ge.Vector3d.kZAxis, rad) pts3d, _params = carc.getSamplePoints(20) filter = Db.SpatialFilter() mat = addFilter_getmat(refid, filter) pts2d = [] for pt in pts3d: pt.transformBy(mat) pts2d.append(Ge.Point2d(pt.x, pt.y)) filter.setDefinition( pts2d, Ge.Vector3d.kZAxis, db.elevation(), ACDB_INFINITE_XCLIP_DEPTH, -ACDB_INFINITE_XCLIP_DEPTH, True, ) except Exception as err: print(err)

pretty slick! you made a Jig in lisp

Easy enough to solve. The easiest way is to just use a viewport in a layout, but you can lead a horse to water...

Not lisp, One approach would be to use a point monitor https://www.cadtutor.net/forum/topic/98349-use-a-point-monitor-to-add-items-to-the-hover-tooltip/ A draw jig might be also work depending on the context.

[Advanced] Use a point monitor to add items to the hover tooltip import traceback from pyrx import Rx, Ge, Gi, Db, Ap, Ed print("added command pymon") print("added command pyunmon") # Adds the monitors to the application def OnPyInitApp(): PyRxCmd_pymon() def OnPyUnloadApp(): PyRxCmd_pyunmon() # https://help.autodesk.com/view/OARX/2025/ENU/?guid=GUID-BBDA79D3-A509-4C96-966E-72592BD32ACD class MyPointMonitor(Ed.InputPointMonitor): def __init__(self): Ed.InputPointMonitor.__init__(self) def monitorInputPoint(self, input: Ed.InputPoint, output: Ed.InputPointMonitorResult): try: ents = input.pickedEntities() geo: Gi.Geometry = input.drawContext().geometry() if len(ents) == 0: geo.text(input.rawPoint(), Ge.Vector3d.kZAxis, Ge.Vector3d.kXAxis, 10.0, 1.0, 0, "Cold") output.setAdditionalTooltipString("COLD") else: geo.text(input.rawPoint(), Ge.Vector3d.kZAxis, Ge.Vector3d.kXAxis, 10.0, 1.0, 0, "Hot") output.setAdditionalTooltipString("HOT") except Exception as err: print(err) # global space pm = MyPointMonitor() def PyRxCmd_pymon(): try: manager = Ap.curDoc().inputPointManager() manager.addPointMonitor(pm) except Exception as err: print(err) def PyRxCmd_pyunmon(): try: manager = Ap.curDoc().inputPointManager() manager.removePointMonitor(pm) except Exception as err: print(err) Screen Recording 2025-06-20 102115.mp4

This might be a starting point https://www.lee-mac.com/grtext.html combine BIGAL and demo one?

*s* remains for the future as a small device abandoned on the moon that, perhaps one day, will be used by the next visitor.

Hi @pkenewell I don’t use tangents. For straight segments, the geometry progresses or retreats based on the angular direction of the lateral segments of the selected one. For arc segments, in order to “link” them, progression and retreat are done based on the radius. The variable *s* is currently single-use if passed to the second part of the command, outside of GRREAD. The code is like a living being: it’s born with the idea of following a path, and along the way, it chooses a different route. So *s* was implemented with the intention of providing a complete solution within GRREAD, and along the way, the current solution was chosen instead.

Maybe something like this will help you: .................... (setq ename (car (entsel)) edata (entget ename '("*")) data (cdr (assoc -3 edata)) ) (foreach memb data (setq nlst (cons -3 (list (cons (car memb) nil)))) (setq ndata (subst nlst (assoc -3 edata) edata)) (entmod ndata) ) ....................

"scale of 100 for a table in the code?" work out the correct scale value and just adjust the table. You know the default size of say text height and can work out what you want as text height at 1:100.

@Steven P went around in circles but false/true is only half of answer this helped ; UnmergeCells minRow, maxRow, minCol, maxCol (vla-unMergeCells table 0 0 0 1) Even though no Title it was still merged cells.

Maybe 'vla-transformBy'?

The code I talked about makes a new table style in any dwg, so I put it at the start of any of my make a table solution. The code checks does the style exist if not then make it. You don't need to scale the table just set all the parameters correctly and the table will be made at the size you want. Again post a proper dwg with a table at the size you want, you just look at row height, column widths, text height being the 3 main things to change in an existing table.

Like @Steven P you can make a table using say the "Standard" table and reset all the correct style values for the table. Columnwidth, row height, text size, text alignment. When you make a table it just sets all column widths to one size so that is an obvious reset. For any of us to help set the table to look like your image need a dwg with that table set up to how you want it, the correct size, then can work backwards getting all the required values to put into say a Lisp. One of the lisps I have is make a new table style and make it current. I have posted code here but sorry can not remember which post.

Not so sure, I am assuming you mean the size of the table and not for example '1000' becoming '1' in your example. Suspect you might need to create a table style with the settings you want - text sizes, line types, colours and so on, probably also add in the header row / merge cells of BigAls answer in table style too

Hi ElpanovEvgeniy's idea was inspiring to me, and I decided to adapt it, in my own way, to make it a little more manageable and useful. I hope so. Of course, it's open to improvement, but I think that should be left to individual work. PS: I ask the moderators to modify what they deem necessary in the code references to Elpanov and TheSwamp SLW_Offset.mp4 ;| Adapted from an original idea by ElpanovEvgeniy 26.02.2010 https://www.theswamp.org/index.php?topic=30650.msg378483#msg378483 ******************* p o r d e s í a r g o ******************** ************************ G L A V C V S ************************* ************************** F E C I T *************************** |; (defun c:offSetea (/ se e pS c? c?c r r1 pu p0 p1 p2 p3 o pt1 pt2 pt3 px1 px2 pa pb ct-r a42 op lgr bd fe *s* para asr dameCentroRadio erroria errores error0) (defun erroria () (defun errores (mens) (setq *error* error0) (entmod fe) (prin1) ) (setq error0 *error* *error* errores ) ) (defun asr (p1 p2 p3 / a b) (if (> (abs (- (setq a (angle p1 p2)) (setq b (angle p2 p3)))) PI) (if (< a b) (if (> (+ a PI PI) b) - +) (if (> (- a PI PI) b) - +) ) (if (> a b) - +) ) ) (defun dameCentroRadio (pt1 pt2 a42 / d radio h aP th centro) (setq radio (/ (setq d (distance pt1 pt2)) (* 2 (sin (/ (setq th (* 4 (atan a42))) 2)))) ; Radio del arco h ((if (> (abs th) PI) - +) (sqrt (- (* radio radio) (* (/ d 2) (/ d 2))))); Distancia del centro al punto medio aP (+ (angle pt1 pt2) (* (/ pi 2) (if (> a42 0) 1 -1))) ; Ángulo perpendicular centro (list (+ (/ (+ (car pt1) (car pt2)) 2) (* h (cos aP))) (+ (/ (+ (cadr pt1) (cadr pt2)) 2) (* h (sin aP)))) ) (list centro radio) ; Devuelve centro y radio ) (erroria) (if (setq se (entsel "\nSelect LWPOLYLINE...")) (if (= (cdr (assoc 0 (entget (setq e (car se))))) "LWPOLYLINE") (progn (setq c? (= (vla-get-closed (setq o (vlax-ename->vla-object (setq e (car se))))) :vlax-true) c?c (equal (vlax-curve-getPointAtParam o (vlax-curve-getStartParam o)) (vlax-curve-getPointAtParam o (setq pu (vlax-curve-getEndParam o))) 1e-6) p1 (fix (vlax-curve-getParamAtPoint o (vlax-curve-getClosestPointTo o (setq pS (cadr se))))) p2 (if (= p1 (1- pu)) (if c? 0 (1+ p1)) (1+ p1)) p0 (if (zerop p1) (if c? (1- pu)) (1- p1)) p3 (if (= p2 pu) (if (or c? c?c) 1) (1+ p2)) pt1 (vlax-curve-getPointAtParam o p1) pt2 (vlax-curve-getPointAtParam o p2) r (vlax-curve-getPointAtParam e (vlax-curve-getParamAtPoint o (vlax-curve-getClosestPointTo o pS))) pt0 (if p0 (vlax-curve-getPointAtParam o p0) (polar pt1 (+ (angle pt1 pt2) (/ PI 2.)) 100)) pt3 (if p3 (vlax-curve-getPointAtParam o p3) (polar pt2 (+ (angle pt1 pt2) (/ PI 2.)) 100)) a42 (cdr (assoc 42 (member (list 10 (car pt1) (cadr pt1)) (setq fe (entget e))))) ) (while (and (not para) (setq lgr (grread nil 13 0))) (if (or (member (cadr lgr) '(107 75)) (= (car lgr) 25)) (if (= (car lgr) 25) (setq para (entmod fe) bd T) (setq *s* (not *s*)) ) (if (zerop a42) (setq d (distance (setq r1 (if *s* (progn (entmod fe) (setq para T) (getpoint r "\nPoint to move to...") ) (progn (prompt "\rPress \'k\' to activate keyboard input...") (cond ((= (car lgr) 5) (cadr lgr)) ((= (car lgr) 3) (setq para T) (cadr lgr)) ) ) ) ) (setq r (inters pt1 pt2 (polar r1 (setq a (+ (angle pt1 pt2) (/ PI 2.))) 3) (polar r1 (+ a PI) 3) nil)) ) px1 (inters pt0 pt1 (setq pa (polar pt1 (setq a ((asr pt1 r r1) (angle pt1 pt2) (/ pi 2.0))) d)) (setq pb (polar pt2 a d)) nil) px2 (inters pt2 pt3 pa pb nil) ) ;;; SI LA DIFERENCIA ENTRE EL ANGULO r-r1 Y PT1-PT0 O PT2-PT3 ES MAYOR QUE 1/2PI ENTONCES HAY QUE SUMARLE PI AL ANGULO DE REFERENCIA (setq ct-r (dameCentroRadio pt1 pt2 a42) d (- (distance (if *s* (progn (entmod fe) (setq para T) (getpoint r "\nPoint to move to...") ) (progn (prompt "\rPress \'k\' to activate keyboard input...") (cond ((= (car lgr) 5) (cadr lgr)) ((= (car lgr) 3) (setq para T) (cadr lgr)) ) ) ) (setq c (car ct-r)) ) (abs (cadr ct-r)) ) px1 (polar pt1 (angle (if (minusp d) pt1 c) (if (minusp d) c pt1)) (abs d)) px2 (polar pt2 (angle (if (minusp d) pt2 c) (if (minusp d) c pt2)) (abs d)) ) ) ) (if (not bd) (foreach l (list (list p1 (list (car px1) (cadr px1))) (list p2 (list (car px2) (cadr px2)))) (vla-put-coordinate o (car l) (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray 5 '(0 . 1)) (cadr l)))) ) ) ) ) (alert "No LWPOLYLINE selected") ) (alert "NOTHING selected") ) (princ) )

You could add it to a reactor so when you type save or close it will run. (cond ((= (vlr-current-reaction-name) ':VLR-beginSave) (Princ "\nThis function has been triggered by a Document Save event.")) ((= (vlr-current-reaction-name) ':VLR-beginClose)(princ "\nThis function has been triggered by a Document Close event.")) ) (princ) ) (if (not _BeginCloseReactor) (setq _BeginCloseReactor (VLR-Dwg-Reactor nil '((:VLR-beginClose . BeginCloseFunc))))) (if (not _BeginSaveReactor ) (setq _BeginSaveReactor (VLR-Dwg-Reactor nil '((:VLR-beginSave . BeginCloseFunc))))) I think this will work (defun BeginCloseFunc (reactor lst / ) (c:ZE_Z9X) ) Not sure may need, if lisp not autoloaded which I would suggest. (if (not ZE_Z9XP) (progn (load "ZE_Z9XP") (command "ZE_Z9XP") ) )

@Emmanuel Delay was working same thing. Almost finished just had to add text. for me I use this for mid point of a 4 side pline. (setq mp (mapcar '* (mapcar '+ pt1 pt3) '(0.5 0.5))) No Table of result ? That is what I did first. You can use this if you want. (setvar 'ctablestyle "standard") (Setq curspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))) (setq pt1 (vlax-3d-point (getpoint "\nPick point for top left hand of table: "))) (setq numrows 3) (setq numcolumns 2) (setq rowheight 530) (setq colwidth 1600) (setq objtable (vla-addtable curspace pt1 numrows numcolumns rowheight colwidth)) (vla-settext objtable 0 0 "Totals") (vla-settext objtable 1 0 "Width") (vla-Setrowheight Objtable 1 940) (vla-settext objtable 1 1 "SOM\nLength") (vla-SetTextStyle custObj (+ acDataRow acHeaderRow acTitleRow) "Standard") (setq objtable (vlax-ename->vla-object (entlast))) (vla-SetAlignment objtable (+ acDataRow acHeaderRow acTitleRow) acMiddleCenter) (vla-SetTextHeight objtable (+ acDataRow acHeaderRow acTitleRow) 250) maybe later today have to go now.

Either of these any help (vla-put-TitleSuppressed table :vlax-false) (vla-put-HeaderSuppressed table :vlax-false)