GRTEXT

February 25, 2021

Hi everyone

I found this Lisp in the Internet and make few changes that will suit me.

i familier to the function grdraw and wounder if i can use GRTEXT in the same way

i dont need to write the text in autocad, i just need to see it and after i scroll with the mouse it will dissapear

(defun c:slopepol ( / osm pl ptlst a b l s mptlst mid otxts tanptlst slopelst anglst )

	(defun mid ( p1 p2 )
		(mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p1 p2)
	)

	(command "_.ucs" "_W")
	(setq osm (getvar 'osmode))
	(setvar 'osmode 0)
	(while (not pl)
		(setq pl (car (entsel "\nSelect open LWPOLYLINE-POLYGON that lies in WCS")))
		(if (not (and pl (eq (cdr (assoc 0 (entget pl))) "LWPOLYLINE") (eq (logand (cdr (assoc 70 (entget pl))) 1) 0) (equal (assoc 210 (entget pl)) '(210 0.0 0.0 1.0)) (vl-every '(lambda ( x ) (= 0.0 (cdr x))) (vl-remove-if-not '(lambda ( x ) (= 42 (car x))) (entget pl)))))
			(progn
				(prompt "\nMissed selection, or picked wrong entity (not LWPOLYLINE), or picked LWPOLYLINE isn't open, or LWPOLYLINE doesn't lie in WCS, or LWPOLYLINE isn't POLYGON (has arced segments)... Try again...")
				(setq pl nil)
			)
		)
	)
	(setq ptlst (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) (entget pl))))
	(initget 7)
	(setq a 0.5)
	(setq b (/ a 2.0))

	(setq mptlst (mapcar '(lambda ( v1 v2 ) (mid v1 v2)) ptlst (cdr ptlst)))
	(setq otxts (getvar 'textsize))
	(setvar 'textsize a)
	(setq anglst (mapcar '(lambda ( v1 v2 ) (* (/ (- (cadr v2) (cadr v1)) (- (car v2) (car v1)) ) 100) ) ptlst (cdr ptlst)))
	(mapcar '(lambda ( x y ) (command "_.text" "_J" "_BC" (polar x (+ (/ pi 2.0) (cvunit y "degrees" "radians")) a) "" y (strcat (rtos (abs y) 2 2) "%"))) mptlst anglst)
	
	(setvar 'osmode osm)
	(setvar 'textsize otxts)
	(command "_.ucs" "_P")
	(princ)
)

February 25, 2021

No - GRTEXT will not work in the graphics area. GRTEXT only writes to the status line or the old screen menu areas.

Can you give us an idea of what your trying to do? The code you posted doesn't have any (grdraw) calls.

February 25, 2021

You could use (grdraw) to write "text", just like you can to draw vectors. A bit more complex, but it can be done.

February 25, 2021

Some ideas

It may be better to look at pick pline segment slope will display either as Text or a (princ or a (alert. There is code for which segment of pline.

Else 1st pick near end this sets order and just do a list of the values then display in command line or again (alert

If you add a list which is (cons (entlast) lst) then you can go through the list and erase all the text entities just created, may need a extra command as pausing and zooming around may be difficult or can do ZOOM C sc using the text position. Use (entdel (entlast))

February 28, 2021

For many years I have been writing this lisp to have some text on the screen ... and then I can delete it.

To write a message in red colour:
(setq &msgscr (x11:message "TEST" 1))

Erase the message:
(command "_erase" &msgscr "")

You can write in 2 lines:
(setq &msgscr (x11:message "LINE 1\nLINE 2" 2))

You can join the message:
(setq &msgscr (x11:message (strcat "HALLO" " WORLD") 5))

MESSAGE.LSP

February 28, 2021

There have been several temporary text routines over the years. This may be useful to you. Good luck -David

GRTXT.LSP

March 2, 2021

The lisp proposed by David Bethel works only on some DWG and not on others ... but I don't understand which variables are different (I only tried on GStarCAD and not on Autocad).

The text created with this lisp, appears but then disappears immediately!

March 3, 2021

Maybe replace

(command "_.text" "_J" "_BC" (polar x (+ (/ pi 2.0) (cvunit y "degrees" "radians")) a) "" y (strcat (rtos (abs y) 2 2) "%")))

with

(Alert (strcat (rtos (abs y) 2 2) "%")) you still have to click ok but disappears.

March 18, 2021

Thx to everyone

and especially to David Bethel

i just find the time to fix it

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:slp ( / osm pl ptlst a b l s mptlst mid otxts tanptlst slopelst anglst ts cp)

	(defun mid ( p1 p2 )
		(mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p1 p2)
	)

	(command "_.ucs" "_W")
	(setq osm (getvar 'osmode))
	(setvar 'osmode 0)
	(while (not pl)
		(setq pl (car (entsel "\nSelect open LWPOLYLINE-POLYGON that lies in WCS")))
		(if (not (and pl (eq (cdr (assoc 0 (entget pl))) "LWPOLYLINE") (eq (logand (cdr (assoc 70 (entget pl))) 1) 0) (equal (assoc 210 (entget pl)) '(210 0.0 0.0 1.0)) (vl-every '(lambda ( x ) (= 0.0 (cdr x))) (vl-remove-if-not '(lambda ( x ) (= 42 (car x))) (entget pl)))))
			(progn
				(prompt "\nMissed selection, or picked wrong entity (not LWPOLYLINE), or picked LWPOLYLINE isn't open, or LWPOLYLINE doesn't lie in WCS, or LWPOLYLINE isn't POLYGON (has arced segments)... Try again...")
				(setq pl nil)
			)
		)
	)
	(setq ptlst (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) (entget pl))))
	(initget 7)
	(setq a 0.5)
	(setq b (/ a 2.0))

	(setq mptlst (mapcar '(lambda ( v1 v2 ) (mid v1 v2)) ptlst (cdr ptlst)))
	(setq otxts (getvar 'textsize))
	(setvar 'textsize a)
	(setq anglst (mapcar '(lambda ( v1 v2 ) (* (/ (- (cadr v2) (cadr v1)) (- (car v2) (car v1)) ) 100) ) ptlst (cdr ptlst)))
	(setq anglstR (mapcar '(lambda ( v1 v2 ) (angle v1 v2)) ptlst (cdr ptlst)))
		
	(mapcar '(lambda ( x y z ) (grtxt (strcat (rtos (abs y) 2 2) "%") (polar x (+ (/ pi 2.0) y) a) 7 Z) ) mptlst anglst anglstR)
	
	(setvar 'osmode osm)
	(setvar 'textsize otxts)
	(command "_.ucs" "_P")
	(princ)
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;AUTO CALL MIDDLE - TOP OF SCREEN
(defun gra (s)
	(redraw)
	(grtxt (strcase s)
		(list (car (getvar "VIEWCTR"))
				(+ (* (getvar "VIEWSIZE") 0.45) (cadr (getvar "VIEWCTR"))) 0)
				7 0)
	(prin1))

;;;ARG ->  Text_String   Middle_Left_Center_Point Color Angle
(defun grtxt (ts cp cl a / ltb i xp a z c p1 p2 lp ld vp n al)
  (setq vp '((1 ( 0.50  0.25))    ;;;VERTEX POINTS
             (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))

            ))

  (setq ltb '(("A" 24 9 7 5 3 20 16 12)            ;;;LETTER TABLE
              ("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)
              ("")
              ))

;	20 PIXEL HALF OF THE TEXT HEIGHT
	(setq z (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE")) 0.1)
	xp (list (- (car cp) (* z (strlen ts) 0.5)) (- (cadr cp) (* z (strlen ts) 0.25)))  ;;;MIDDLE JUST TEXT
	i 1)

	(repeat (strlen ts)
	(setq 
		c (substr ts i 1)               ;;;EACH CHARACHTER
		lp '()                           ;;;LINE POINT LIST
		ld (cdr (assoc c ltb))          ;;;LETTER POINT DEF
	)
	(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))

;;;
(defun c:gtest ()
	(redraw)
	(command "_.ZOOM" "_C" '(0 0) 10)
	(grtxt "ABC DEFGHIJKLM"  (list -3  2) 1 0.0)
	(grtxt "NOP QRSTUVWXYZ"  (list -3  1) 2 0.0)
	(grtxt "1234567890-=\\"  (list -3  0) 3 0.0)
	(grtxt "~`!@#$%^&*()_+|" (list -3 -1) 4 0.0)
	(grtxt "}{[]\":';?><,./" (list -3 -2) 5 0.0)
	(prin1)
)

(defun c:gt1 ()
	(redraw)
	(command "_.ZOOM" "_C" '(0 0) 10)
	(grtxt "DEF"  (list -3  2) 1 0.0)
	(prin1)
)

(defun c:ptest ()  ;;; MAKE VP GLOBAL In GRTXT
	(command "_.ZOOM" "_C" '(0 0) 3)
	(setvar "CMDECHO" 1)
	(setvar "TEXTEVAL" 1)
	(foreach b vp (command "_.TEXT" "_M" (cadr b) 0 (itoa (car b))))
	(prin1)
)


(princ
	(strcat
	"\n:: Edit By Moshe Pour-David ::"
	"\n:: \"SLP\" To Activate ::"
	)
)
(princ)

Sign In

GRTEXT

Recommended Posts

mousho

pkenewell

rkmcswain

BIGAL

X11start

David Bethel

X11start

BIGAL

mousho

Join the conversation

Tutorials

Forums

Activity