Leaderboard

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

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)

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

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

Thank you . I have set things running on another pc, I was hoping to save some time . interesting to learn about core console though .

It's called purchasing the previously posted Drawing Tree | AutoCAD | Autodesk App Store. It has a free trial. Other than that, just need to ask around and see if someone will make you something for free. What permissions do you have for installing software?

Hello Slw i test your lisp today and works !!! seem all ok. thanks a lot!

agree , ribbons itself are nice & pretty and so , but half of it I have never used in my life nor will I so the classic menu will do nicely thank you , easy to change , clean and simple. So every new AutoCad version : ribbon off , menuload , rlxmenu... done.

I moved your thread to the .NET, ObjectARX & VBA Forum in case some one feels like making a program for FREE.

You might want to check out OpenDCL, it has pallets, block preview … all the tools you would need create a block + group manager

You want to create a GUI? There’s a sample in python creating a palette with block names and preview https://github.com/CEXT-Dan/PyRx?tab=readme-ov-file#features you’d have to roll it yourself. There’s also opendcl if you feel more comfortable with lisp

Monday i Will test It and i tell you .thanks a lot

Great thank you . i am planning to add into the startup folder and give a go but got distracted today .

No worries, I get that we have other usages, for my work changing the position of the arc segment without changing the tangentcy is important. If it doesn't keep that I'll have to fix it afterwards every time. I updated the code in the previous post to be a little bit less gittery, but I understand that not everyone will sacrifice smoothness to have snap enabled. Therefore here is a version without snap. So the only difference with the one from Evgeny's is that you are able to type in an offset distance as well as select an (inexact) point. offset - nosnap.lsp

I'll try to find time in the coming days to modify and expand offsetea. I've found a couple of bugs in it, likely due to the lack of stress testing. Also, I'll try to find a way to rein in those arcs governed by tangents. I might include a few more improvements as well. But I'll leave that as a surprise.

Thank you @Danielm103 for the information, next time, I will try to play with this (because I'm also occuring with this problem, not always, but it happens). Also, there is LAYOUTREGENCTL (System Variable), same thing which can be found in Option -> System.

This was recently discussed in PyRx, How to batch create layouts? https://github.com/CEXT-Dan/PyRx/discussions/368 Each time you create a layout, AutoCAD will cache the graphics of the viewports, consuming large amounts of memory and slowing the process, you can try to turn off the cache as explained here https://github.com/CEXT-Dan/PyRx/discussions/368#discussioncomment-13604115 But… it is what it is, layouts are a resource hog

I should have read the code by PGia closer (setq Access (vl-catch-all-apply 'vlax-create-object '("Access.Application"))) Instead use (setq Access (vl-catch-all-apply 'vlax-get-or-create-object '("Access.Application"))) The get or create means if it is open then make application, if it is not open it will open Access. I have never had a problem opening Word or Excel with lisp. Same with are they open already. @PGia its your turn to respond, The code should work.

Interesting for sure!

Amazing and original. I find it interesting to see how you’ve solved the character's drawing using polar coordinates. I also did something similar when I was thinking about drawing text next to the cursor in real time. I even created tools to encode characters from drawing polylines. But I gave up on the idea because there are simpler options. However, your approach is a different one — something I had never considered. It’s an interesting idea that opens the door to imagining new possibilities

The biggest advantage to LISP solution is usability, very few people are allowed to load programs on their work computers, but most can download and run a LISP. @GLAVCVS latest works fine for me as of now. Right now I'm just getting a few things done for after I retire to help those behind me do things easier. I might just do a whole new take on a solution to this issue and have the user input the new diameters/radii, lengths, etc. and redraw it.

Everything can be improved But, IMO, there are two fundamental aspects in which Lisp code has a clear advantage over others: self-sufficiency and versatility. Self-sufficiency: because the code is able to resolve by itself (using the two platforms it has available—Windows and AutoCAD) all the needs it may encounter to solve a problem. Versatility: a *.lsp file is much more versatile and adaptable across versions (for obvious reasons) than a *.arx file. @dexus Therefore, if you write something entirely in Lisp that solves whatever you consider important, I will also applaud your code. (P.S.: Sometimes the .arx file that’s supposed to be valid for a certain version of AutoCAD doesn’t work—as you can see in the image.) I believe AutoCAD has made it this far not because its applications are particularly fast or slow, but because it gives the user a great deal of freedom in handling drawing objects. Someone said in another thread on this forum that AutoCAD will eventually stop supporting Visual Lisp. The day that happens, I know many who will stop using AutoCAD and stick with whatever software best inherits its strengths. And I will be one of them.

I added a gray helper line so you can see how it edits curved segments. Maybe that makes it clearer what is happening and therefore more predictable. For me @GLAVCVS code is not as usefull since it doesn't keep tangent lines tangent when changing curves. It does work quite nicely on straight segments though.

Probably, the answer to your question has already been answered. Try reading all the messages in this thread.

Not sure if this will make any difference, this is a stripped down version of my PDF plotting, - check it works first with a standard PDF plot maybe? then change to what you want. I have a little function for each pdf setting - below they are just values but would be things like client specific stuff, company styles and so on, then these are set to variables which is what most of this is. Look through for 'Change this bit here' as what to change for your PDFs. Note that there are 2 PDF plotters set, I use one to do a plot preview and one that doesn't - you'll need to change both to your Foxit plotter. Anyway, if this works for you it is a basis to do all the other stuff that you might want - just go to each sub function to adjust as you need. (defun c:pdfplot ( / ) ;; NOTE: Variables not set ;; Sub functions (defun PDFgetdetailedplotconfiguration ( / dpc) (setq dpc "Yes") dpc) (defun PDFgetlayoutname ( / lname) (setq lname (getvar "ctab")) lname ) ;;;;;;;;;;;;;;;;;;;;;; ;;Change this bit here (defun PC3Name ( / ) "DWG to PDF.pc3" ) ; plotter setting with preview ;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;; ;;Change this bit here (defun PC3NameNP ( / ) "DWG to PDF no Preview.pc3" ) ; No preview plotter setting ;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;; ;;Change this bit here (defun PDFgetpapersize ( / ) (setq papersize "ISO expand A0 (841.00 x 1189.00 MM)") ) ;;;;;;;;;;;;;;;;;;;;;; (defun PDFgetpaperunits ( / pu) (setq pu "") pu) (defun PDFGetPageOrientation ( / ) (setq pageorientation "L") pageorientation) (defun PDFgetorientation ( / orientation) (setq orientation "landscape") orientation) (defun PDFgetplotupsidedown ( / plud) (setq plud "N") plud) (defun PDFgetplotarea ( / pla) (setq pla "Extents") pla) ;;Extents, Display, Limits, View (defun PDFgetplotscale ( / pls) (setq pls "Fit") pls) (defun PDFgetplotoffset ( / plo) (setq plo "Center") plo) (defun PDFgetplotwithplotstyles ( / plwpls) (setq plwpls "Y") plwpls) ;;;;;;;;;;;;;;;;;;;;;; ;;Change this bit here (defun PDFgetplotstyletablename ( / plstname) (setq plstname "acad.ctb") plstname) ;;;;;;;;;;;;;;;;;;;;;; (defun PDFgetplotwithlineweights ( / plwlw) (setq plwlw "Y") plwlw) (defun PDFgetshadeplotsetting ( / spls) (setq spls "As Displayed") spls ) (defun PDFgetfullpath ( / fp) (if (= (getvar 'dwgtitled) 1)(setq fp (getvar "dwgprefix"))) ;;drawing saved (if (= (getvar 'dwgtitled) 0)(setq fp (strcat (PDFgetDesktop) "\\"))) ;;drawing not saved fp ) (defun PDFgetDesktop ( / script spFolders desktop) ;;gets the location of the desktop (cond ( (setq script (vlax-create-object "WScript.Shell")) (setq spFolders (vlax-get-property script "SpecialFolders") desktop (vlax-invoke-method spFolders 'Item "Desktop") ) (vlax-release-object spFolders) (vlax-release-object script) )) desktop ) (defun PDFgetfilename ( / myfnloc myfn myf) ;; check in here if PDF file to write to is open (setq myfnloc (PDFgetfullpath)) (setq myfn (vl-filename-base (getvar 'dwgname))) (setq myf (strcat myfnloc myfn ".pdf")) myfn ) (defun PDFgetsaveplotsettings ( / savepls) (setq savepls "N") savepls ) (defun PDFgetproceedwithplot ( / pwpl) (setq pwpl "Y") pwpl ) (defun PDFgetplottername ( pdfpreview / pname) ;;;;pname this needs to be set up in pagesetup settings ;;;; ;;;;;;;;;;;;;;;;;;;;;; ;;Change this bit here (setq pname "DWG to PDF.pc3") ;;Default DWG to PDF plotter ;;;;;;;;;;;;;;;;;;;;;; (if (findfile (setq PC3FilePath (strcat (PC3Loc) "\\" (PC3Name))) ) (setq pname (PC3Name)) );;end if (if (= pdfpreview "N") ;; plotter setting with no preview (if (findfile (setq PC3FilePath (strcat (PC3Loc) "\\" (PC3NameNP))) ) (setq pname (PC3NameNP)) );;end if );;end if pname ) ;;End of sub functions (setq detailedplotconfiguration (PDFgetdetailedplotconfiguration)) (setq layoutname (PDFgetlayoutname)) (setq pdfpreview "N") (setq plottername (PDFgetplottername pdfpreview)) (setq papersize (PDFgetpapersize)) ;;drawing paper size...not plotting size if different (setq paperunits (PDFgetpaperunits)) (setq orientation (PDFgetorientation)) (setq plotupsidedown (PDFgetplotupsidedown)) (setq plotarea (PDFgetplotarea)) (setq plotscale (PDFgetplotscale)) (setq plotoffset (PDFgetplotoffset)) (setq plotwithplotstyles (PDFgetplotwithplotstyles)) (setq plotstyletablename (PDFgetplotstyletablename)) (setq plotwithlineweights (PDFgetplotwithlineweights)) (setq shadeplotsetting (PDFgetshadeplotsetting)) (setq fullpath (PDFgetfullpath)) (setq myfilename (PDFgetfilename)) (setq filepathname (strcat fullpath myfilename ".pdf")) (setq saveplotsettings (PDFgetsaveplotsettings)) (setq proceedwithplot (PDFgetproceedwithplot)) ;; Do plotting ;;Plot model space (if (= (getvar "TILEMODE") 1) ;;model space plot (progn (if (= (ssget "_x" '((410 . "Model"))) nil) ;;check if there are any objects to plot (progn (alert "-CANCELLING-\nThe drawing is blank") (exit) ) ; end progn ) ; end if (if (= plotarea "window") (command "-plot" detailedplotconfiguration layoutname plottername papersize paperunits orientation plotupsidedown plotarea pause pause plotscale plotoffset plotwithplotstyles plotstyletablename plotwithlineweights shadeplotsetting filepathname saveplotsettings proceedwithplot) ) ; end if 'window' (if (/= plotarea "window") (command "-plot" detailedplotconfiguration layoutname plottername papersize paperunits orientation plotupsidedown plotarea plotscale plotoffset plotwithplotstyles plotstyletablename plotwithlineweights shadeplotsetting filepathname saveplotsettings proceedwithplot) ) ; end if ) ; end progn ) ; end if modelspace ;;Plot paper space (if (= (getvar "TILEMODE") 0) (progn (if (= plotarea "window") (command "-plot" detailedplotconfiguration layoutname plottername papersize paperunits orientation plotupsidedown plotarea pause pause plotscale plotoffset plotwithplotstyles plotstyletablename plotwithlineweights "" "" "" filepathname saveplotsettings proceedwithplot) ) (if (= plotarea "extents") (command "zoom" "all" "zoom" ".95x") ;; Zoom screen, just because (command "-plot" detailedplotconfiguration layoutname plottername papersize paperunits orientation plotupsidedown plotarea plotscale plotoffset plotwithplotstyles plotstyletablename plotwithlineweights "" "" "" filepathname saveplotsettings proceedwithplot) ) ; end if ) ; end progn ) ; end if paperspace (princ) ; exit quietly )

One way, might be the easiest is to change the list that populates 'Block List', adding spaces to the nested block So you might have a line like this in your LISP: (start_list "lst" 3)(mapcar 'add_list BlockList)(end_list) Where BlockList is your list of block, might be (setq BlockList (list "BLOCK-1" "BLK-1" "BLK-2"... "BLOCK-2")) Which you could change to be (setq BlockList (list "BLOCK-1" " BLK-1" " BLK-2"... "BLOCK-2")) I don't think you can do the indenting with DCL, has to be done before then.

I've played with ElpanoxEvgeniy's original code and made a working version. It;s fine on straight segments but can be a little unpredictable on curved segments @GLAVCVS code is a bit more stable on curved segments.

Has anyone tried the code, got it working and find it useful?

I have used just a lisp name not a path in the autoload. All our customisation was in one directory on a server, it did though have sub directory's lisp blocks icons etc. Yes if you have Acad need to add trusted paths. (if (> (vl-string-search "BRICSCAD" (strcase (getvar 'product))) 0) (princ "Bricscad not found") (progn (setq oldtrust (getvar 'trustedpaths)) (if (wcmatch oldtrust "*XXX*") (princ) (setvar 'trustedpaths (strcat oldtrust ";" "c:\\XXX-CAD-TOOLS")) ) ) ) (command "workspace" "save" "" "y") ; a good idea is have a new workspace say user name (alert "\nSupport and trusted paths added")

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

Sorry it took me a while to clean this up, it worked on your sample drawing. I was trying to get it to do any closed shape, but couldn't get Ellipses and Pline Ellipses to work. I'll get back to that when time allows. ;;; Trim (Lines & LWPolylines) Inside Closed Shapes (LWPolylines & Circles) = TICS | ;;; | ;;; https://www.cadtutor.net/forum/topic/98452-trim-lines-inside-rectangs/#findComment-674554 | ;;; | ;;; By SLW210 (a.k.a. Steve Wilson) | ;;; | ;;; TICS.lsp | ;;; | ;;; (Needs improvement, need to add Ellipses and Pline Ellipses to Shapes to trim with.) | ;;; | ;;;================================================================================================| (defun evenp (n) (= (rem n 2) 0)) (defun ent-in-ss (ent ss / i found) (setq found nil i 0 ) (while (and (< i (sslength ss)) (not found)) (if (equal ent (ssname ss i)) (setq found T) (setq i (1+ i)) ) ) found ) ;; Ray casting algorithm for closed LWPolyline. (defun point-inside-polygon (pt plObj / crossings i paramCount p1 p2) (setq crossings 0) (setq pCount (fix (vlax-curve-getEndParam plObj))) (setq i 0) (while (< i pCount) (setq p1 (vlax-curve-getPointAtParam plObj i)) (setq p2 (vlax-curve-getPointAtParam plObj (1+ i))) (if (and (> (cadr pt) (min (cadr p1) (cadr p2))) (<= (cadr pt) (max (cadr p1) (cadr p2))) (< (car pt) (+ (car p1) (* (- (cadr pt) (cadr p1)) (/ (- (car p2) (car p1)) (- (cadr p2) (cadr p1))) ) ) ) ) (setq crossings (1+ crossings)) ) (setq i (1+ i)) ) (not (evenp crossings)) ) ;;;================================================================================================| (defun c:TICS (/ ssShapes ssLines i j ent entObj shapeEnt shapeObj shapeType pts allIntPts p1 p2 mid inside? origColor ) (vl-load-com) (prompt "\n--- Trim Lines & LWPolylines Inside Circles & Closed LWPoplylines ---\n" ) ;; Prompt to select shapes for trimming (prompt "\nSelect closed polylines or circles as trimming boundaries:" ) (setq ssShapes (ssget '((0 . "LWPOLYLINE,CIRCLE")))) (if (not ssShapes) (progn (prompt "\nNo valid trimming shapes selected.") (exit)) ) ;; Select all lines and polylines in drawing (setq ssLines (ssget "X" '((0 . "LINE,LWPOLYLINE")))) (if (not ssLines) (progn (prompt "\nNo lines or polylines found to trim.") (exit)) ) (setq i 0) (while (< i (sslength ssLines)) (setq ent (ssname ssLines i)) (if (not (ent-in-ss ent ssShapes)) (progn (setq entObj (vlax-ename->vla-object ent)) (setq origColor (vla-get-Color entObj)) ;; Collect intersection points with all shapes (setq allIntPts '()) (setq j 0) (while (< j (sslength ssShapes)) (setq shapeEnt (ssname ssShapes j)) (setq shapeObj (vlax-ename->vla-object shapeEnt)) (setq shapeType (cdr (assoc 0 (entget shapeEnt)))) (if (or (= shapeType "LWPOLYLINE") (= shapeType "CIRCLE")) (progn (setq pts (vlax-invoke shapeObj 'IntersectWith entObj acExtendNone ) ) (if (and pts (> (length pts) 2)) (progn (repeat (/ (length pts) 3) (setq allIntPts (append allIntPts (list (list (car pts) (cadr pts) (caddr pts) ) ) ) ) (setq pts (cdddr pts)) ) ) ) ) ) (setq j (1+ j)) ) (if (null allIntPts) (progn (setq mid (cond ((= (vla-get-objectname entObj) "AcDbLine") (mapcar '(lambda (a b) (/ (+ a b) 2.0)) (vlax-get entObj 'StartPoint) (vlax-get entObj 'EndPoint) ) ) ((= (vla-get-objectname entObj) "AcDbPolyline") (vlax-curve-getPointAtDist entObj (/ (vlax-curve-getDistAtParam entObj (vlax-curve-getEndParam entObj) ) 2.0 ) ) ) (T nil) ) ) (setq inside? nil) (setq j 0) (while (and (< j (sslength ssShapes)) (not inside?)) (setq shapeEnt (ssname ssShapes j)) (setq shapeObj (vlax-ename->vla-object shapeEnt)) (setq shapeType (cdr (assoc 0 (entget shapeEnt)))) (setq inside? (cond ((= shapeType "LWPOLYLINE") (point-inside-polygon mid shapeObj) ) ((= shapeType "CIRCLE") (< (distance mid (vlax-get shapeObj 'Center)) (vlax-get shapeObj 'Radius) ) ) (T nil) ) ) (setq j (1+ j)) ) (if inside? (entdel ent) ) ) (progn (setq allIntPts (append (list (vlax-curve-getStartPoint ent)) allIntPts (list (vlax-curve-getEndPoint ent)) ) ) (setq allIntPts (vl-sort allIntPts (function (lambda (a b) (< (vlax-curve-getDistAtPoint ent a) (vlax-curve-getDistAtPoint ent b) ) ) ) ) ) (entdel ent) (setq j 0) (while (< j (1- (length allIntPts))) (setq p1 (nth j allIntPts)) (setq p2 (nth (1+ j) allIntPts)) (setq mid (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p1 p2)) (setq inside? nil) (setq k 0) (while (and (< k (sslength ssShapes)) (not inside?)) (setq shapeEnt (ssname ssShapes k)) (setq shapeObj (vlax-ename->vla-object shapeEnt)) (setq shapeType (cdr (assoc 0 (entget shapeEnt)))) (setq inside? (cond ((= shapeType "LWPOLYLINE") (point-inside-polygon mid shapeObj) ) ((= shapeType "CIRCLE") (< (distance mid (vlax-get shapeObj 'Center) ) (vlax-get shapeObj 'Radius) ) ) (T nil) ) ) (setq k (1+ k)) ) (if (not inside?) (entmakex (list '(0 . "LINE") (cons 10 p1) (cons 11 p2) (cons 62 origColor) ) ) ) (setq j (1+ j)) ) ) ) ) ) (setq i (1+ i)) ) (prompt "\nDone trimming inside shapes.") (princ) ) (princ "\nType 'TICS' to run the command.")

ClipIt (Express Tool) works on blocks, etc. so I got it to work manually. I did do some light reading on automating options in a called Express Tool, so maybe at some point. This works for me, hopefully speeds things up for the OP. Works OP provided .dwg and some quick blocks to test it. ;;; Creates a circular detail clip from a block reference. Copies, scales, and trims to scaled circle (connected by trimmed line). ;;; ;;; https://www.cadtutor.net/forum/topic/98334-detail-circle-in-ms/page/2/#findComment-674313 ;;; ;;;*************************************************************************************************| ;;; | ;;; By SLW210 (a.k.a. Steve Wilson) | ;;; | ;;; MSCirClip.lsp | ;;; | ;;; Uses the Express Tool ClipIt manually (maybe this will be automated at a later time). | ;;; At the prompt-Select the detail circle then select the copied and scaled block. | ;;; At Enter maximum allowable error distance for resolution of arc segments. | ;;; I used 1 and it seems good (smaller is more segments) (see Clipit in Express Tools help). | ;;; | ;;;*************************************************************************************************| ;;; ClipIt creates a pseudo circle of polylines, the connector line will most likely have a gap. | ;;; | ;;; Optionally you could comment the part erasing it. | ;;; | ;;;*************************************************************************************************| ;;; (defun c:MSCIRCLIP (/ ent cen rad circle newPt scaleFactor newRad vec dir pt1 pt2 len scaledBlock detailCircle entsBefore entsAfter diffBlocks ) (vl-load-com) (prompt "\n--- MODELSPACE DETAIL VIEW WITH CLIPIT ---\n") ;; Modelspace entities (defun all-ents () (vl-remove-if 'null (mapcar 'cadr (ssnamex (ssget "_X" '((410 . "Model"))))) ) ) ;; Select block reference (setq ent (car (entsel "\nSelect block reference to detail: "))) (if (not (and ent (= (cdr (assoc 0 (entget ent))) "INSERT"))) (progn (prompt "\nNot a valid block reference.") (exit)) ) ;; Circle center/radius (setq cen (getpoint "\nSpecify center of detail circle: ")) (setq rad (getdist cen "\nSpecify radius of detail circle: ")) (entmakex (list '(0 . "CIRCLE") (cons 10 cen) (cons 40 rad) (cons 62 1) (cons 8 "DETAIL") ) ) ;; Detail location and scale (setq newPt (getpoint "\nSpecify center point for detail view: ")) (initget 7) (setq scaleFactor (getreal "\nEnter detail scale factor (e.g. 2): ")) (setq newRad (* rad scaleFactor)) ;; Copy and scale block (command "COPY" ent "" cen newPt) (setq scaledBlock (entlast)) (command "SCALE" scaledBlock "" newPt scaleFactor) ;; Clipping circle (setq detailCircle (entmakex (list '(0 . "CIRCLE") (cons 10 newPt) (cons 40 newRad) (cons 62 1) (cons 8 "DETAIL") ) ) ) ;; Run CLIPIT manually (prompt "\n>>> Run CLIPIT: Select the detail circle and the new (scaled) block.\n" ) (C:CLIPIT) ;; Delete temp circle after CLIPIT (if (and detailCircle (entget detailCircle)) (entdel detailCircle) ) ;; Draw connector line (setq vec (mapcar '- newPt cen)) (setq len (distance cen newPt)) (setq dir (mapcar '/ vec (list len len len))) (setq pt1 (mapcar '+ cen (mapcar '* dir (list rad rad rad)))) (setq pt2 (mapcar '- newPt (mapcar '* dir (list newRad newRad newRad)) ) ) (entmakex (list '(0 . "LINE") (cons 10 pt1) (cons 11 pt2) (cons 62 3) (cons 8 "DETAIL") ) ) (prompt "\nDetail view created and connector drawn.\n") (princ) )

Aj, unlucky. Hopefully Alexander Rivilis will make an updated version for newer versions!

I can't believe you just asked "What are architectural units?" Hint: feet and inches. Type the UNITS command at the command line then press Enter. At the UNITS dialog window look under the heading for "Type". Select "Architectural". Specify the Precision below that. I would expect 0'-0 1/16" to be good enough. Click on the OK button. You're done. Go to work. I don't think we've gotten as far as dimensioning yet. I think we are still trying to draw to the correct length.

I suppose the simplest would be something like: (defun c:zoomhandle ( / e ) (if (setq e (handent (getstring "\nSpecify Handle: "))) (command "_.zoom" "_O" e "") ) (princ) ) In the mean time, use AfraLISP to learn LISP.