entmake text w/ centered justification

[hokie555]

I've got a routine where I'm placing text with bottom centered justification. The insertion point (tp) is where I want the text to be centered upon, and is being used for group code 10. How can I find group code 11? Currently it places the text anyway but breaks out of the routine (error: bad DXF group: (11)). Thanks for your help!

 

Here's what I got:

 

(setq tp (getpoint "\nSelect Text Insertion Point: "))
(setq bln (getstring "\nEnter Text: "))
 (entmake
   (list
     (cons 0 "TEXT")
     (cons 8 lyr) 
     (cons 10 tp) 
     (cons 11 tp) 
     (cons 40 0.062) 
     (cons 1 bln) 
     (cons 50 0) 
     (cons 7 "ROMANS") 
     (cons 71 0) 
     (cons 72 1) 
     (cons 73 0) 
   )
)

 

 

EDIT: hmm seems to be working now. found the error that came from somewhere else.

[The Buzzard]

hokie 555,

 

I hope you do not mind, But I made a complete function out of it. I hope this helps you.

I did not bother to add any snaps or orthomode.

 

I will be glad to answer your questions after you test it.

 

I basically created the entity with respect to 0,0,0 and moved it to the insertion point.

 

(defun C:MTCJ (/ EXDR TFBP TSBP BLN INPT)                               ;Define function (Make Text Center Justified), Declare local variables
 (setq EXDR (list 0.0 0.0 1.0))                                        ;Set extrusion direction (Needed for 3D only)
 (setq TFBP  (list 0.0 0.0 0.0))                                       ;Set text first base point
 (setq TSBP  (list -0.023619 -0.031 0.0))                              ;Set text second base point
 (MTCJ_LAYER "TEXT" "2" "")                                            ;Set layer name, color & linetype
 (MTCJ_FONT)                                                           ;Set font
 (setq BLN (getstring "\nEnter Text: "))                               ;Enter the string
 (setq INPT  (getpoint "\nSelect Text Insertion Point: "))             ;Enter the insertion point
 (entmake                                                              ;Start entity make
   (list                                                               ;Start list
     (cons 0   "TEXT")                                                 ;Entity type
     (cons 8   "TEXT")                                                 ;Layer name
     (cons 10   TSBP)                                                  ;Text second base point
     (cons 40   0.062)                                                 ;Text height
     (cons 1    BLN)                                                   ;Text string 
     (cons 50   0.0)                                                   ;Text rotation
     (cons 41   1.0)                                                   ;Relative x scale factor
     (cons 51   0.0)                                                   ;Oblique angle
     (cons 7   "ROMANS")                                               ;Text style
     (cons 71   0)                                                     ;Text generation flag
     (cons 72   1)                                                     ;Horizontal justification flag center
     (cons 11   TFBP)                                                  ;Text first base point
     (cons 210  EXDR)                                                  ;Extrusion direction (Needed for 3D)
     (cons 73   2)                                                     ;Vertical justification
   )                                                                   ;End list
 )                                                                     ;End entity make

 (command "_.move" "_l" "" TFBP INPT "")                               ;Move command, last object from text first base point to insertion point 
 (prompt "\nRotation Angle: ")                                         ;Get rotation angle
 (command "_.rotate" "_l" "" INPT pause)                               ;Rotate command, last object, rotate on insertion point
)                                                                       ;End defun
(defun MTCJ_FONT ()                                                     ;Define function (FONT)
 (command "_.STYLE" "romans" "romans.shx" "0.0" "1.0" "0" "N" "N" "N") ;style command
 (princ)                                                               ;Exit quietly
)                                                                       ;End defun
(defun MTCJ_LAYER (NLAY CLR LT / LAY FRZ)                               ;Define function (Make Layer), Declare local varibles & arguments
 (setq LAY (tblsearch "layer" NLAY))                                   ;Search drawing for layer
 (if (not LAY)                                                         ;If layer not found
   (command "_.-layer" "_m" NLAY "_c" CLR "" "_lt" LT "" "")           ;Make layer, color & linetype
   (progn                                                              ;Then do the following
     (setq FRZ (cdr (assoc 70 LAY)))                                   ;Look for frozen layers from last edit
     (if (= FRZ 65)                                                    ;if any layers frozen
       (progn                                                          ;Then do the following
         (command "_.-layer" "_t" NLAY "")                             ;Thaw layer
         (command "_.-layer" "_s" NLAY "")                             ;Set layer
       )                                                               ;End progn
       (command "_.-layer" "_s" NLAY "")                               ;Set layer
     )                                                                 ;End if
   )                                                                   ;End progn
 )                                                                     ;End if
 (princ)                                                               ;Exit quietly
)                                                                       ;End defun

[The Buzzard]

If this helps any, This is how I get the entity list.

 

(defun C:pdxf (/ pick)
 (if (setq pick (car (entsel "\nSelect Object: ")))
   (progn (textscr)
   (foreach x (entget pick)
     (print x))))
 (princ))

 

 

Run this program and select the entity.

A list will be returned.

[The Buzzard]

Sorry,

 

This one is bottom centered. The first code was middle centered.

 

Sorry for the mix up.

 

Type MTBC for this code.

 

(defun C:MTBC (/ EXDR TFBP TSBP BLN INPT)                               ;Define function (Make Text Center Justified), Declare local variables
 (setq EXDR (list 0.0 0.0 1.0))                                        ;Set extrusion direction (Needed for 3D only)
 (setq TFBP (list 0.0 0.0 0.0))                                        ;Set text first base point
 (setq TSBP (list -0.023619 0.0206667 0.0))                            ;Set text second base point
 (MTCJ_LAYER "TEXT" "2" "")                                            ;Set layer name, color & linetype
 (MTCJ_FONT)                                                           ;Set font
 (setq BLN  (getstring "\nEnter Text: "))                              ;Enter the string
 (setq INPT (getpoint "\nSelect Text Insertion Point: "))              ;Enter the insertion point
 (entmake                                                              ;Start entity make
   (list                                                               ;Start list
     (cons 0   "TEXT")                                                 ;Entity type
     (cons 8   "TEXT")                                                 ;Layer name
     (cons 10   TSBP)                                                  ;Text second base point
     (cons 40   0.062)                                                 ;Text height
     (cons 1    BLN)                                                   ;Text string 
     (cons 50   0.0)                                                   ;Text rotation
     (cons 41   1.0)                                                   ;Relative x scale factor
     (cons 51   0.0)                                                   ;Oblique angle
     (cons 7   "ROMANS")                                               ;Text style
     (cons 71   0)                                                     ;Text generation flag
     (cons 72   1)                                                     ;Horizontal justification flag center
     (cons 11   TFBP)                                                  ;Text first base point
     (cons 210  EXDR)                                                  ;Extrusion direction (Needed for 3D)
     (cons 73   1)                                                     ;Bottom justification
   )                                                                   ;End list
 )                                                                     ;End entity make
 (command "_.move" "_l" "" TFBP INPT "")                               ;Move command, last object from text first base point to insertion point 
 (prompt "\nRotation Angle: ")                                         ;Get rotation angle
 (command "_.rotate" "_l" "" INPT pause)                               ;Rotate command, last object, rotate on insertion point
)                                                                       ;End defun
(defun MTCJ_FONT ()                                                     ;Define function (FONT)
 (command "_.STYLE" "romans" "romans.shx" "0.0" "1.0" "0" "N" "N" "N") ;style command
 (princ)                                                               ;Exit quietly
)                                                                       ;End defun
(defun MTCJ_LAYER (NLAY CLR LT / LAY FRZ)                               ;Define function (Make Layer), Declare local varibles & arguments
 (setq LAY (tblsearch "layer" NLAY))                                   ;Search drawing for layer
 (if (not LAY)                                                         ;If layer not found
   (command "_.-layer" "_m" NLAY "_c" CLR "" "_lt" LT "" "")           ;Make layer, color & linetype
   (progn                                                              ;Then do the following
     (setq FRZ (cdr (assoc 70 LAY)))                                   ;Look for frozen layers from last edit
     (if (= FRZ 65)                                                    ;if any layers frozen
       (progn                                                          ;Then do the following
         (command "_.-layer" "_t" NLAY "")                             ;Thaw layer
         (command "_.-layer" "_s" NLAY "")                             ;Set layer
       )                                                               ;End progn
       (command "_.-layer" "_s" NLAY "")                               ;Set layer
     )                                                                 ;End if
   )                                                                   ;End progn
 )                                                                     ;End if
 (princ)                                                               ;Exit quietly
)                                                                       ;End defun

[alanjt]

This might also help for object info extraction:

 

;;; VLA & DXF Info of selected Primary or Nested object
;;; Alan J. Thompson
(defun c:Info (/ #Choice #Obj)
 (vl-load-com)
 (initget 0 "Nested Primary")
 (and (or (setq #Choice (getkword "\nNested or Primary object [Nested/<Primary>]: "))
          (setq #Choice "Primary")
      ) ;_ or
      (cond
        ((eq #Choice "Primary")
         (setq #Obj (entsel "\nSelect Primary object for VLA & DXF info: "))
        )
        ((eq #Choice "Nested")
         (setq #Obj (nentsel "\nSelect Nested object for VLA & DXF info: "))
        )
      ) ;_ cond
      (not (textscr))
      (princ "\nVLA Info:\n\n")
      (vlax-dump-object (vlax-ename->vla-object (car #Obj)) T)
      (princ "\nDXF Info:\n")
      (mapcar 'print (entget (car #Obj)))
 ) ;_ and
 (princ)
) ;_ defun

[The Buzzard]

This might also help for object info extraction:

 

;;; VLA & DXF Info of selected Primary or Nested object
;;; Alan J. Thompson
(defun c:Info (/ #Choice #Obj)
 (vl-load-com)
 (initget 0 "Nested Primary")
 (and (or (setq #Choice (getkword "\nNested or Primary object [Nested/<Primary>]: "))
          (setq #Choice "Primary")
      ) ;_ or
      (cond
        ((eq #Choice "Primary")
         (setq #Obj (entsel "\nSelect Primary object for VLA & DXF info: "))
        )
        ((eq #Choice "Nested")
         (setq #Obj (nentsel "\nSelect Nested object for VLA & DXF info: "))
        )
      ) ;_ cond
      (not (textscr))
      (princ "\nVLA Info:\n\n")
      (vlax-dump-object (vlax-ename->vla-object (car #Obj)) T)
      (princ "\nDXF Info:\n")
      (mapcar 'print (entget (car #Obj)))
 ) ;_ and
 (princ)
) ;_ defun

 

Great program Alan,

 

I have something new for my toolbox.

 

Thanks!

[alanjt]

Great program Alan,

 

I have something new for my toolbox.

 

Thanks!

 

You're quite welcome.

I use it all the time.

[The Buzzard]

You're quite welcome.

I use it all the time.

 

Its very versatile as it can be used for nested as well as primary &

dxf as well as vla. This will help me greatly in learning vla.

[alanjt]

Its very versatile as it can be used for nested as well as primary &

dxf as well as vla. This will help me greatly in learning vla.

 

I'm lazy so I always make sure I can stick everything in one nice little package.

 

Dig through my subroutine thread, there's a lot of VLA subroutines in there.

[The Buzzard]

I'm lazy so I always make sure I can stick everything in one nice little package.

 

Dig through my subroutine thread, there's a lot of VLA subroutines in there.

 

 

I run out now to check out the sales!

[The Buzzard]

This is the same as your method.

No rotation involved.

 

Just type MT.

 

(defun C:MT (/ BLN INPT)                                                ;Define function
 (MTCJ_LAYER "TEXT" "2" "")                                            ;Set layer name, color & linetype
 (MTCJ_FONT)                                                           ;Set font
 (setq BLN  (getstring "\nEnter Text: "))                              ;Enter the string
 (setq INPT (getpoint "\nSelect Text Insertion Point: "))              ;Enter the insertion point
 (entmake                                                              ;Start entity make
   (list                                                               ;Start list
     (cons 0   "TEXT")                                                 ;Entity type
     (cons 8   "TEXT")                                                 ;Layer name
     (cons 10   INPT)                                                  ;Text second base point
     (cons 40   0.062)                                                 ;Text height
     (cons 1    BLN)                                                   ;Text string 
     (cons 50   0.0)                                                   ;Text rotation
     (cons 41   1.0)                                                   ;Relative x scale factor
     (cons 51   0.0)                                                   ;Oblique angle
     (cons 7   "ROMANS")                                               ;Text style
     (cons 71   0)                                                     ;Text generation flag
     (cons 72   1)                                                     ;Horizontal justification flag center
     (cons 11   INPT)                                                  ;Text first base point
     (cons 73   1)                                                     ;Bottom justification
   )                                                                   ;End list
 )                                                                     ;End entity make
)                                                                       ;End defun
(defun MTCJ_FONT ()                                                     ;Define function (FONT)
 (command "_.STYLE" "romans" "romans.shx" "0.0" "1.0" "0" "N" "N" "N") ;style command
 (princ)                                                               ;Exit quietly
)                                                                       ;End defun
(defun MTCJ_LAYER (NLAY CLR LT / LAY FRZ)                               ;Define function (Make Layer), Declare local varibles & arguments
 (setq LAY (tblsearch "layer" NLAY))                                   ;Search drawing for layer
 (if (not LAY)                                                         ;If layer not found
   (command "_.-layer" "_m" NLAY "_c" CLR "" "_lt" LT "" "")           ;Make layer, color & linetype
   (progn                                                              ;Then do the following
     (setq FRZ (cdr (assoc 70 LAY)))                                   ;Look for frozen layers from last edit
     (if (= FRZ 65)                                                    ;if any layers frozen
       (progn                                                          ;Then do the following
         (command "_.-layer" "_t" NLAY "")                             ;Thaw layer
         (command "_.-layer" "_s" NLAY "")                             ;Set layer
       )                                                               ;End progn
       (command "_.-layer" "_s" NLAY "")                               ;Set layer
     )                                                                 ;End if
   )                                                                   ;End progn
 )                                                                     ;End if
 (princ)                                                               ;Exit quietly
)                                                                       ;End defun

[The Buzzard]

It seems to me the problem with your code is that you have DXF code 11 imediately after 10.

 

Here in this example I create a letter on 0,0,0 and run the PDXF program to see the list returned.

Notice where dxf 11 is in your list.

Notice where dxf 11 is in the list.

Although you can remove non-essential dxf codes from it, 11 must remain in its order in the list.

 

Here is yours.
;
(entmake
   (list
     (cons 0 "TEXT")
     (cons 8 lyr) 
     (cons 10 tp) 
     (cons 11 tp) 
     (cons 40 0.062) 
     (cons 1 bln) 
     (cons 50 0) 
     (cons 7 "ROMANS") 
     (cons 71 0) 
     (cons 72 1) 
     (cons 73 0) 
   )
)
;
;
Here is the list generated with PDXF.lsp
;
(0 . "TEXT")
(330 . <Entity name: 7ef59cf8>)
(5 . "28C")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "TEXT")
(100 . "AcDbText")
(10 -0.0177143 0.0206667 0.0)
(40 . 0.062)
(1 . "t")
(50 . 0.0)
(41 . 1.0)
(51 . 0.0)
(7 . "romans")
(71 . 0)
(72 . 1)
(11 0.0 0.0 0.0)
(210 0.0 0.0 1.0)
(100 . "AcDbText")
(73 . 1)

 

You should have dxf 11 after dxf 72.

This is where I think your problem is.

You must not change the order of the list.

Thats why I believe you are getting a DXF 11 error.

But I am not exactly sure.

[The Buzzard]

In this image, The coodinate locations for bottom centered text are as shown.

 

DXF 11 would be where your insertion point should be. I am not sure if dxf 10 is really that important since the length of text can vary. So one would think that even the coordinates used in dxf 11 would be fine for 10 as well. I prefer to position the text at 0,0,0 the same way you would create a block and provide the correct coordinate given to me from the PDXF.lsp. I just move the text from coordinate dxf 11 to the insertion point. This way I am sure there are no problems.

 

Seems to me it can be done the other way using one set of coordinates although I would not feel comfortable with that. Its upto you.

[VVA]

another example

(defun mip-text-entmake (txt pnt height rotation justification / ent_list)
 ;;; borrowed from ShaggyDoc
 ;;; http://www.caduser.ru/forum/index.php?PAGE_NAME=read&FID=23&TID=30276
 ;;; Draw text with entmake Lisp function
 ;;; Arguments:
 ;;; txt - text string
 ;;; pnt - point in WCS
 ;;; height - text height
 ;;; rotation - rotation angle
 ;;; justification - justification or nil

 (setq  ent_list (list  '(0 . "TEXT")
    '(100 . "AcDbEntity")
    '(100 . "AcDbText")
    (list 10 (car pnt) (cadr pnt) 0.0)
    (cons 1 txt)
    (cons 40 height)
    (cons 7 (getvar "TEXTSTYLE"))
    (if justification
      (cond
        ((= justification "C")
         '(72 . 1)
        )
        ((= justification "R")
         '(72 . 2)
        )
        ((= justification "A")
         '(72 . 3)
        )
        ((= justification "M")
         '(72 . 4)
        )
        ((= justification "F")
         '(72 . 5)
        )
        (t
         '(72 . 0)
        )
      ) ;_ end of cond
      '(72 . 0)
    ) ;_ end of if
    (cons 50 rotation)
    (list 11 (car pnt) (cadr pnt) 0.0)
    ) ;_ end of list
  ) ;_ end of setq
  (setq ent_list (entmakex ent_list))
)

;;;TEST
(defun C:TEST ()
 (and
   (setq pt (getpoint "\nPick center text point: "))
   (setq pt (trans pt 1 0))
   (mip-text-entmake
     "TEST TEXT"           ;;; text
      pt                   ;;; point
     (getvar "TEXTSIZE") ;;; heigth
     0                     ;;; rotation
     "C"                   ;;; justification
     )
   )
 )

Type TEST in command line

[hokie555]

Thank you very much folks! Learning something new everyday.

[rrulep]

Hello!!

I modified this lisp by adding an option to offset the text from alignment.

What I want is to set the justification of the text to middle left. When I change the value of 73 to any number other than 0, all text were place at 0, 0>

I also want to add an option where to position the text whether it is on the right side of the alignment or on the left side.

Hope to hear from you soon guys.

Thank you

 

(defun c:CH4 (/)
(vl-load-com)
(defun _Line (p b o)
      (entmake
 (append
   '((0 . "line")
     (100 . "AcDbEntity")
     (67 . 0)
     (410 . "Model")
     (8 . "C-CTRL_TICK")
     (100 . "AcDbLine")
     )
   (list (cons 10 (polar p b o)))
   (list (cons 11 (polar p (+ b PI) o)))
   '((210 0.0 0.0 1.0))
   )
 )
 )
(defun _text (p b o h c)
      (entmake
 (append
   '((0 . "TEXT")
     (100 . "AcDbEntity")
     (67 . 0)
     (410 . "Model")
     (7 . "Standard Arial")
     (8 . "C-CTRL_TXT")
     (100 . "AcDbText")
     )
   (list (cons 10 (polar p (+ b PI) (* o 1.0)))
  )
   (list (cons 40 h))
   (list (cons 1 (strcat "CH "
    (if (setq ld (nth (strlen (rtos  c 2 0)) '(x   "")))
       ld "")
    (rtos c 2 2))))
   (list (cons 50 (+ b PI)))

   '((41 . 1.0)
     (51 . 0)
     (71 . 0)
     (72 . 0)
     (11 0.0 0.0 0.0)
     (210 0.0 0.0 1.0)
     (100 . "AcDbText")
     (73 . 0)
     )
   )
 )
 )
(defun _ang (p1 p2)(+ (angle p1 p2) (/ (* 3 PI) 2)))

(setq dist (getdist "increment: "))
 (setq offset (getdist "tick size: "))
 (setq height (getdist "text height: "))
 (setq to (getdist "text offset: "))
 (setq ss (ssget)
count 0
dist dist
offset offset
height height
)
 (repeat (sslength ss)
   (setq ent    (ssname ss count)
  obj    (vlax-ename->vla-object ent)
  chainage dist
  )
   (_line (setq p (vlax-curve-getstartpoint obj))
   (setq bearing (_ang p (vlax-curve-getPointAtDist obj (+ chainage 0.001))))
    offset)
   (_text p bearing to height 0.0)
   (while
     (and
(setq point1 (vlax-curve-getPointAtDist obj chainage))
(setq point2 (vlax-curve-getPointAtDist obj (+ chainage 0.001)))
)
      (setq bearing (+ (angle point1 point2)  (/ (* 3 PI) 2)))
      (_line point1 bearing offset)
      (_text point1 bearing to height chainage)

      (setq chainage (+ chainage dist))
      )
   (setq count (1+ count))
   )
 )

Edited April 29, 2014 by rrulep
to comply with the code posting guidelines

[Tomislav]

i have a question not directly related to this but it's related to text management...how can i find out the length of text if i want to draw a line under it that would be exactly long as text?

and, yeah, great stuff Alan for that Info.lsp!

[SLW210]

rrulep,

 

Please read the CODE POSTING GUIDELINES and edit your post to include the Code in Code Tags.

[Nabin Maharjan]

Dear all,

I wonder to know, how to place multi strings with space while inserting text?

while pressing space gets to next step

i want to add words...

is it possible?