Text inserting (from list)
@BB8x wrote:
Example attached. Lines are base drawing. All texts are target and I need to put by hand
(defun c:Labelp (/ notesFile opf pline str layer ppt ang file ipt str noteslist )
;;; pBe June 2021 ;;;
(setq _trans (lambda (p)(trans p 1 0)))
(if
(setq notesFile (getfiled "Selet notes file" (getvar 'dwgprefix) "txt" 16))
(progn
(setq opf (open notesFile "r"))
(while
(setq a (read-line opf))
(setq noteslist (cons a noteslist)))
(close opf)
(prompt "\nSelect Polyline:")
(while (and
(setq pline (entsel "\nSelect Polyline"))
(member (cdr (assoc 0 (setq ent (entget (setq e (Car pline)))))) '("LINE" "LWPOLYLINE" ))
(setq str (Car (LM:listbox "Select notes to insert" noteslist 0)))
)
(setq layer (cdr (assoc 8 ent)))
(setq ppt (vlax-curve-getClosestPointTo e (cadr pline)))
(setq ang (angle '(0.0 0.0 0.0) (vlax-curve-getfirstderiv e (vlax-curve-getparamatpoint e ppt))))
(entmakex
(list (cons 0 "TEXT")
(cons 10 (Setq p_ ( _trans (polar ppt (+ ang (* pi 1.5)) 0.2 ))
)
)
(cons 11 p_)
'(40 . 0.20)
(Cons 50
(if (and
(> ang (/ pi 2))
(<= ang (* pi 1.5))
) (+ ang pi) ang ))
'(72 . 4)
'(73 . 3)
(cons 8 layer)
(cons 1 str)
)
)
)
)
)(princ)
)
;; List Box - Lee Mac
;; Displays a DCL list box allowing the user to make a selection from the supplied data.
;; msg - [str] Dialog label
;; lst - [lst] List of strings to display
;; bit - [int] 1=allow multiple; 2=return indexes
;; Returns: [lst] List of selected items/indexes, else nil
(defun LM:listbox ( msg lst bit / dch des tmp rtn )
(cond
( (not
(and
(setq tmp (vl-filename-mktemp nil nil ".dcl"))
(setq des (open tmp "w"))
(write-line
(strcat "listbox:dialog{label=\"" msg "\";spacer;:list_box{key=\"list\";multiple_select="
(if (= 1 (logand 1 bit)) "true" "false") ";width=50;height=15;}spacer;ok_cancel;}"
)
des
)
(not (close des))
(< 0 (setq dch (load_dialog tmp)))
(new_dialog "listbox" dch)
)
)
(prompt "\nError Loading List Box Dialog.")
)
( t
(start_list "list")
(foreach itm lst (add_list itm))
(end_list)
(setq rtn (set_tile "list" "0"))
(action_tile "list" "(setq rtn $value)")
(setq rtn
(if (= 1 (start_dialog))
(if (= 2 (logand 2 bit))
(read (strcat "(" rtn ")"))
(mapcar '(lambda ( x ) (nth x lst)) (read (strcat "(" rtn ")")))
)
)
)
)
)
(if (< 0 dch)
(unload_dialog dch)
)
(if (and tmp (setq tmp (findfile tmp)))
(vl-file-delete tmp)
)
rtn
)
Command: Labelp
Select Polyline
HTH
Pbe has posted a excellent solution for me I demand load the external routines like Lee's list box code. So only 1 line needed, rather than having all the external code in your code.
(if (not LM:listbox)(load "ListboxV1-2.lsp"))
If the text file is less than say 20 lines have a look at Multi Radio buttons.lsp Is a library routine again, but makes a radio button dcl rather than a list box.
@BB8x wrote:
Would be a chance to modify this and inserted text would have current text properties? So far it insets text, but after changing texts to standard height and style texts are bit off base line and I need to move texts
Would it be easier if the user were prompt for a text height ( using current value of TEXTSIZE as default value) [ Option 1 ] instead of running the program and re-sizing the TEXT objects?
OR
use TOP CENTER or BOTTOM CENTER as insertion point so regardless of the adjustments on the height it will not cross the lines. [ Option 2 ]
(defun c:Labelp (/ notesFile opf pline str layer ppt ang file ipt str noteslist txheight)
;;; pBe June 2021/Apr 2022 ;;;
(setq _trans (lambda (p)(trans p 1 0)))
(if (and
(setq notesFile (getfiled "Select notes file" (getvar 'dwgprefix) "txt" 16))
(setq txheight (cond ((getreal
(strcat "\nEnter text height <" (rtos (setq txheight (getvar 'TEXTSIZE )) 2 )
">: "
)
)
)
( txheight )
)
)
)
(progn
(setvar 'Textsize txheight)
(setq opf (open notesFile "r"))
(while
(setq a (read-line opf))
(setq noteslist (cons a noteslist)))
(close opf)
(prompt "\nSelect Polyline/Line:")
(while (and
(setq pline (entsel "\nSelect Polyline"))
(member (cdr (assoc 0 (setq ent (entget (setq e (Car pline)))))) '("LINE" "LWPOLYLINE" ))
(setq str (Car (LM:listbox "Select notes to insert" noteslist 0)))
)
(setq layer (cdr (assoc 8 ent)))
(setq ppt (vlax-curve-getClosestPointTo e (cadr pline)))
(setq ang (angle '(0.0 0.0 0.0) (vlax-curve-getfirstderiv e (vlax-curve-getparamatpoint e ppt))))
(entmakex
(list (cons 0 "TEXT")
(cons 10 (Setq p_ ( _trans (polar ppt (+ ang (* pi 1.5)) (* txheight 0.50)))
)
)
(cons 11 p_)
(cons 40 txheight)
(Cons 50
(if (setq b (and (> ang (/ pi 2)) (<= ang (* pi 1.5)))
) (+ ang pi) ang ))
'(72 . 1)
(cons 73 (if b 1 3))
(cons 8 layer)
(cons 1 str)
)
)
)
)
)(princ)
)
