Author Topic: Constant screen point (translated from WCS)  (Read 215 times)

0 Members and 1 Guest are viewing this topic.

Grrr1337

  • Bull Frog
  • Posts: 453
Constant screen point (translated from WCS)
« 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:

ribarm

  • Water Moccasin
  • Posts: 1710
  • Marko Ribar, architect
Re: Constant screen point (translated from WCS)
« Reply #1 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...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

Grrr1337

  • Bull Frog
  • Posts: 453
Re: Constant screen point (translated from WCS)
« Reply #2 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.

VovKa

  • Swamp Rat
  • Posts: 873
  • Ukraine
Re: Constant screen point (translated from WCS)
« Reply #3 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)))
  )
)

Grrr1337

  • Bull Frog
  • Posts: 453
Re: Constant screen point (translated from WCS)
« Reply #4 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 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.

Lee Mac

  • Seagull
  • Posts: 11854
  • AutoCAD 2015 Windows 7 London, England
Re: Constant screen point (translated from WCS)
« Reply #5 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)))

Grrr1337

  • Bull Frog
  • Posts: 453
Re: Constant screen point (translated from WCS)
« Reply #6 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

MP

  • Seagull
  • Posts: 17015
  • brevity != aggression
Re: Constant screen point (translated from WCS)
« Reply #7 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:
\|// Set goal. Experiment tirelessly until
|oo| practice has become expertise.  Loop.
|- | LinkedIn | Dropbox | About

Grrr1337

  • Bull Frog
  • Posts: 453
Re: Constant screen point (translated from WCS)
« Reply #8 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.

« Last Edit: December 07, 2017, 07:33:49 pm by Grrr1337 »