AutoLisp to create Table from Mtexts in specific layer

[tiwari1211]

Dear Lisp experts, 

 

I am very new to this forum and looking for help to find solution to my problem.

In my Cad drawing i have several of Mtext in layer (E-Text). I am looking for a lisp which create a table of all the texts in specific format. 

 

MText example - 1497-1/1.4000/410S-2x

 

Table format -

 

 

Would be great if someone can help me in this.  Thank you

 

 

[Emmanuel Delay]

This should work

 

command CTFM: Create Table From Mtext

 

 

	(vl-load-com)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Removes non-numeric characters from a string
;;	https://forums.autodesk.com/t5/autocad-forum/lisp-for-extract-number-value-from-between-text-string/m-p/3609272#M193744
(defun numbers-in-string1 (str)
	;; Removes the non-numeric characters from a string
	(vl-list->string
		(vl-remove-if-not 'num-char-p
			(vl-string->list str)))
)

(defun num-char-p (char)
	;; Does (chr num) represent a numeric character (0...9)?
	;;(< 46 char 58)
	(and
		(> char 46)
		(< char 58)
	)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; http://www.lee-mac.com/listtostring.html

;; List to String  -  Lee Mac
;; Concatenates each string in a supplied list, separated by a given delimiter
;; lst - [lst] List of strings to concatenate
;; del - [str] Delimiter string to separate each item
(defun LM:lst->str ( lst del )
    (if (cdr lst)
        (strcat (car lst) del (LM:lst->str (cdr lst) del))
        (car lst)
    )
)

;; String to List  -  Lee Mac
;; Separates a string using a given delimiter
;; str - [str] String to process
;; del - [str] Delimiter by which to separate the string
;; Returns: [lst] List of strings
(defun LM:str->lst ( str del / pos )
    (if (setq pos (vl-string-search del str))
        (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del))
        (list str)
    )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; make a table

(defun inserttable (lst pt / ht htc tab i j row tb acObj acDoc space width_cols)
  ;; settings, text height, cel height
  (setq ht 12.0)
  (setq htc 30.0)
  ;; widths of the columns.  Feel free to adapt
  (setq width_cols (list
    80.0 200.0 200.0 80.0
  ))
  
  ;; document, model space, ...
  (setq acObj (vlax-get-acad-object)
        acDoc (vla-get-activedocument acObj)
        space (vlax-get acDoc (if (= 1 (getvar 'cvport)) 'PaperSpace 'ModelSpace))
  )

  (setq tab (vla-addtable space (vlax-3d-point pt) (length lst) (length (cadr lst)) (* 1.1 ht) (* 10.0 ht)  ))  ;; 
  (vla-SetTextHeight tab 1 ht)
  (vla-SetTextHeight tab 2 ht)
  (vla-SetTextHeight tab 4 ht)
  
  (vla-put-VertCellMargin tab (* 0.3 ht))
  (vla-put-HorzCellMargin tab (* 0.3 ht))
  
  (setq i 0)
  (repeat (length lst)  ;; iterates the rows
    (vla-setrowHeight tab i htc)
    (setq row (nth i lst))
    (setq j 0)
    (repeat (length row)  ;; iterates the cols in the row
      
      ;; (textbox (list (cons 1 (to_string x)) (cons 7 (getvar 'textstyle)) (cons 40 ht) ))
      (vla-SetColumnWidth tab j (nth j width_cols) )
      
      (vla-SetText tab i j (nth j row) )
      (setq j (+ j 1))
    )
    (setq i (+ i 1))
  )
  ;; default Autocad expects a title row.  If the first row has more than 1 cel, let's unmerge this row
  (if (> (length (nth 0 lst)) 1)
    (vla-unMergeCells tab 0 0 0 0)
  )
  
  
  ;; Merge last row, to show total
  ;; but we don't need this here
		;; MergeCells minRow, maxRow, minCol, maxCol
		;;(vla-MergeCells tab (- (length lst) 1) (- (length lst) 1) 0 3)

  tab
)

;; test of inserttable
(defun c:ila ( / )
  (inserttable
    (list
      (list "P.NO" "EASTING" "NORTHING" "ELEV." )
      (list "P1" "20.5" "30.5" "40.5" )
      (list "P2" "50.5" "60.5" "70.5" )
    )
    (getpoint "\nInsert point of table: ")
  )
)



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; command CTFM: Create Table From Mtext
(defun c:ctfm ( / ss i rows	cels str last_cel sp)
	;; user selects Mtext elements
	(princ "\nSelects Mtext elements: ")
	(setq ss (ssget (list (cons 0 "MTEXT") (cons 8 "E-Text"))))
	
	(setq i 0)
	(setq rows (list (list "S.no."  "Item No."  "Material"  "Qty.")))
	(repeat (sslength ss)
		;; read text contents of the Mtext
		(setq str (cdr (assoc 1 (entget (ssname ss i)))))
		;; split the text by "/"
		(setq cels (LM:str->lst str "/"))
		;; for example "1497-1/1.4000/410S-2x" is now (list "1497-1"  "1.4000"  "410S-2x")
		;; We'll split that last "410S-2x" to (list "410S"  "2x"), then remove the X
		(setq last_cel (LM:str->lst (nth 2 cels) "-"))
		;; now we assemble the row and add it to the list of rows
		(setq rows (append rows (list (list
			(itoa (+ i 1))				
			(nth 0 cels)
			(strcat		;; re-attach  the middle cels
				(nth 1 cels) "/" (nth 0 last_cel)
			)
			(numbers-in-string1 (nth 1 last_cel))
		))))
		(setq i (+ i 1))
	)
	(princ rows)
	
	(setq sp (getpoint "\nPick top left point of the table: ")); or use getpoint
	(inserttable rows sp)
	
	(princ )
)

 

Edited October 28, 2022 by Emmanuel Delay
typo