Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 07/09/2025 in all areas

  1. 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)
    2 points
  2. 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"
    2 points
  3. Oh , you're not lisping anymore? pitty... you belong to the top lispy's
    2 points
  4. 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).
    2 points
  5. 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))
    1 point
  6. Interesting for sure!
    1 point
  7. Nice, I can see uses for this. Might add a slight change one day if it works to draw a wipeout under the 'buttons'?
    1 point
  8. 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
    1 point
×
×
  • Create New...