Lisp to Copy Mtext but paste only the first line

[tiwari1211]

Dear Lisp experts.  I hope you all are doing well. 

Do we have any Lisp to copy only the first line of MTEXT. I have many drawings where i need to copy only the first line to other position. presently i use copy command and then manually delete the remaining bottom lines. I dont want to explode the MTEXT. 

Can anyone help me in this. Thank you very much 

[Sea-Haven]

Also

AutoLisp to create Table from Mtexts in specific layer - AutoLISP, Visual LISP & DCL - AutoCAD Forum...

[tiwari1211]

Hi, This is also me looking for solution. 

[ВeekeeCZ]

Post the source dwg to it.

BTW posting the same request to multiple forums is the reason for some to ignore it. Me included.

[tiwari1211]

@ВeekeeCZ @Sea-Haven 

I had no idea, I was looking for the help but I will take care of this in future. Many thanks for your suggestion. 

DXF file is attached now. 

[Sea-Haven]

If you want to stay in excel and get results in excel and a table, start googling "VBA make table Autocad" 

[tiwari1211]

Hi,

I want this table in Autocad not in excel. Thanks 

[ВeekeeCZ · Accepted solution]

(vl-load-com)

(defun c:TableFromE-text ( / LM:str->lst insert_table acdoc s p i a c l)
  
  
  ;; 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)))
  
  (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))

  ; not mine, thx anyone who wrote it.
  (defun insert_table (lst title header pct / tab row col ht i n space)
    (setq space (vlax-get acDoc (if (= 1 (getvar 'cvport)) 'PaperSpace 'ModelSpace))
	  ht  (/ 150 (cond ((getvar 'cannoscalevalue)) (1.0)))
	  pct (trans pct 1 0)
	  n   (trans '(1 0 0) 1 0 T)
	  tab (setq tab (vla-addtable space (vlax-3d-point pct) (+ (if title 1 0) (if header 1 0) (length lst)) (length (car lst)) (* 150 ht) ht)))
    
    (vlax-put tab 'direction n)
    
    (mapcar '(lambda (rowType)
	       (vla-SetTextStyle  tab rowType (getvar 'textstyle))
	       (vla-SetTextHeight tab rowType ht))
	    '(2 4 1))
    (vla-put-HorzCellMargin tab (* 0.2 ht))
    (vla-put-VertCellMargin tab (* 0.2 ht))

    (if header (setq lst (cons header lst)))
    (setq i 0)
    
    (foreach col (apply 'mapcar (cons 'list lst))
      (vla-SetColumnWidth tab i
	(apply 'max (mapcar '(lambda (x)
			       ((lambda (txb) (+ (abs (- (caadr txb) (caar txb))) (* 2.2 ht)))
				 (textbox (list (cons 1 (vl-princ-to-string x)) (cons 7 (getvar 'textstyle)) (cons 40 ht)))))
			    col)))
      (setq i (1+ i)))

    (setq lst (cons (list title) lst))
    (setq row 0)
    
    (foreach r lst
      (setq col 0)
      (vla-SetRowHeight tab row (* 2 ht))
      (foreach c r
	(vla-SetText tab row col (if (numberp c) (rtos c) (vl-princ-to-string c)))
	(setq col (1+ col)))
      (setq row (1+ row))))

  
  ; ===========================================================================================================================
  
  (if (and (setq s (ssget "_X" '((0 . "MTEXT") (8 . "E-text"))))
	   (setq p (getpoint "\nTable scale depend on annotation scale.\nSpecify table insert point: "))
	   )
    (repeat (setq i (sslength s))
      (if (setq c (cdr (assoc 1 (entget (ssname s (setq i (1- i))))))
		c (list (substr c 1 (vl-string-search "/" c))
			(substr c (setq z (+ 2 (vl-string-search "/" c))) (- (vl-string-position (ascii "-") c nil T) z -1))
			(atoi (substr c (+ 2 (vl-string-position (ascii "-") c nil T))))))
	(setq l (if (setq a (assoc (car c) l))
		  (subst (reverse (cons (+ (last c) (last a)) (cdr (reverse a)))) a l)
		  (cons c l))))
      ))
  
  (and l
       (setq l (vl-sort l '(lambda (e1 e2) (< (car e1) (car e2)))))
       (setq i 0)
       (setq l (mapcar '(lambda (x) (list (itoa (setq i (1+ i))) (car x) (cadr x) (itoa (last x)))) l))
       (insert_table l "Export" '("SNo" "Item No" "Material" "Qty") p)
       )
  (princ)
  )

[tiwari1211]

It works perfectly as required. Many many thanks for your help. 

[tiwari1211]

Hi, Can you please guide me books to learn the Lisp basics ?

Also how can i add 3 more columns in the table for (bending, welding & Final check). 

I tried and added this in the last line of your program but it didn't worked. 

Thanks 

[ВeekeeCZ · Accepted solution]

THIS site is generally recommended as a good starting point.

Possibly like this.

(vl-load-com)

(defun c:TableFromE-text ( / LM:str->lst insert_table acdoc s p i a c l)
  
  
  ;; 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)))
  
  (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))

  ; not mine, thx anyone who wrote it.
  (defun insert_table (lst title header pct / tab row col ht i n space)
    (setq space (vlax-get acDoc (if (= 1 (getvar 'cvport)) 'PaperSpace 'ModelSpace))
	  ht  (/ 150 (cond ((getvar 'cannoscalevalue)) (1.0)))
	  pct (trans pct 1 0)
	  n   (trans '(1 0 0) 1 0 T)
	  tab (setq tab (vla-addtable space (vlax-3d-point pct) (+ (if title 1 0) (if header 1 0) (length lst)) (length (car lst)) (* 150 ht) ht)))
    
    (vlax-put tab 'direction n)
    
    (mapcar '(lambda (rowType)
	       (vla-SetTextStyle  tab rowType (getvar 'textstyle))
	       (vla-SetTextHeight tab rowType ht))
	    '(2 4 1))
    (vla-put-HorzCellMargin tab (* 0.2 ht))
    (vla-put-VertCellMargin tab (* 0.2 ht))

    (if header (setq lst (cons header lst)))
    (setq i 0)
    
    (foreach col (apply 'mapcar (cons 'list lst))
      (vla-SetColumnWidth tab i
	(apply 'max (mapcar '(lambda (x)
			       ((lambda (txb) (+ (abs (- (caadr txb) (caar txb))) (* 2.2 ht)))
				 (textbox (list (cons 1 (vl-princ-to-string x)) (cons 7 (getvar 'textstyle)) (cons 40 ht)))))
			    col)))
      (setq i (1+ i)))

    (setq lst (cons (list title) lst))
    (setq row 0)
    
    (foreach r lst
      (setq col 0)
      (vla-SetRowHeight tab row (* 2 ht))
      (foreach c r
	(vla-SetText tab row col (if (numberp c) (rtos c) (vl-princ-to-string c)))
	(setq col (1+ col)))
      (setq row (1+ row))))

  
  ; ===========================================================================================================================
  
  (if (and (setq s (ssget "_X" '((0 . "MTEXT") (8 . "E-text"))))
	   (setq p (getpoint "\nTable scale depend on annotation scale.\nSpecify table insert point: "))
	   )
    (repeat (setq i (sslength s))
      (if (setq c (cdr (assoc 1 (entget (ssname s (setq i (1- i))))))
		c (list (substr c 1 (vl-string-search "/" c))
			(substr c (setq z (+ 2 (vl-string-search "/" c))) (- (vl-string-position (ascii "-") c nil T) z -1))
			(atoi (substr c (+ 2 (vl-string-position (ascii "-") c nil T))))))
	(setq l (if (setq a (assoc (car c) l))
		  (subst (reverse (cons (+ (last c) (last a)) (cdr (reverse a)))) a l)
		  (cons c l))))
      ))
  
  (and l
       (setq l (vl-sort l '(lambda (e1 e2) (< (car e1) (car e2)))))
       (setq i 0)
       (setq l (mapcar '(lambda (x) (list (itoa (setq i (1+ i))) (car x) (cadr x) (itoa (last x)) "-" "-" "-")) l))
       (insert_table l "Export" '("SNo" "Item No" "Material" "Qty" "bending" "welding" "Final check") p)
       )
  (princ)
  )

[tiwari1211]

Hi, This works very well on Autocad. Any idea why it does not work on DraftSight ?