tiwari1211 Posted October 25, 2022 Share Posted October 25, 2022 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 Quote Link to comment Share on other sites More sharing options...
Emmanuel Delay Posted October 27, 2022 Share Posted October 27, 2022 (edited) 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 1 Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.