Author Topic: Create a 'dynamic' Text that always faces the screen with a certain size?  (Read 2231 times)

0 Members and 1 Guest are viewing this topic.

TheRubens

  • Newt
  • Posts: 27
Hi everyone, Just wondering if it is possible to create a text in Autocad that it's always facing the screen and maintain the given size regardless of the viewpoint and zoom in/out in Autocad 3D model? Not sure if you can fully understand what I mean.

ribarm

  • Water Moccasin
  • Posts: 2369
  • Marko Ribar, architect
Re: Create a 'dynamic' Text that always faces the screen with a certain size?
« Reply #1 on: December 29, 2019, 07:13:46 AM »
Yes it's possible... But I am not willing to code it...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube


Grrr1337

  • Swamp Rat
  • Posts: 728
Re: Create a 'dynamic' Text that always faces the screen with a certain size?
« Reply #3 on: December 29, 2019, 07:26:40 AM »
Yeah it is possible - through grread or reactors -

« Last Edit: December 29, 2019, 07:35:02 AM by Grrr1337 »
(apply ''((a b c)(a b c))
  '(
    (( f L ) (apply 'strcat (f L)))
    (( L ) (if L (cons (chr (car L)) (f (cdr L)))))
    (72 101 108 108 111 32 87 111 114 108 100)
  )
)

TheRubens

  • Newt
  • Posts: 27
Re: Create a 'dynamic' Text that always faces the screen with a certain size?
« Reply #4 on: December 29, 2019, 05:49:30 PM »
Here's one way to do it.
Thank you Lee. The example Grrr1337 posted is what I wanted to achieve. But I guess the logic is the same as your examples?

TheRubens

  • Newt
  • Posts: 27
Re: Create a 'dynamic' Text that always faces the screen with a certain size?
« Reply #5 on: December 29, 2019, 05:51:52 PM »
Yeah it is possible - through grread or reactors -
Thanks Grrr1337. This is exactly what I wanted  :-D. Not familiar with grread or reactor though. I might need to search for more examples to help me understand how it works.

TheRubens

  • Newt
  • Posts: 27
Re: Create a 'dynamic' Text that always faces the screen with a certain size?
« Reply #6 on: December 29, 2019, 05:52:32 PM »
Yes it's possible... But I am not willing to code it...
Thank you all the same ribarm  :-D

Grrr1337

  • Swamp Rat
  • Posts: 728
Re: Create a 'dynamic' Text that always faces the screen with a certain size?
« Reply #7 on: December 30, 2019, 04:26:41 AM »
Yeah it is possible - through grread or reactors -
Thanks Grrr1337. This is exactly what I wanted  :-D. Not familiar with grread or reactor though. I might need to search for more examples to help me understand how it works.

Looks like I've posted some demo here -- Big thanks to VoVka for sharing his (vk_Point2Pixel) and (vk_Pixel2Point) subs!

Heres another demo which uses mtext entity instead of Lee's (LM:GrText) -
Code - Auto/Visual Lisp: [Select]
  1. (defun C:test ( / msg *error* ReshrinkMtext o p ll ur d pxl s k v m scz )
  2.  
  3.   (setq msg "\n[T]ype new text | [Q/E] justify | [P]lace at custom location")
  4.  
  5.   (defun *error* ( m )
  6.     (and o (vl-catch-all-apply 'vla-Delete (list o)))
  7.     (and m (princ m)) (princ)
  8.   ); defun
  9.  
  10.   ; (ReshrinkMtext (car (entsel)) 6)
  11.   (setq ReshrinkMtext
  12.     (lambda ( e n / enx )
  13.       (repeat n
  14.         (and e
  15.           (member '(0 . "MTEXT") (setq enx (entget e)))
  16.           (setq enx (subst (cons 46 0) (assoc 46 enx) enx))
  17.           (setq enx (subst (cons 41 (cdr (assoc 42 enx))) (assoc 41 enx) enx))
  18.           (entmod enx)
  19.         ); and
  20.       ); repeat
  21.     ); lambda
  22.   ); setq ReshrinkMtext
  23.  
  24.   ; RetVal = object.AddMText(InsertionPoint, Width, Text)
  25.   (setq o
  26.     (vla-AddMText
  27.       (vlax-3D-point (setq p '(0. 0. 0.))) (getvar 'textsize) msg
  28.     )
  29.   )
  30.   (vla-GetBoundingBox o 'll 'ur)
  31.   (vla-put-width o (setq d (apply 'distance (mapcar 'vlax-safearray->list (list ll ur)))))
  32.   ; (vla-put-attachmentpoint o acTopLeft)
  33.   (vla-put-attachmentpoint o acMiddleCenter)
  34.   (vla-highlight o :vlax-true)
  35.   ; (vla-put-BackgroundFill o :vlax-true)
  36.  
  37.   (ReshrinkMtext (vlax-vla-object->ename o) 6)
  38.  
  39.   ; Initialise color:
  40.   ( (lambda ( col ) (entmod (append (vl-remove-if '(lambda (x) (member (car x) '(62 420 430))) (entget (vlax-vla-object->ename o))) col)))
  41.     '((62 . 102))
  42.   )
  43.  
  44.  
  45.   ; (setq pxl (WcsPt<->ScreenPt (getpoint "\nSpecify info position: ") t))
  46.   ; Initialise pxl:
  47.   (setq pxl
  48.     (
  49.       (lambda ( / tmp tmp2)
  50.         (setq tmp (LM:ViewportExtents))
  51.         ; (setq tmp2 (mapcar '* '(0.008 0.008) (list (caar tmp) (cadadr tmp))))
  52.         ; (WcsPt<->ScreenPt (mapcar '+ tmp2 (apply '(lambda (a b) (list (car a) (cadr b))) tmp)) t)
  53.         ; (mapcar '* '(1.01 0.99) (WcsPt<->ScreenPt (list (caar tmp) (cadadr tmp)) t))
  54.         (WcsPt<->ScreenPt (apply 'mapcar (cons '(lambda (a b) (/ (+ a b) 2.)) tmp)) t)
  55.       ); lambda
  56.     )
  57.   ); setq pxl
  58.  
  59.   ; (setq pxl '(930 1380))
  60.   (princ msg)
  61.   (vlax-invoke o 'Move p (setq p (append (WcsPt<->ScreenPt pxl nil) '(0.))))
  62.   (while (not s) (mapcar 'set '(k v) (grread T))
  63.     (cond
  64.       ( (and (or (member (list k v) '((2 13)(2 32))) (= 25 k)) (setq s T)) (vla-Delete o) ) ; Exit keys = ENTER/SPACE/RMB
  65.       ( (= 2 k) (setq v (strcase (chr v)))
  66.         (cond
  67.           ( (= v "T")
  68.             (
  69.               (lambda ( / tmp )
  70.                 (if (/= "" (setq tmp (getstring t "\nInput new text value: ")))
  71.                   (progn
  72.                     (vlax-put o 'TextString tmp)
  73.                     (ReshrinkMtext (vlax-vla-object->ename o) 6)
  74.                   )
  75.                 )
  76.               )
  77.             )
  78.           )
  79.           ( (= v "Q")
  80.             (setq pxl
  81.               (
  82.                 (lambda ( / tmp )
  83.                   (setq tmp (LM:ViewportExtents))
  84.                   (mapcar '* '(1.01 0.99) (WcsPt<->ScreenPt (list (caar tmp) (cadadr tmp)) t))
  85.                   ); lambda
  86.                 )
  87.               ); setq pxl
  88.               (vla-put-AttachmentPoint o acAttachmentPointTopLeft)
  89.               (setq p (vlax-get o 'InsertionPoint))
  90.               (vl-catch-all-apply (function (lambda nil (vlax-invoke o 'Move p (setq p (append (WcsPt<->ScreenPt pxl nil) '(0.)))) )))
  91.           )
  92.           ( (= v "E")
  93.             (setq pxl
  94.               (
  95.                 (lambda ( / tmp )
  96.                   (setq tmp (LM:ViewportExtents))
  97.                   (mapcar '* '(0.999 0.99) (WcsPt<->ScreenPt (cadr tmp) t))
  98.                 ); lambda
  99.               )
  100.             ); setq pxl
  101.             (vla-put-AttachmentPoint o acAttachmentPointTopRight)
  102.             (setq p (vlax-get o 'InsertionPoint))
  103.             (vl-catch-all-apply (function (lambda nil (vlax-invoke o 'Move p (setq p (append (WcsPt<->ScreenPt pxl nil) '(0.)))) )))
  104.           )
  105.           ( (= v "P")
  106.             (
  107.               (lambda ( / osm )
  108.                 (setq osm (getvar 'osmode))
  109.                 (setvar 'osmode 0)
  110.                 (vl-catch-all-apply
  111.                   (function
  112.                     (lambda nil
  113.                       (if (setq tmp (getpoint "\nSpecify new text position: "))  (setq pxl (WcsPt<->ScreenPt tmp t)))
  114.                     )
  115.                   )
  116.                 )
  117.                 (setvar 'osmode osm)
  118.               ); lambda
  119.             )
  120.           )
  121.         ); cond
  122.       ); (= 2 k)
  123.       ( (= 5 k) ; Cursor is moved
  124.         (setq scz (/ (getvar 'viewsize) (cadr (getvar 'screensize))))
  125.         (vla-put-Height o (* 0.5 (getvar 'textsize) scz))
  126.         (vla-GetBoundingBox o 'll 'ur)
  127.         (vla-put-width o (setq d (apply 'distance (mapcar 'vlax-safearray->list (list ll ur)))))
  128.         (vl-catch-all-apply (function (lambda nil (vlax-invoke o 'Move p (setq p (append (WcsPt<->ScreenPt pxl nil) '(0.)))) )))
  129.         (vla-highlight o :vlax-true)
  130.       ); (= 5 k) ; Cursor is moved
  131.       ( (= 3 k) (setq s t) ); LMB is pressed
  132.     ); cond
  133.   ); while
  134.   (*error* nil) (princ)
  135. ); defun
  136.  
  137.  
  138. ;; Viewport Extents  -  Lee Mac
  139. ;; Returns two WCS points describing the lower-left and
  140. ;; upper-right corners of the active viewport.
  141.  
  142. (defun LM:ViewportExtents ( / c h v )
  143.   (setq ; Lee Mac ; http://www.theswamp.org/index.php?topic=46661.msg516726#msg516726
  144.     c (trans (getvar 'viewctr) 1 0)
  145.     h (/ (getvar 'viewsize) 2.0)
  146.     v (list (* h (apply '/ (getvar 'screensize))) h)
  147.   )
  148.   (list (mapcar '- c v) (mapcar '+ c v))
  149. )
  150.  
  151.  
  152.  
  153. ; Translation between WCS point and Pixel - vice versa
  154. ; p - point [pixel or WCS]
  155. ; b - boolean [T/nil] | T = WcsPt->ScreenPt, nil = ScreenPt->WcsPt
  156. (defun WcsPt<->ScreenPt ( p b / vsz scz vct pixelsz )
  157.   ; Vovka ; https://www.theswamp.org/index.php?topic=53702.0
  158.   (mapcar 'set '(vsz scz vct) (mapcar 'getvar '(viewsize screensize viewctr)))
  159.   (setq pixelsz (/ vsz (cadr scz)))
  160.   (if b
  161.     (mapcar '+ scz (mapcar '/ (mapcar '- p vct) (list pixelsz pixelsz))) ; vk_Point2Pixel
  162.     (mapcar '+ vct (mapcar '* (mapcar '- p scz) (list pixelsz pixelsz))) ; vk_Pixel2Point
  163.   ); if
  164. ); defun WcsPt<->ScreenPt

Both techniques (LM:GrText) or creating MTEXT entity have their drawbacks as it goes for user experience (self-tested).
(apply ''((a b c)(a b c))
  '(
    (( f L ) (apply 'strcat (f L)))
    (( L ) (if L (cons (chr (car L)) (f (cdr L)))))
    (72 101 108 108 111 32 87 111 114 108 100)
  )
)

TheRubens

  • Newt
  • Posts: 27
Re: Create a 'dynamic' Text that always faces the screen with a certain size?
« Reply #8 on: December 30, 2019, 08:42:34 PM »
Yeah it is possible - through grread or reactors -
Thanks Grrr1337. This is exactly what I wanted  :-D. Not familiar with grread or reactor though. I might need to search for more examples to help me understand how it works.

Looks like I've posted some demo here -- Big thanks to VoVka for sharing his (vk_Point2Pixel) and (vk_Pixel2Point) subs!

Heres another demo which uses mtext entity instead of Lee's (LM:GrText) -
Code - Auto/Visual Lisp: [Select]
  1. (defun C:test ( / msg *error* ReshrinkMtext o p ll ur d pxl s k v m scz )
  2.  
  3.   (setq msg "\n[T]ype new text | [Q/E] justify | [P]lace at custom location")
  4.  
  5.   (defun *error* ( m )
  6.     (and o (vl-catch-all-apply 'vla-Delete (list o)))
  7.     (and m (princ m)) (princ)
  8.   ); defun
  9.  
  10.   ; (ReshrinkMtext (car (entsel)) 6)
  11.   (setq ReshrinkMtext
  12.     (lambda ( e n / enx )
  13.       (repeat n
  14.         (and e
  15.           (member '(0 . "MTEXT") (setq enx (entget e)))
  16.           (setq enx (subst (cons 46 0) (assoc 46 enx) enx))
  17.           (setq enx (subst (cons 41 (cdr (assoc 42 enx))) (assoc 41 enx) enx))
  18.           (entmod enx)
  19.         ); and
  20.       ); repeat
  21.     ); lambda
  22.   ); setq ReshrinkMtext
  23.  
  24.   ; RetVal = object.AddMText(InsertionPoint, Width, Text)
  25.   (setq o
  26.     (vla-AddMText
  27.       (vlax-3D-point (setq p '(0. 0. 0.))) (getvar 'textsize) msg
  28.     )
  29.   )
  30.   (vla-GetBoundingBox o 'll 'ur)
  31.   (vla-put-width o (setq d (apply 'distance (mapcar 'vlax-safearray->list (list ll ur)))))
  32.   ; (vla-put-attachmentpoint o acTopLeft)
  33.   (vla-put-attachmentpoint o acMiddleCenter)
  34.   (vla-highlight o :vlax-true)
  35.   ; (vla-put-BackgroundFill o :vlax-true)
  36.  
  37.   (ReshrinkMtext (vlax-vla-object->ename o) 6)
  38.  
  39.   ; Initialise color:
  40.   ( (lambda ( col ) (entmod (append (vl-remove-if '(lambda (x) (member (car x) '(62 420 430))) (entget (vlax-vla-object->ename o))) col)))
  41.     '((62 . 102))
  42.   )
  43.  
  44.  
  45.   ; (setq pxl (WcsPt<->ScreenPt (getpoint "\nSpecify info position: ") t))
  46.   ; Initialise pxl:
  47.   (setq pxl
  48.     (
  49.       (lambda ( / tmp tmp2)
  50.         (setq tmp (LM:ViewportExtents))
  51.         ; (setq tmp2 (mapcar '* '(0.008 0.008) (list (caar tmp) (cadadr tmp))))
  52.         ; (WcsPt<->ScreenPt (mapcar '+ tmp2 (apply '(lambda (a b) (list (car a) (cadr b))) tmp)) t)
  53.         ; (mapcar '* '(1.01 0.99) (WcsPt<->ScreenPt (list (caar tmp) (cadadr tmp)) t))
  54.         (WcsPt<->ScreenPt (apply 'mapcar (cons '(lambda (a b) (/ (+ a b) 2.)) tmp)) t)
  55.       ); lambda
  56.     )
  57.   ); setq pxl
  58.  
  59.   ; (setq pxl '(930 1380))
  60.   (princ msg)
  61.   (vlax-invoke o 'Move p (setq p (append (WcsPt<->ScreenPt pxl nil) '(0.))))
  62.   (while (not s) (mapcar 'set '(k v) (grread T))
  63.     (cond
  64.       ( (and (or (member (list k v) '((2 13)(2 32))) (= 25 k)) (setq s T)) (vla-Delete o) ) ; Exit keys = ENTER/SPACE/RMB
  65.       ( (= 2 k) (setq v (strcase (chr v)))
  66.         (cond
  67.           ( (= v "T")
  68.             (
  69.               (lambda ( / tmp )
  70.                 (if (/= "" (setq tmp (getstring t "\nInput new text value: ")))
  71.                   (progn
  72.                     (vlax-put o 'TextString tmp)
  73.                     (ReshrinkMtext (vlax-vla-object->ename o) 6)
  74.                   )
  75.                 )
  76.               )
  77.             )
  78.           )
  79.           ( (= v "Q")
  80.             (setq pxl
  81.               (
  82.                 (lambda ( / tmp )
  83.                   (setq tmp (LM:ViewportExtents))
  84.                   (mapcar '* '(1.01 0.99) (WcsPt<->ScreenPt (list (caar tmp) (cadadr tmp)) t))
  85.                   ); lambda
  86.                 )
  87.               ); setq pxl
  88.               (vla-put-AttachmentPoint o acAttachmentPointTopLeft)
  89.               (setq p (vlax-get o 'InsertionPoint))
  90.               (vl-catch-all-apply (function (lambda nil (vlax-invoke o 'Move p (setq p (append (WcsPt<->ScreenPt pxl nil) '(0.)))) )))
  91.           )
  92.           ( (= v "E")
  93.             (setq pxl
  94.               (
  95.                 (lambda ( / tmp )
  96.                   (setq tmp (LM:ViewportExtents))
  97.                   (mapcar '* '(0.999 0.99) (WcsPt<->ScreenPt (cadr tmp) t))
  98.                 ); lambda
  99.               )
  100.             ); setq pxl
  101.             (vla-put-AttachmentPoint o acAttachmentPointTopRight)
  102.             (setq p (vlax-get o 'InsertionPoint))
  103.             (vl-catch-all-apply (function (lambda nil (vlax-invoke o 'Move p (setq p (append (WcsPt<->ScreenPt pxl nil) '(0.)))) )))
  104.           )
  105.           ( (= v "P")
  106.             (
  107.               (lambda ( / osm )
  108.                 (setq osm (getvar 'osmode))
  109.                 (setvar 'osmode 0)
  110.                 (vl-catch-all-apply
  111.                   (function
  112.                     (lambda nil
  113.                       (if (setq tmp (getpoint "\nSpecify new text position: "))  (setq pxl (WcsPt<->ScreenPt tmp t)))
  114.                     )
  115.                   )
  116.                 )
  117.                 (setvar 'osmode osm)
  118.               ); lambda
  119.             )
  120.           )
  121.         ); cond
  122.       ); (= 2 k)
  123.       ( (= 5 k) ; Cursor is moved
  124.         (setq scz (/ (getvar 'viewsize) (cadr (getvar 'screensize))))
  125.         (vla-put-Height o (* 0.5 (getvar 'textsize) scz))
  126.         (vla-GetBoundingBox o 'll 'ur)
  127.         (vla-put-width o (setq d (apply 'distance (mapcar 'vlax-safearray->list (list ll ur)))))
  128.         (vl-catch-all-apply (function (lambda nil (vlax-invoke o 'Move p (setq p (append (WcsPt<->ScreenPt pxl nil) '(0.)))) )))
  129.         (vla-highlight o :vlax-true)
  130.       ); (= 5 k) ; Cursor is moved
  131.       ( (= 3 k) (setq s t) ); LMB is pressed
  132.     ); cond
  133.   ); while
  134.   (*error* nil) (princ)
  135. ); defun
  136.  
  137.  
  138. ;; Viewport Extents  -  Lee Mac
  139. ;; Returns two WCS points describing the lower-left and
  140. ;; upper-right corners of the active viewport.
  141.  
  142. (defun LM:ViewportExtents ( / c h v )
  143.   (setq ; Lee Mac ; http://www.theswamp.org/index.php?topic=46661.msg516726#msg516726
  144.     c (trans (getvar 'viewctr) 1 0)
  145.     h (/ (getvar 'viewsize) 2.0)
  146.     v (list (* h (apply '/ (getvar 'screensize))) h)
  147.   )
  148.   (list (mapcar '- c v) (mapcar '+ c v))
  149. )
  150.  
  151.  
  152.  
  153. ; Translation between WCS point and Pixel - vice versa
  154. ; p - point [pixel or WCS]
  155. ; b - boolean [T/nil] | T = WcsPt->ScreenPt, nil = ScreenPt->WcsPt
  156. (defun WcsPt<->ScreenPt ( p b / vsz scz vct pixelsz )
  157.   ; Vovka ; https://www.theswamp.org/index.php?topic=53702.0
  158.   (mapcar 'set '(vsz scz vct) (mapcar 'getvar '(viewsize screensize viewctr)))
  159.   (setq pixelsz (/ vsz (cadr scz)))
  160.   (if b
  161.     (mapcar '+ scz (mapcar '/ (mapcar '- p vct) (list pixelsz pixelsz))) ; vk_Point2Pixel
  162.     (mapcar '+ vct (mapcar '* (mapcar '- p scz) (list pixelsz pixelsz))) ; vk_Pixel2Point
  163.   ); if
  164. ); defun WcsPt<->ScreenPt

Both techniques (LM:GrText) or creating MTEXT entity have their drawbacks as it goes for user experience (self-tested).

Thank you very much Grrr1337  :smitten:

ronjonp

  • Needs a day job
  • Posts: 7155
Re: Create a 'dynamic' Text that always faces the screen with a certain size?
« Reply #9 on: December 31, 2019, 11:41:15 AM »
Here's a sample of my 'Q' routine that uses grread and mtext:


Windows 10 x64 - AutoCAD /C3D 2020

Custom Build PC

TheRubens

  • Newt
  • Posts: 27
Re: Create a 'dynamic' Text that always faces the screen with a certain size?
« Reply #10 on: January 01, 2020, 10:29:17 PM »
Here's a sample of my 'Q' routine that uses grread and mtext:

Thanks ronjonp. I also have one more question regarding this. The examples here seem to make the texts temporarily, which means after the command the text will disappear. Is it possible make the text always showing even after we exit the command and use other commands like drawing objects. Also make the texts location to be flexible like normal texts instead of fixed locations. So basically it is like normal texts, the only difference is they are always facing the screen in 3D model with fixed sizes that won't be changed even if we zoom in or zoom out. Is it possible?

snownut2

  • Swamp Rat
  • Posts: 970
  • Bricscad 20 Ultimate
Re: Create a 'dynamic' Text that always faces the screen with a certain size?
« Reply #11 on: January 02, 2020, 06:37:51 AM »
That's why there's paperspace.....

TheRubens

  • Newt
  • Posts: 27
Re: Create a 'dynamic' Text that always faces the screen with a certain size?
« Reply #12 on: January 02, 2020, 05:49:56 PM »
That's why there's paperspace.....
I don't think so. Layout is just for printing. It doesn't allow you to keep the text facing the screen in a 3D model, and you cannot edit items in layout. What I want to do is edit objects in other plane other than XY in a 3D model and view the objects information etc while I zoom in/out, rotate or the like at the same time.

steve.carson

  • Newt
  • Posts: 78
Re: Create a 'dynamic' Text that always faces the screen with a certain size?
« Reply #13 on: January 03, 2020, 11:18:09 AM »
The attached gif explains what snownut2 is referring to. Put the text in paperspace and work on your model through an unlocked viewport.


TheRubens

  • Newt
  • Posts: 27
Re: Create a 'dynamic' Text that always faces the screen with a certain size?
« Reply #14 on: January 04, 2020, 06:59:47 AM »
The attached gif explains what snownut2 is referring to. Put the text in paperspace and work on your model through an unlocked viewport.
I do understand paperspace will make the sizes fixed. But like I have explained, this is not what I wanted to do. Take
Grrr1337's gif as an example, I want the line object information to be displayed at the middle point of each line. Whenever I move/rotate the view port, the object information text will follow the line objects instead of having fixed locations. it is basically like normal texts, but they are always facing the screen with a fixed sizes.