Jump to content

insert text from a lisp


morgos

Recommended Posts

is it possible to insert text automatically from a lisp,

I tried this but does not work....

 

(command "dtext" 
    pt1 ; variable for insertion point

           "" ; scale
           "" ; rotation
    pt1Z ; variable for text
    ""

 

I got the cursor to insert the text manually,

Edited by SLW210
Link to comment
Share on other sites

  • Replies 23
  • Created
  • Last Reply

Top Posters In This Topic

  • Lee Mac

    5

  • CAB

    3

  • morgos

    3

  • Chiron

    2

Top Posters In This Topic

Hi morgos, and welcome to CADtutor,

 

If I were you, I would use entmake to insert your text, as it is far more reliable. - sometimes the in-built ACAD text insertor will assume a text height or rotation or both, hence screwing with the order of your prompts.

Link to comment
Share on other sites

Something like this:

 

(defun c:txt (/ *error* varlist oldvars pt1 tval)
   (defun *error* (msg)
   (mapcar 'setvar varlist oldvars)
   (if (= msg "")
       (princ "\nText Inserted.")
       (princ "\nEsc or Error Pressed...")
   ) ;_  end if
   (princ)
   ) ;_  end defun
   (setq varlist (list "CMDECHO" "CLAYER")
     oldvars (mapcar 'getvar varlist)
   ) ;_  end setq
   (while (and    (/= (setq pt1 (getpoint "\nSelect Insertion Point: ")) nil)
       (/= (setq tval (getstring t "\nSpecify Text: ")) "")
      ) ;_  end and
[b][color=Blue]    (if (not (tblsearch "Layer" "TEXT"))
       (command "-layer" "m" "TEXT" "")
   ) ;_  end if[/color][/b]
   (entmake (list '(0 . "TEXT")
              '(8 . "[b][color=Red]TEXT[/color][/b]") [b][color=Red]; Change this for different Layer[/color][/b] [color=SeaGreen][i](type layer name in quote marks)[/i][/color]
              (cons 10 pt1)
              (cons 40 [b][color=Red](getvar "TEXTSIZE")[/color][/b]) [b][color=Red]; Change this for different height[/color][/b] [i][color=SeaGreen](set at default text size, change all red parts to just a number, i.e. (cons 40 2.5)[/color][/i]
              (cons 1 tval)
              '(50 . 0.0)
              '(7 . "[b][color=Red]STANDARD[/color][/b]") [b][color=Red]; change this for different Text Style[/color][/b] [color=SeaGreen][i](type style name in quote marks)[/i][/color]
              '(71 . 0)
              '(72 . 0)
              '(73 . 0)
        ) ;_  end list
   ) ;_  end entmake
   ) ;_  end while
   (*error* "")
   (princ)
) ;_  end defun

Remove the blue lines if you do not wish for a Text layer to be created (if there isn't a TEXT layer already), and change the red parts to suit your needs accordingly :)

Link to comment
Share on other sites

here's the 2 subroutines i use:

MTEXT

(defun makeMTEXT (pt txt width txtsize / entl)
 (setq entl (list
              '(0 . "MTEXT")
              '(100 . "AcDbEntity")
              '(100 . "AcDbMText")
              (cons 10 pt)
  &nb22)
               (cons 1 val2)
               (cons 7 tstyle)
               (cons 10 p1)
               (cons 40 theight)
               (cons 41 1)
               (cons 50 0)
        )
 )
 (entmake txt1)
)

Link to comment
Share on other sites

I too would use entmakex but to use the command use this:

 ;; If text height is undefined (signified by 0 in the table) 
 (if (zerop (cdr(assoc 40(tblsearch "style" (getvar "textstyle")))))
   ;; Draw the text using the current text height (textsize) 
   (command ".text" "c" "_non" txtpt "" L_Angle txt)
   ;; Otherwise use the defined text height 
   (command ".text" "c" "_non" txtpt L_Angle txt)
 ) ; endif 

Link to comment
Share on other sites

thanks all for the quick reply,

I just started my working day,

thanks Lee for your neat and complete code,

I will try all this later in the day,

 

 

Morgos.

Link to comment
Share on other sites

I too would use entmakex but to use the command use this:

 ;; If text height is undefined (signified by 0 in the table) 
 (if (zerop (cdr(assoc 40(tblsearch "style" (getvar "textstyle")))))
   ;; Draw the text using the current text height (textsize) 
   (command ".text" "c" "_non" txtpt "" L_Angle txt)
   ;; Otherwise use the defined text height 
   (command ".text" "c" "_non" txtpt L_Angle txt)
 ) ; endif 

 

Nice one CAB, a smaller and simpler solution to my LISP - but what is the difference between entmakex and entmake?

Link to comment
Share on other sites

Thanks everyone,

I was busy doing something else the last week,

my intention was to insert the Z value (as text) of some points from a text file " the insertion point is the point itself ",

I managed to make it works,

Lee's code was very helpfull as well as everyone's else comments,

thanks all again,

here is my final code for the benifit of everyone at CadTutor,

 

 

 

(defun c:spot ( / pt1 file1)
(if (not (tblsearch "Layer" "TEXT"))
(command "-layer" "m" "TEXT" "")
) 

(setq file1 (open "E:\\Morgos\\AutoCadd\\sh.csv" "r"))
(setq pt1 (read-line file1))
(while 
(/= pt1 nil)
(setq pt (read-line file1))
(setq sx (substr pt 1 9))
(setq sy (substr pt 13 22))
(setq sz (substr pt 26 31))

(setq fx (atof sx))
(setq fy (atof sy))
(setq fz (atof sz))
(setq Lpt (list fx fy fz))
(entmake (list '(0 . "MTEXT")
'(100 . "AcDbEntity")
'(100 . "AcDbMText")
'(8 . "TEXT")
(cons 10 Lpt)
'(40 . 2.5) 
(cons 1 sz)
'(50 . 0.0)
'(7 . "STANDARD") 
'(71 . 0)
'(72 . 0)
'(73 . 0)
) ;_ end list
) ;_ end entmake
) ;_ end while
(princ) 
) ;_ end defun

Edited by SLW210
Link to comment
Share on other sites

  • 4 years later...

By the way, how can we insert text with current "TEXTWIDTH" by using your make-text function?

(defun make_text  (txt_pt txt_val)
 (entmake (list '(0 . "TEXT")
                '(8 . "0")
                (cons 10 txt_pt)
                (cons 40 (max 2.5 (getvar "TEXTSIZE")))
                (cons 1 txt_val)
                '(50 . 0.0)
                '(7 . "STANDARD")
                '(71 . 0)
                '(72 . 1)
                '(73 . 2)
                (cons 11 txt_pt))))

Link to comment
Share on other sites

I solved already: (assoc 41 (tblsearch "Style" (getvar "textstyle")))

But I have other problem: It doesn't work well with shx font. Text is created with wrong position, text is corrected after we double click on it.

Link to comment
Share on other sites

  • 1 year later...

First, thx for that code Leemac. I have a question. on the line

 

'(8 . "TEXT") ; Change this for different Layer (type layer name in quote marks)

 

I tried using (getvar "CLAYER") instead of "TEXT" and I get the following error

 

Command: ; error: bad DXF group: (8 GETVAR "CLAYER")

 

can I not use getvar here?

Link to comment
Share on other sites

My $0.05 I would add the make text defun to a autoload lsp routine that has all your library of common used stuff, this way you just have to do 1 line as a call to use it. (make_text (txt_pt txt_val)). Another (insertblock ins_pt blkname x y ro)

 

As an example I have a "getval" defun that pops a nice dialouge box for input rather than using the getxxxx it pops in middle of screen with message etc. (thanks AlanJT)

Link to comment
Share on other sites

  • 3 years later...

Hello.

In my program, I use the insertion of text on the cursor, But there is a problem.

The program is executed completely once, the second time is simply completed after entering the height of the text. I do not understand why.

Here is part of the code where this error occurs:

(if 
       (setq *ht*
         (cond
           ((getdist (strcat "\nSpecify the height of the text <" (if *ht* (rtos *ht* 2 3) "") ">:[0.5/1.0/1.5/2.0/2.5/3.0]")))
           (*ht*)
         )
       )
       (progn
         (setq e
           (entmakex
             (list
               '(0 . "MTEXT")
               '(100 . "AcDbEntity")
               '(100 . "AcDbMText")
               (cons 8 "Area")
               (cons 62 256)
               (cons 10 '(0 0 0))
               (cons 7 (getvar 'textstyle))
               (cons 40 *ht*)
               (cons 41 0)
               (cons 1
                     (strcat
                       "Land area is : " oar decl
                 )
               )
             )
           )
         )
         (setq e (vlax-ename->vla-object e))
         (grread t)
          (while (not enter)
           (princ "\nSpecify the insertion point of the text...")
           (setq grp (grread T 5 0)
                 reason (car grp)
                 value (cadr grp)
           )
           (cond
             ((or (member reason '(11 12 25)) (= value 13) (= value 32)) (vla-delete e) (setq enter t)) 
             ((= reason 5) (vlax-put e 'InsertionPoint (trans value 1 0)))
             ((= reason 3) (setq enter t))
           )
         )
       )
       (princ
         (strcat
           "\n\tLand area is : " oar decl
		
         )
       )
    )

Please tell me why this problem occurs.

Thank you

Link to comment
Share on other sites

Hello.

In my program, I use the insertion of text on the cursor, But there is a problem.

The program is executed completely once, the second time is simply completed after entering the height of the text. I do not understand why.

Here is part of the code where this error occurs:


          (while [color="red"](not enter)[/color]
           (princ "\nSpecify the insertion point of the text...")
           (setq grp (grread T 5 0)
                 reason (car grp)
                 value (cadr grp)
           )
 

Please tell me why this problem occurs.

Thank you

 

hi, perhaps 'enter' variable not localizes ?

(defun c:test (  / [color="red"] enter[/color] )
...
...
([color="blue"]while[/color] ( not[color="red"] enter [/color])
...
...

 

or try this after while loop..

(setq enter nil)

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...