Searching lisp about adding texts to table

[veteranus]

Hi I have two single text.

 

I just want to select to these texts and create table side by side.

 

like this:

 

 

thanks for your help guys.

[Lee Mac]

To offer a solution using existing code: you could copy the table and then use this program to populate it with the desired text.

[veteranus]

lee ı ınstall your program but ıt doesnt solve my problem, help please...

[veteranus]

this belongs to you ı guess but ı need these number sıde by sıde...

 

;; Text to Table - Lee Mac

;; Generates a AutoCAD Table object containing the content of selected text/mtext.

 

(defun c:text2table ( / enx idx ins lst sel )

(if (and (setq sel (ssget '((0 . "TEXT,MTEXT"))))

(setq ins (getpoint "\nSpecify point for table: "))

)

(progn

(repeat (setq idx (sslength sel))

(setq enx (entget (ssname sel (setq idx (1- idx))))

lst (cons (list (LM:gettextstring enx) (cdr (assoc 10 enx))) lst)

)

)

(LM:addtable (vlax-get-property (LM:acdoc) (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))

(trans ins 1 0)

nil

(mapcar '(lambda ( x ) (list (car x)))

(vl-sort lst '(lambda ( a b ) (> (cadadr a) (cadadr b))))

)

nil

)

)

)

(princ)

)

 

;; Get Textstring - Lee Mac

;; Returns the text content of Text, MText, Multileaders, Dimensions & Attributes

 

(defun LM:gettextstring ( enx / enx itm str typ )

(setq typ (cdr (assoc 0 enx)))

(cond

( (wcmatch typ "TEXT,*DIMENSION")

(cdr (assoc 1 (reverse enx)))

)

( (and (= "MULTILEADER" typ)

(= acmtextcontent (cdr (assoc 172 (reverse enx))))

)

(cdr (assoc 304 enx))

)

( (wcmatch typ "ATTRIB,MTEXT")

(setq str (cdr (assoc 1 (reverse enx))))

(while (setq itm (assoc 3 enx))

(setq str (strcat (cdr itm) str)

enx (cdr (member itm enx))

)

)

str

)

)

)

 

;; Add Table - Lee Mac

;; Generates a table at the given point, populated with the given data and optional title.

;; spc - [vla] VLA Block object

;; ins - [lst] WCS insertion point for table

;; ttl - [str] [Optional] Table title

;; lst - [lst] Matrix list of table cell data

;; eqc - [bol] If T, columns are of equal width

;; Returns: [vla] VLA Table Object

 

(defun LM:addtable ( spc ins ttl lst eqc / dif hgt i j obj stn sty wid )

(setq sty

(vlax-ename->vla-object

(cdr

(assoc -1

(dictsearch (cdr (assoc -1 (dictsearch (namedobjdict) "acad_tablestyle")))

(getvar 'ctablestyle)

)

)

)

)

)

(setq hgt (vla-gettextheight sty acdatarow))

(if (LM:annotative-p (setq stn (vla-gettextstyle sty acdatarow)))

(setq hgt (/ hgt (cond ((getvar 'cannoscalevalue)) (1.0))))

)

(setq wid

(mapcar

'(lambda ( col )

(apply 'max

(mapcar

'(lambda ( str )

( (lambda ( box ) (if box (+ (* 2.5 hgt) (- (caadr box) (caar box))) 0.0))

(textbox

(list

(cons 01 str)

(cons 40 hgt)

(cons 07 stn)

)

)

)

)

col

)

)

)

(apply 'mapcar (cons 'list lst))

)

)

(if

(and ttl

(

(setq dif

(/

(-

( (lambda ( box ) (if box (+ (* 2.5 hgt) (- (caadr box) (caar box))) 0.0))

(textbox

(list

(cons 01 ttl)

(cons 40 hgt)

(cons 07 stn)

)

)

)

(apply '+ wid)

)

(length wid)

)

)

)

)

(setq wid (mapcar '(lambda ( x ) (+ x dif)) wid))

)

(setq obj

(vla-addtable spc

(vlax-3D-point ins)

(1+ (length lst))

(length (car lst))

(* 2.0 hgt)

(if eqc

(apply 'max wid)

(/ (apply '+ wid) (float (length (car lst))))

)

)

)

(vla-put-regeneratetablesuppressed obj :vlax-true)

(vla-put-stylename obj (getvar 'ctablestyle))

(setq i -1)

(if (null eqc)

(foreach col wid

(vla-setcolumnwidth obj (setq i (1+ i)) col)

)

)

(if ttl

(progn

(vla-settext obj 0 0 ttl)

(setq i 1)

)

(progn

(vla-deleterows obj 0 1)

(setq i 0)

)

)

(foreach row lst

(setq j 0)

(foreach val row

(vla-settext obj i j val)

(setq j (1+ j))

)

(setq i (1+ i))

)

(vla-put-regeneratetablesuppressed obj :vlax-false)

obj

)

 

;; Annotative-p - Lee Mac

;; Returns T if the given Textstyle is annotative

 

(defun LM:annotative-p ( sty )

(and (setq sty (tblobjname "style" sty))

(setq sty (cadr (assoc -3 (entget sty '("acadannotative")))))

(= 1 (cdr (assoc 1070 (reverse sty))))

)

)

 

;; 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)

)

 

(vl-load-com) (princ)

[SLW210]

Please read the Code Posting Guidelines and edit your Code to be included in Code Tags.[NOPARSE]

Your Code Here[/NOPARSE]

=

Your Code Here

[BIGAL]

Do you need a table would a block not work better much simpler programming wise. Pick text1 text2 then auto rest insert block pickpoint 1 1 0 text1 text2 all done.

 

Just need basic dimensions of the block. Post dwg of linework and text. Have a go yourself just need a block with 2 attributes.

 

(defun c:tbox ( / t1 t2 pt)
(setq t1 (vla-get-textstring  (vlax-ename->vla-object  (car (entsel "Pick text 1 ")))))
(setq t2 (vla-get-textstring  (vlax-ename->vla-object  (car (entsel "Pick text 2 ")))))
(setq pt (getpoint "Pick point for label"))
(command "insert" "Tbox" pt 1 1 0 t1 t2)
)

[Tharwat]

Hi,

Try the following codes but you should already have the table to be able to place the two texts within the second row;

 

(defun c:txt2tbl (/ l s l tbl)
 ;; Tharwat - Date:28.Dec.2016	;;
 (and
   (progn
     (while (and
              (/= 2 (length l))
              (princ
                (strcat
                  "\nPick"
                  (if l
                    " Second "
                    " First "
                    )
                  "text :"
                  )
                )
              (setq s (ssget "_+.:S:E" '((0 . "*TEXT"))))
              (setq l (cons (cdr (assoc 1 (entget (ssname s 0)))) l))
              )
      )
     (= 2 (length l))
     )
   (princ "\nPick a table :")
   (setq tbl (ssget "_+.:S:E:L" '((0 . "ACAD_TABLE"))))
   (setq tbl (vlax-ename->vla-object (ssname tbl 0)))
   (vl-every
     '(lambda (n) (< 1 n))
     (list (vla-get-rows tbl) (vla-get-columns tbl))
     )
   (mapcar '(lambda (s c) (vla-settext tbl 1 c s)) l '(0 1))
   )
 (princ)
 ) (vl-load-com)

[veteranus]

Hi,

Try the following codes but you should already have the table to be able to place the two texts within the second row;

 

(defun c:txt2tbl (/ l s l tbl)
 ;; Tharwat - Date:28.Dec.2016	;;
 (and
   (progn
     (while (and
              (/= 2 (length l))
              (princ
                (strcat
                  "\nPick"
                  (if l
                    " Second "
                    " First "
                    )
                  "text :"
                  )
                )
              (setq s (ssget "_+.:S:E" '((0 . "*TEXT"))))
              (setq l (cons (cdr (assoc 1 (entget (ssname s 0)))) l))
              )
      )
     (= 2 (length l))
     )
   (princ "\nPick a table :")
   (setq tbl (ssget "_+.:S:E:L" '((0 . "ACAD_TABLE"))))
   (setq tbl (vlax-ename->vla-object (ssname tbl 0)))
   (vl-every
     '(lambda (n) (< 1 n))
     (list (vla-get-rows tbl) (vla-get-columns tbl))
     )
   (mapcar '(lambda (s c) (vla-settext tbl 1 c s)) l '(0 1))
   )
 (princ)
 ) (vl-load-com)

 

hi,

 

It worked like a charm. Thank you very much.

[Tharwat]

hi,

 

It worked like a charm. Thank you very much.

 

You're most welcome.