Jump to content

Text: multiple insertion


Romero

Recommended Posts

Good afternoon. I'm having a bit of trouble with a Lisp routine that I require for my needs.
Maybe a good Samaritan can tell me which is the right path.

 

The routine is designed to do the following:

; Insert desired text, from a list available in Dlg.dlc
; Use the current text style (with defined height)
; In case of not having Height, manual entry is allowed to indicate height
; Everything is established in a new layer: _TEXTOS
; If you want to change Text: Right click to access the list
; A clean output restoring variables to their original state.

 

With the help of forums I started a bit, but I have problems inserting the text (I can not insert it)
Like I do not know how to set a height if it is detected that the current style does not.

I appreciate any help. I will continue practicing to improve

 

;Crea y/o establece el layer actual en "_TEXTOS" _____________________________________________________

(defun nlay ( )
(command "._layer" "_M" "_TEXTOS" "_C" "7" "" "")
(setvar "clayer" "_TEXTOS"));end


;Preguntar al usuario si el estio tiene Altura_________________________________________________________

(defun qst ()
(initget "Si No")
      (setq eath (getkword "\nESTILO DE TEXTO ACTUAL TIENE ALTURA? [Si/No] <Si>: "));Estilo actual tiene H 

(if 
(= eath "No") (dnh) 
);end if  
);end 

;establece altura de texto cuando el estilo no lo tiene______________________________________________

(defun dnh (/ ph)
(setq dnht (getdist "\nAltura de Texto: <0.18>: "); Define Nueva H texto
	dnht (if (null ph) 0.18 ph))
(setvar 'textsize dnht)
);end

;=======================================================================================================

(defun c:txt3 ( / *error*  lista nfile fdesc id salida pt tmp txthgt) ;Define comando y funciones
	
;; Error handler
  
(defun *error* (msg)
    (mapcar 'setvar vars vals)
    (if	(not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )
 
;; Guarda y establece variables
  
(setq vals (mapcar 'getvar (setq vars '(clayer orthomode luprec textsize tspacefac orthomode))))
  


(nlay)
(qst)
(dnh)
(setq lista '(
					  "TEXTO1"
					  "TEXTO2"
					  "TEXTO3"
					  "TEXTO4"
					  "TEXTO5"
					  "TEXTO6"
					  "TEXTO7"
					  "TEXTO8"
					  "TEXTO7"
					  "TEXTO8"
					  "TEXTO9"
					  "TEXT10"
					 )
	)

	(setq nfile (vl-filename-mktemp "Dlg.dcl")
			fdesc (open nfile "w")
	)
	(write-line "lista :dialog{ :list_box{key=\"lst\";multiple_select=false; width=30;} :button{label=\"Salir\"; key=\"cancel\"; is_cancel=true;}     }" fdesc)
	(close fdesc)

	(setq id (load_dialog nfile)
			salida 0
	)
	
	
	(while (>= salida 0)
		(new_dialog "lista" id)
		(start_list "lst" 3)
		(mapcar 'add_list lista)
		(end_list)
		(action_tile "lst" "(if (> (strlen $value) 0) (done_dialog (atoi $value)) )")
		(action_tile "cancel" "(done_dialog -1)")

		(if (>= (setq salida (start_dialog)) 0)
			(while (setq pt (getpoint))
				(entmake
					(list
						'(0 . "MTEXT")
						'(100 . "AcDbEntity")
						'(100 . "AcDbMText")
						(cons 10 pt)
						(cons 40 txthgt)
						'(41 . 0)
						'(71 . 1)
						(cons 1 (nth salida lista))
						'(50 . 0)
					)
				)
			)
		)
	)

	(unload_dialog id)
	(vl-file-delete nfile)
)

 

Link to comment
Share on other sites

Since you are changing the value of the TEXTSIZE system variable to the appropriate height as part of your 'dnh' function, you can simply omit DXF group 40 from the MTEXT DXF data supplied to entmake and the resulting text height will be inherited from the TEXTSIZE system variable (note that this only applies to MTEXT, for which DXF group 40 is optional).

Edited by Lee Mac
  • Like 1
Link to comment
Share on other sites

you use txthgt in cons group 40 but txthgt is never initialized. So ...


; Crea y/o establece el layer actual en "_TEXTOS" _____________________________________________________
; create or make current layer "_TEXTOS"
(defun nlay ( )(command "._layer" "_M" "_TEXTOS" "_C" "7" "" "")(setvar "clayer" "_TEXTOS"))

; Preguntar al usuario si el estio tiene Altura_________________________________________________________
; ask user if style has height

(defun qst ()
  ;Estilo actual tiene H
  ;(initget "Si No")(setq eath (getkword "\nESTILO DE TEXTO ACTUAL TIENE ALTURA?? [Si/No] <Si>: "))
  (initget "Yes No")(setq eath (getkword "\nDoes current textstyle have a fixed height? [Yes/No] <Yes>: "))
  (if (= eath "No") (dnh))
)

; establece altura de texto cuando el estilo no lo tiene______________________________________________
; set text height when the style does not have it

(defun dnh (/ ph)
  ;(setq dnht (getdist "\nAltura de Texto: <0.18>: "); Define Nueva H texto
  ;      dnht (if (null ph) 0.18 ph))
  (or txthgt (if (null (setq txthgt (getdist "\nText height : <0.18>: ")))(setq txthgt 0.18)))
  (setvar 'textsize txthgt)
);end

;=======================================================================================================

(defun c:txt3 ( / *error*  lista nfile fdesc id salida pt tmp txthgt) ;Define comando y funciones
  ;; Error handler
  (defun *error* (msg)
    (mapcar 'setvar vars vals)
    (if    (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))(princ (strcat "\nError: " msg)))
    (princ)
  )
 
  ;; Guarda y establece variables
  ;; Save and set variables
  (setq vals (mapcar 'getvar (setq vars '(clayer orthomode luprec textsize tspacefac orthomode))))
  (nlay)(qst)(dnh)
  (setq lista '("TEXTO1" "TEXTO2" "TEXTO3" "TEXTO4" "TEXTO5" "TEXTO6" "TEXTO7" "TEXTO8"
                                                                      "TEXTO7" "TEXTO8" "TEXTO9" "TEXT10"))
  (setq nfile (vl-filename-mktemp "Dlg.dcl") fdesc (open nfile "w"))
  (write-line
    "lista :dialog {:list_box{key=\"lst\";multiple_select=false;width=30;}:button{label=\"Salir\";key=\"cancel\";is_cancel=true;}}"
    fdesc)
  (close fdesc)
  (setq id (load_dialog nfile) salida 0)
  (while (>= salida 0)
    (new_dialog "lista" id) (start_list "lst" 3) (mapcar 'add_list lista) (end_list)
    (action_tile "lst" "(if (> (strlen $value) 0) (done_dialog (atoi $value)) )")
    (action_tile "cancel" "(done_dialog -1)")
    (if (>= (setq salida (start_dialog)) 0)
      (while (setq pt (getpoint))
        (entmake (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(100 . "AcDbMText") (cons 10 pt)(cons 40 txthgt)
                       '(41 . 0) '(71 . 1) (cons 1 (nth salida lista)) '(50 . 0))))))
  (unload_dialog id)(vl-file-delete nfile)
)

two things... use english in your code when posting here. Don't think people like to first have to translate.

second thing (the right click thing)... can be done with using grread (homework) , but you would need extra code for catching cancel.

 

 

  • Like 1
Link to comment
Share on other sites

On 5/11/2019 at 4:26 PM, Lee Mac said:

Since you are changing the value of the TEXTSIZE system variable to the appropriate height as part of your 'dnh' function, you can simply omit DXF group 40 from the MTEXT DXF data supplied to entmake and the resulting text height will be inherited from the TEXTSIZE system variable (note that this only applies to MTEXT, for which DXF group 40 is optional).

 

Thanks for answering. I'll keep it in mind, same time I try to solve that; but I still have difficulties.

Edited by Romero
Link to comment
Share on other sites

@rlx  Thank you. The code still does not work for me as I wish, but you already gave me an idea. The right click if it works, but I still have problems with the height and style of text.
I will be using English in my future publications. I appreciate the hassle in helping.

Link to comment
Share on other sites

@Lee Mac 

Thank you very much for your observations. I worked a bit on the code and it works for me; however, I still have some difficulties and I hope you can support me. I would appreciate it enough.
The problems I have are the following:
- I can not solve that the text is inserted with the current style and height. (They are inserted with "standard" style)
- When doing the repetition cycle to insert the next text the text height legend always appears, however, I would like to put a legend that says "next point".
- The change of text option with right click and error control to reset values is working well for me.

I still learn some things. Sorry for the inconvenience. 🙃

 ;Insert desired text, from a list available in Dlg.dlc
 ;Uses the current text style (with defined height)
 ;If there is no Height, manual entry is allowed to indicate height
 ;Everything is established in a new layer: _TEXTOS
 ;If you want to change text: Right click to access the list


 ;;Create and / or set the current layer in "TEXTOS"

(defun nlay ( )
(command "._layer" "_M" "_TEXTOS" "_C" "7" "" "")
(setvar "clayer" "_TEXTOS"));end


 ;;Set text height when style does not have it

(defun dnh (/ ph)
(setq dnht (getdist "\nAltura de Texto: <0.18>: ") ;Define New text height
	dnht (if (null ph) 0.18 ph))
(setvar 'textsize dnht)
);end

 ;;Ask the user if the style has Height

(defun qst ()
(initget "Yes No")
      (setq eath (getkword "\nCurrent text style has height? [Yes/No] <Yes>: ")) 

(if 
(= eath "No") (dnh) 
);end if  
);end 

(defun c:test( / *error*  vals lista nfile id salida pt) ;Define command and functions
	
;; Error handler
  
(defun *error* (msg)
    (mapcar 'setvar vars vals)
    (if	(not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )
 
 ;;Save and set variables
  
(setq vals (mapcar 'getvar (setq vars '(clayer orthomode luprec textsize tspacefac orthomode))))
  


(nlay)
(qst)
(setq lista '(
					  "TEXTO1"
					  "TEXTO2"
					  "TEXTO3"
					  "TEXTO4"
					  "TEXTO5"
					  "TEXTO6"
					  "TEXTO7"
					  "TEXTO8"
					  "TEXTO7"
					  "TEXTO8"
					  "TEXTO9"
					  "TEXT10"
					 )
	)

	(setq nfile (vl-filename-mktemp "Dlg.dcl")
			fdesc (open nfile "w")
	)
	(write-line "lista :dialog{ :list_box{key=\"lst\";multiple_select=false; width=30;} :button{label=\"Salir\"; key=\"cancel\"; is_cancel=true;}     }" fdesc)
	(close fdesc)

	(setq id (load_dialog nfile)
			salida 0
	)
	
	
	(while (>= salida 0)
		(new_dialog "lista" id)
		(start_list "lst" 3)
		(mapcar 'add_list lista)
		(end_list)
		(action_tile "lst" "(if (> (strlen $value) 0) (done_dialog (atoi $value)) )")
		(action_tile "cancel" "(done_dialog -1)")

		(if (>= (setq salida (start_dialog)) 0)
			(while (setq pt (getpoint))
				(entmake
					(list
						'(0 . "MTEXT")
						'(100 . "AcDbEntity")
						'(100 . "AcDbMText")
						(cons 10 pt)
						(cons 1 (nth salida lista))
					)
				)
			)
		)
	)

	(unload_dialog id)
	(vl-file-delete nfile)
;; Reset variables
  (mapcar 'setvar vars vals)
  (princ)
);end

 

Link to comment
Share on other sites

@Romero Consider the following example:

(defun c:test ( / *error* dch dcl des hgt idx ins lst sty )

    (defun *error* ( msg )
        (if (< 0 dch) (unload_dialog dch))
        (if (= 'file (type des)) (close des))
        (if (and (= 'str (type dcl)) (setq dcl (findfile dcl))) (vl-file-delete dcl))
        (if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )

    (setq lst
       '(
            "TEXTO1"
            "TEXTO2"
            "TEXTO3"
            "TEXTO4"
            "TEXTO5"
            "TEXTO6"
            "TEXTO7"
            "TEXTO8"
            "TEXTO9"
            "TEXT10"
        )
    )

    (setq sty (getvar 'textstyle)
          hgt (cdr (assoc 40 (tblsearch "style" sty)))
    )
    (if (zerop hgt)
        (progn
            (initget 6)
            (setq hgt (cond ((getdist (strcat "\nAltura de texto <" (rtos (getvar 'textsize)) ">: "))) ((getvar 'textsize))))
        )
    )

    (if
        (and
            (setq dcl (vl-filename-mktemp nil nil ".dcl"))
            (setq des (open dcl "w"))
            (foreach str
               '(
                    "txt : dialog"
                    "{"
                    "    key = \"dcl\"; spacer;"
                    "    : list_box"
                    "    {"
                    "        key = \"lst\";"
                    "        width = 40;"
                    "        height = 20;"
                    "        fixed_width = true;"
                    "        fixed_height = true;"
                    "        allow_accept = true;"
                    "    }"
                    "    ok_cancel;"
                    "}"
                )
                (write-line str des)
            )
            (not (setq des (close des)))
            (< 0 (setq dch (load_dialog dcl)))
        )
        (while
            (not
                (cond
                    (   (not (new_dialog "txt" dch))
                        (princ "\nDialog could not be loaded.")
                    )
                    (   (progn
                            (set_tile    "dcl" "Select Text")
                            (start_list "lst")
                            (foreach itm lst (add_list itm))
                            (end_list)
                            (set_tile    "lst"  (cond (idx) ((setq idx "0"))))
                            (action_tile "lst" "(setq idx $value)")
                            (zerop (start_dialog))
                        )
                    )
                    (   (while (setq ins (getpoint "\rSpecify text insertion point <back>: "))
                            (entmake
                                (list
                                   '(000 . "MTEXT")
                                   '(100 . "AcDbEntity")
                                   '(100 . "AcDbMText")
                                   '(008 . "_TEXTOS")
                                    (cons 007 sty)
                                    (cons 040 hgt)
                                    (cons 010 (trans ins 1 0))
                                    (cons 001 (nth (atoi idx) lst))
                                    (cons 011 (getvar 'ucsxdir))
                                    (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))
                                )
                            )
                        )
                        (redraw)
                    )
                )
            )
        )
        (princ "\nUnable to write & load DCL file.")
    )
    (*error* nil) (princ)
)

 

Edited by Lee Mac
  • Thanks 1
Link to comment
Share on other sites

@Lee Mac That was incredible. Exactly what I needed. I am very grateful to you. The truth is that I want to devote myself more and someday to be able to convert, even if it is half of what you are.
My respect and recognition for a great help. You're the best. always sharing knowledge
I will study this routine to learn more; Since I have a long way to go, but thanks to the help of all of you in the forums, we will move forward. 👏

Link to comment
Share on other sites

1 hour ago, Romero said:

@Lee Mac That was incredible. Exactly what I needed. I am very grateful to you. The truth is that I want to devote myself more and someday to be able to convert, even if it is half of what you are.
My respect and recognition for a great help. You're the best. always sharing knowledge
I will study this routine to learn more; Since I have a long way to go, but thanks to the help of all of you in the forums, we will move forward. 👏

 

Thank you for your sincere gratitude and compliments @Romero, I really appreciate your respect and appreciation for my time.

 

I realise that offering suggestions for improvement for your existing code may have been more beneficial to your learning than rewriting the entire program, but nevertheless, I hope that you can benefit from studying my code, and of course, feel free to ask if you have any questions about the posted code.

  • Like 1
Link to comment
Share on other sites

18 hours ago, Lee Mac said:

 

Thank you for your sincere gratitude and compliments @Romero, I really appreciate your respect and appreciation for my time.

 

I realise that offering suggestions for improvement for your existing code may have been more beneficial to your learning than rewriting the entire program, but nevertheless, I hope that you can benefit from studying my code, and of course, feel free to ask if you have any questions about the posted code.

 

@Lee Mac  You should not thank me. Thanks are for you You are always so useful with your codes.
And of course I hope to learn a lot more with your routines. If I have doubts, I will be asking you. I hope that does not bother you. By the way, I've browsed on your website to discover new things. Blessings

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...