Inserting text in a UCS

dlbsurveysuk · ‎03-18-2022

Hi,

I've got a variety of fairly simple lisp routines for adding text to drawings. They all work fine in the WCS but not in a UCS.

I can see that there needs to be co-ordinate transformations to make them work in a UCS. This seems to involve the "TRANS" command but even after much googling I can't seem to get my head around it.

Multiple UCSs involve an initial rotation around the z axis that could be any angle, further 90 degree rotations around the z axis, and then 90 degree flips around the x axis.

I've attached three sample routines -

TT - Insert multiple lines of text equally spaced and centred at selected point.

UT - Add multiple lines of equally spaced and centred text under existing selected text.

LH - Inserts MTEXT "Loft" "hatch" at an intersection.

Hopefully someone can point me in the right direction...

(sorry the formatting is a bit messy, they came from a colleague in this state)

Thanks in advance
Quentin.

(DEFUN C:TT (/)
(GRAPHSCR)


(SETQ lll (GETVAR"CLAYER"))
 (SETQ OSM (GETVAR"OSMODE"))
 (COMMAND "OSNAP" "NONE")
(command "layer" "m" "GTEXT" "")


  (setq edp(getpoint "TEXT AT.."))
(setq txt (getstring T "TEXT.."))
   (COMMAND "TEXT" "C" EDP "" 0.0 TXt)


(setq e(entget(entlast)))

	(setq en2(cdr(assoc -1 e)))
	(setq en3(entget en2))   
	(SETQ TYPE1 (CDR (ASSOC 0 EN3)))
		(textun)


(SETVAR "OSMODE" OSM)
  (COMMAND "LAYER" "S" lll "")
   (setq *error* olderr)             ; Restore old *error* handler
   (princ)
)

(DEFUN C:UT (/)
(GRAPHSCR)

;;;EXTRACT EXISTING INFORMATION


(SETQ STYLE1 (GETVAR "TEXTSTYLE"))
(SETQ LAYER1 (GETVAR "CLAYER"))
(SETQ SIZE1 (GETVAR "TEXTSIZE"))
(SETQ COL2 (GETVAR "CECOLOR"))
(SETQ COL3 (ATOI COL2))

;;;SELECT TEXT TO UNDERWRITE

	(SETQ EN1 (ENTSEL "SELECT THE TEXT TO WRITE UNDER: "))
		(WHILE (= EN1 NIL)
			(ALERT "NO TEXT SELECTED")
			(SETQ EN1 (ENTSEL "SELECT THE TEXT TO WRITE UNDER: "))	
		)

	(SETQ EN2 (CAR EN1))
	(SETQ EN3 (ENTGET EN2))


;;;CHECK TO SEE IF TEXT OR MTEXT

	(SETQ TYPE1 (CDR (ASSOC 0 EN3)))
	(IF (= TYPE1 "MTEXT")(COMMAND "DDEDIT" EN1 "")(TEXTUN))
	
;;;RESET EXISTING VALUES

(SETVAR "TEXTSIZE" SIZE1)
(SETVAR "TEXTSTYLE" STYLE1)
(SETVAR "CLAYER" LAYER1)
(SETVAR "CECOLOR" COL2)

(PRINC)

)

(DEFUN C:LH (/)
(GRAPHSCR)

 (SETQ lll (GETVAR"CLAYER"))
 (SETQ OSM (GETVAR"OSMODE"))
 (COMMAND "OSNAP" "INTERSECTION")
 (command "layer" "m" "GTEXT" "")

  (setq edp(getpoint "TEXT AT.."))


   (COMMAND "MTEXT" edp "_Justify" "MC" "_none" "@" "Loft" "hatch" "")


(SETVAR "OSMODE" OSM)
  (COMMAND "LAYER" "S" lll "")
   (setq *error* olderr)             ; Restore old *error* handler
   (princ)
)

ВeekeeCZ · ‎03-18-2022

What (textun) is?

Apart from that, the text should be correctly placed to the current UCS.

dlbsurveysuk · ‎03-18-2022

Hi thanks for the response,

I also wondered what (textun) is. I can't contact my colleague at the moment.

This is an example of what happens with the LH lisp in a UCS (see attached screenshots) -

First image is in WCS using LH lisp at triangle point 1 (0,0,0)

Then commands -

UCS
origin at point 1
point on x-axis at point 2

VP (image 2)
Relative to UCS
Set to Plan View
OK

point 1 is now 0,0,0 in the UCS (image 3)

LH lisp at point 1

the text is inserted at 87.282,10.915,0 (image 4)

image 1image 2image 3image 4

dlbsurveysuk · ‎03-18-2022

PS These are my drawing units settings -

dlbsurveysuk · ‎03-18-2022

Anyone got any ideas on this? Thanks.

dlbsurveysuk · ‎03-19-2022

Sorry to bump this again but I really need some help sorting this out.

Thanks.

pbejse · ‎03-19-2022

HYG

dlbsurveysuk · ‎03-19-2022

Thanks for the help...

dlbsurveysuk · ‎03-22-2022

OK. This has been solved in a bodge like manner by using -

(command "UCS" "W")
;and
(command "UCS" "V")
;and
(C:ROV)

in the LH routine. The UCS commands gave the correct positions but the text was rotated to the WCS. The ROV routine solves this.

New LH routine with ROV routine attached -

(DEFUN C:LH (/)
(GRAPHSCR)

 (SETQ lll (GETVAR"CLAYER"))
 (SETQ OSM (GETVAR"OSMODE"))
 (COMMAND "OSNAP" "INTERSECTION")
 (command "layer" "m" "GTEXT" "")

(command "UCS" "W")

  (setq edp(getpoint "TEXT AT.."))


   (COMMAND "MTEXT" edp "_Justify" "MC" "_none" "@" "Loft" "hatch" "")


(SETVAR "OSMODE" OSM)
  (COMMAND "LAYER" "S" lll "")
   (setq *error* olderr)             ; Restore old *error* handler
(command "UCS" "V")
(C:ROV)
   (princ)
)


(defun c:ROV ( / ss2 i vta tmp)
  (vl-load-com)
  (prompt "\n Select TEXT and MTEXT to rotate ")
  (setq ss2 (ssget '((0 . "*TEXT")))
        i   0
        vta (- 0 (getvar "viewtwist"))
  )
  (repeat (sslength ss2)
    (setq tmp (vlax-ename->vla-object (ssname ss2 i)))
    (if (eq (vla-get-ObjectName tmp) "AcDbText")
      (progn
        (vlax-put tmp "Rotation" vta)
        (vlax-put tmp "Alignment" acAlignmentBottomCentre)
      )
      (progn
        (vlax-put tmp "Rotation" 0.0)
        (vlax-put tmp "AttachmentPoint" acAttachmentPointBottomCentre)
      )
    )
    (setq i (1+ i))
  )
)

UT and TT commands also solved -

(DEFUN C:TT (/ *error* )
  (setvar "cmdecho" 0)
  ;(command "ucs" "w")
  (LM:startundo (LM:acdoc))
  ;error control
    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (setvar "cmdecho" 1)
        ;(command "ucs" "p")
        (princ)
    )


(GRAPHSCR)


 (SETQ lll (GETVAR"CLAYER"))
 (SETQ OSM (GETVAR"OSMODE"))
 (COMMAND "OSNAP" "NONE") 
 (command "layer" "m" "GTEXT" "")


 (setq edp(getpoint "\n pick point for first text - "))
 (setq txt (getstring t "\n input text - "))
 (COMMAND "TEXT" "C" EDP "" 0.0 TXt)

 (setq e(entget(entlast)))
	(setq en2(cdr(assoc -1 e)))
	(setq en3(entget en2))   
	(SETQ TYPE1 (CDR (ASSOC 0 EN3)))
		(textun)


   (SETVAR "OSMODE" OSM)
   (COMMAND "LAYER" "S" lll "")
   (setq *error* olderr)             ; Restore old *error* handler


   (setvar "cmdecho" 1)
   ;(command "ucs" "p")
   (LM:endundo (LM:acdoc))
   (princ)
)

(defun textun ()
  (vl-load-com)
  (setq txt (getstring t "\n input text - "))  ;if you want space bar in text (getstring t "\n input text"))
  (if (= txt "")
     (progn (princ "\n end process \n"))
     (progn
  (setq ss0 (ssadd en2))
  (setq textsize (cdr (assoc 40 en3)))
  (setq textlocation (cdr (assoc 10 en3)))
  (setq putlocation (list (car textlocation) (- (cadr textlocation) (* textsize 1.5)) (caddr textlocation)))
  (command "copy" ss0 "" textlocation putlocation)
 
  (setq ename2 (entlast))
  (setq obj2 (vlax-ename->vla-object ename2))
  ;(vla-put-alignment obj2 1)
  (vla-put-textstring obj2 txt)  
  (setq en2 (vlax-vla-object->ename obj2))
  (setq en3(entget en2))   
  (textun)
  );end of progn
  );end of if
  (princ)
)


(DEFUN C:UT (/ *error*)
  (setvar "cmdecho" 0)
  ;(command "ucs" "w")
  (LM:startundo (LM:acdoc))
  ;error control
    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (setvar "cmdecho" 1)
        ;(command "ucs" "p")
        (princ)
    )



(GRAPHSCR)

;;;EXTRACT EXISTING INFORMATION


(SETQ STYLE1 (GETVAR "TEXTSTYLE"))
(SETQ LAYER1 (GETVAR "CLAYER"))
(SETQ SIZE1 (GETVAR "TEXTSIZE"))
(SETQ COL2 (GETVAR "CECOLOR"))
(SETQ COL3 (ATOI COL2))

;;;SELECT TEXT TO UNDERWRITE

	(SETQ EN1 (ENTSEL "SELECT THE TEXT TO WRITE UNDER: "))
		(WHILE (= EN1 NIL)
			(ALERT "NO TEXT SELECTED")
			(SETQ EN1 (ENTSEL "SELECT THE TEXT TO WRITE UNDER: "))	
		)

	(SETQ EN2 (CAR EN1))
	(SETQ EN3 (ENTGET EN2))


;;;CHECK TO SEE IF TEXT OR MTEXT

	(SETQ TYPE1 (CDR (ASSOC 0 EN3)))
	(IF (= TYPE1 "MTEXT")(COMMAND "DDEDIT" EN1 "")(TEXTUN))
	
;;;RESET EXISTING VALUES

(SETVAR "TEXTSIZE" SIZE1)
(SETVAR "TEXTSTYLE" STYLE1)
(SETVAR "CLAYER" LAYER1)
(SETVAR "CECOLOR" COL2)


   (setvar "cmdecho" 1)
   ;(command "ucs" "p")
   (LM:endundo (LM:acdoc))

(PRINC)

)

(DEFUN CLH (/ *error*)
  (setvar "cmdecho" 0)
  ;(command "ucs" "w")
  (LM:startundo (LM:acdoc))
  ;error control
    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (setvar "cmdecho" 1)
        ;(command "ucs" "p")
        (princ)
    )


(GRAPHSCR)

 (SETQ lll (GETVAR"CLAYER"))
 (SETQ OSM (GETVAR"OSMODE"))
 (COMMAND "OSNAP" "INTERSECTION")
 (command "layer" "m" "GTEXT" "")

  (setq edp(getpoint "TEXT AT.."))


   (COMMAND "MTEXT" edp "_Justify" "MC" "_none" "@" "Loft" "hatch" "")


(SETVAR "OSMODE" OSM)
  (COMMAND "LAYER" "S" lll "")
   (setq *error* olderr)             ; Restore old *error* handler


   (setvar "cmdecho" 1)
   ;(command "ucs" "p")
   (LM:endundo (LM:acdoc))

   (princ)
)



;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)


;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)

ВeekeeCZ · ‎03-22-2022

That's an unfortunate difference between TEXT and MTEXT definitions. In TEXT object definition is a rotation angle always in WCS, in MTEXT is changing by current UCS.

dlbsurveysuk · ‎03-22-2022

Thanks for the info. I'll have to look at that again.

dlbsurveysuk · ‎03-22-2022

PS. I'm glad to have the TT and UT routines working in any UCS but I'll probably not be using the LH routine because I've now solved the initial problem I had which made me come up with the LH routine in the first place.

I've now worked out how to constrain some text to an intersection in a dynamic block.

Community

Inserting text in a UCS

Inserting text in a UCS

Inserting text in a UCS