TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Grrr1337 on December 05, 2017, 08:14:29 AM

Title: Constant screen point (translated from WCS)
Post by: Grrr1337 on December 05, 2017, 08:14:29 AM
Hey guys,

I'm trying to figure out is there a way to:
Translate a given [WCS] point to a point on-screen (WcsPt->ScreenPt),
and then reconvert it back to WCS (ScreenPt->WcsPt).
Which would basically result to a constant position on the screen, while scrolling and panning.

I've assembled a quick test function to help you visualise the result you got:
Code - Auto/Visual Lisp: [Select]
  1. (defun C:test ( / p s g )
  2.   (setq p (getpoint "\nPick a point: "))
  3.   (setq p (WcsPt->ScreenPt p)) ; convert to Screen Point
  4.   (princ "\nTrapped in (grread) loop - please scroll and pan.") (redraw)
  5.   (while (not s)
  6.     (setq g (grread t))
  7.     (and (or (equal g '(2 13)) (= (car g) 25)) (setq s t)) ; enter/RMB to exit
  8.     (and (= (car g) 5) ; cursor
  9.       ; (LM:grx p 5 1) ; constant WCS point
  10.       (LM:grx
  11.         (ScreenPt->WcsPt p) ; Reconvert to WCS point ; should be constant Screen Point
  12.         5 1
  13.       )
  14.     ); and
  15.   ); while
  16.   (princ "\nLoop complete.") (redraw)
  17.   (princ)
  18. ); defun
  19.  
  20. ;; grX  -  Lee Mac
  21. ;; p - [lst] WCS point at which to display 'X'
  22. ;; s - [int] size of point (in pixels)
  23. ;; c - [int] ACI colour of point
  24. ;; Returns supplied WCS point.
  25.  
  26. (defun LM:grx ( p s c / -s r q )
  27.   (setq r (/ (getvar 'viewsize) (cadr (getvar 'screensize)))
  28.     q (trans p 0 3)
  29.     -s (- s)
  30.   )
  31.   (grvecs
  32.     (list c
  33.       (list -s -s) (list s  s) (list -s (1+ -s)) (list (1- s)  s) (list (1+ -s) -s) (list s (1-  s))
  34.       (list -s  s) (list s -s) (list -s (1-  s)) (list (1- s) -s) (list (1+ -s)  s) (list s (1+ -s))
  35.     )
  36.     (list
  37.       (list r  0. 0. (car  q))
  38.       (list 0. r  0. (cadr q))
  39.       (list 0. 0. r  0.)
  40.       (list 0. 0. 0. 1.)
  41.     )
  42.   )
  43.   p
  44. )

But I'm not sure how to write the (WcsPt->ScreenPt) and (ScreenPt->WcsPt),
my guess is by using the:
Code: [Select]
(/ (getvar 'viewsize) (cadr (getvar 'screensize))from the (grdrawpoint) technique.  :thinking:
Title: Re: Constant screen point (translated from WCS)
Post by: ribarm on December 05, 2017, 10:35:33 AM
As from what I understood, you only need to use trans function... (trans p 1 2)  and (trans p 2 0)... But all this is unnecessary as you only need to provide point in WCS as argument for (LM:grx)... So perhaps :

Code - Auto/Visual Lisp: [Select]
  1. (defun C:test ( / p s g )
  2.   (setq p (getpoint "\nPick a point: "))
  3.   ;  (setq p (WcsPt->ScreenPt p)) ; convert to Screen Point
  4.   (setq p (trans p 1 2)) ; convert from UCS to DCS (display coord sys)
  5.   (princ "\nTrapped in (grread) loop - please scroll and pan.") (redraw)
  6.   (while (not s)
  7.     (setq g (grread t))
  8.     (and (or (equal g '(2 13)) (= (car g) 25)) (setq s t)) ; enter/RMB to exit
  9.     (and (= (car g) 5) ; cursor
  10.       ; (LM:grx p 5 1) ; constant WCS point
  11.       ;|
  12.       (LM:grx
  13.         (ScreenPt->WcsPt p) ; Reconvert to WCS point ; should be constant Screen Point
  14.         5 1
  15.       )
  16.       |;
  17.       (LM:grx
  18.         (trans p 2 0) ; Reconvert to WCS point ; should be constant Screen Point
  19.         5 1
  20.       )
  21.     ); and
  22.   ); while
  23.   (princ "\nLoop complete.") (redraw)
  24.   (princ)
  25. ); defun
  26.  

But the result is equal to :

Code - Auto/Visual Lisp: [Select]
  1. (defun C:test ( / p s g )
  2.   (setq p (getpoint "\nPick a point: "))
  3.   ;  (setq p (WcsPt->ScreenPt p)) ; convert to Screen Point
  4.   (setq p (trans p 1 0)) ; convert from UCS to WCS
  5.   (princ "\nTrapped in (grread) loop - please scroll and pan.") (redraw)
  6.   (while (not s)
  7.     (setq g (grread t))
  8.     (and (or (equal g '(2 13)) (= (car g) 25)) (setq s t)) ; enter/RMB to exit
  9.     (and (= (car g) 5) ; cursor
  10.       (LM:grx p 5 1) ; constant WCS point
  11.       ;|
  12.       (LM:grx
  13.         (ScreenPt->WcsPt p) ; Reconvert to WCS point ; should be constant Screen Point
  14.         5 1
  15.       )
  16.       |;
  17.     ); and
  18.   ); while
  19.   (princ "\nLoop complete.") (redraw)
  20.   (princ)
  21. ); defun
  22.  

I hope it has some meaning, otherwise I don't quite understand what do you need to achieve...
Title: Re: Constant screen point (translated from WCS)
Post by: Grrr1337 on December 05, 2017, 11:27:54 AM
I hope it has some meaning, otherwise I don't quite understand what do you need to achieve...

Just tried to figure out a substitute for a modeless dialog by utilising (LM:GrText) and this technique, so the shown information "locks" at the screen position.
Title: Re: Constant screen point (translated from WCS)
Post by: VovKa on December 05, 2017, 12:25:04 PM
Code: [Select]
(defun vk_GetPixelSize () (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE"))))
(defun vk_Point2Pixel (p)
  (mapcar '+
  (getvar "SCREENSIZE")
  (mapcar '/ (mapcar '- p (getvar "VIEWCTR")) (list (vk_GetPixelSize) (vk_GetPixelSize)))
  )
)
(defun vk_Pixel2Point (p)
  (mapcar '+
  (getvar "VIEWCTR")
  (mapcar '* (mapcar '- p (getvar "SCREENSIZE")) (list (vk_GetPixelSize) (vk_GetPixelSize)))
  )
)
Title: Re: Constant screen point (translated from WCS)
Post by: Grrr1337 on December 05, 2017, 12:43:08 PM
Wow,
Vovka your suggestion worked like a charm! :wideeyed:
Now people can dock information on the screen (by combining this with (LM:GrText)), while using (grread) or reactors...

This thread resulted when I wanted to help (http://www.cadtutor.net/forum/showthread.php?102274-Alert-box-with-focus-on-DWG-acet-uit-status-Multiple-lines) a user from another forum, who complained about (acet-ui-status) that supported only 3 lines of text.
And it seemed that (acet-ui-status) was the only way[?] to display info from a modeless dialog, without annoying the user while working.
Title: Re: Constant screen point (translated from WCS)
Post by: Lee Mac on December 05, 2017, 01:13:38 PM
FWIW, there is also (acet-geom-pixel-unit) which will return the same as (/ (getvar 'viewsize) (cadr (getvar 'screensize)))
Title: Re: Constant screen point (translated from WCS)
Post by: Grrr1337 on December 05, 2017, 08:05:28 PM
Thanks for the info Lee, although I try to avoid if possible acet-*** functions, since Michael wrote that its like "building a castle on floating sand".  :-D
Title: Re: Constant screen point (translated from WCS)
Post by: MP on December 06, 2017, 12:13:12 AM
Close:

Quote from: MP
Analogous to building a house on quick sand.

My opinion hasn't changed. :police:
Title: Re: Constant screen point (translated from WCS)
Post by: Grrr1337 on December 07, 2017, 07:25:52 PM
Soo heres a sample for you guys, incase you still didn't got the idea for usage [requires (LM:GrText) defined]:

Code - Auto/Visual Lisp: [Select]
  1. ; test for (WcsPt<->ScreenPt)
  2. (defun C:test ( / str col vec p s g e )
  3.  
  4.   (and
  5.     (setq vec (LM:GrText str))
  6.     (setq p (getpoint "\nPick a point for text location: "))
  7.     (setq p (WcsPt<->ScreenPt p T)) ; convert to Screen Point
  8.     (princ "\nTrapped in (grread) loop - please scroll, pan and hover over some object.")
  9.     (progn
  10.       (redraw)
  11.       (while (not s)
  12.         (setq g (grread t))
  13.         (and (or (equal g '(2 13)) (= (car g) 25)) (setq s t)) ; enter/RMB to exit
  14.         (and (= (car g) 5) ; cursor
  15.           (or
  16.             (and
  17.               (setq e (car (nentselp (cadr g))))
  18.               (setq vec
  19.                 (LM:GrText
  20.                   (strcat
  21.                     "Object relies on layer: " (cdr (assoc 8 (entget e)))
  22.                     "\nObject's entity type: " (cdr (assoc 0 (entget e)))
  23.                     "\nNow I'll just put a bunch of rows..."
  24.                     "\n...................................."
  25.                     "\n...................................."
  26.                     "\n...................................."
  27.                     "\n...................................."
  28.                     "\n..................................:)"
  29.                   )
  30.                 )
  31.               )
  32.               (setq col 2)
  33.             )
  34.             (and
  35.               (setq vec
  36.                 (LM:GrText
  37.                   (strcat
  38.                     "\nBTW you could use this technique"
  39.                     "\nas a modeless dialog substitute"
  40.                     "\nwithin a reactor."
  41.                     "\n\nThis is awesome!"
  42.                   )
  43.                 )
  44.               )
  45.               (setq col 1)
  46.             )
  47.           )
  48.           (progn (redraw)
  49.             (if vec (LM:DisplayGrText (WcsPt<->ScreenPt p nil) vec col 15 -31))
  50.           )
  51.         ); and
  52.       ); while
  53.       s
  54.     ); progn
  55.     (princ "\nLoop complete.") (redraw)
  56.   ); and
  57.   (princ)
  58. ); defun
  59.  
  60.  
  61. ; Translation between WCS point and Pixel - vice versa
  62. ; p - point [pixel or WCS]
  63. ; b - boolean [T/nil] | T = WcsPt->ScreenPt, nil = ScreenPt->WcsPt
  64. (defun WcsPt<->ScreenPt ( p b / vsz scz vct pixelsz )
  65.   ; Vovka ; https://www.theswamp.org/index.php?topic=53702.0
  66.   (mapcar 'set '(vsz scz vct) (mapcar 'getvar '(viewsize screensize viewctr)))
  67.   (setq pixelsz (/ vsz (cadr scz)))
  68.   (if b
  69.     (mapcar '+ scz (mapcar '/ (mapcar '- p vct) (list pixelsz pixelsz))) ; vk_Point2Pixel
  70.     (mapcar '+ vct (mapcar '* (mapcar '- p scz) (list pixelsz pixelsz))) ; vk_Pixel2Point
  71.   ); if
  72. ); defun
  73.  
  74.  
  75. ;; Display GrText  -  Lee Mac
  76. ;; pnt  -  cursor point in UCS
  77. ;; vec  -  GrText vector list
  78. ;; col  -  Text Colour (ACI Colour)
  79. ;; xof  -  x-offset from cursor in pixels
  80. ;; yof  -  y-offset from cursor in pixels
  81.  
  82. (defun LM:DisplayGrText ( pnt vec col xof yof / scl )
  83.   (setq scl (/ (getvar 'viewsize) (cadr (getvar 'screensize)))
  84.     pnt (trans pnt 1 2)
  85.   )
  86.   (grvecs (cons col vec)
  87.     (list
  88.       (list scl 0.0 0.0 (+ (car  pnt) (* xof scl)))
  89.       (list 0.0 scl 0.0 (+ (cadr pnt) (* yof scl)))
  90.       (list 0.0 0.0 scl 0.0)
  91.       '(0.0 0.0 0.0 1.0)
  92.     )
  93.   )
  94. )

I've condensed Vovka's functions and left his nickname and link to the thread inside the subfunction (I hope he's ok with that).
I know I mentioned reactors (and it could be used the same way) although I'm uploading a demo with grread usage.
You can see I'm scrolling 'n' panning and the LM:Grtext stays in a constant position.