Split text and create two individual entity afterwards

[Anonymous]

Hi, I need all of the text instances in my model space which contain the word "shop"   (not case sensative) to be split into two separate text objects using LISP routine. See example below.

Can anybody help on this?

[devitg]

Please Upload the DWG or send it to my email .

"my-user-name-here"@gmail.com

[Anonymous]

Attached.

[devitg]

see it 

[Anonymous]

Thanks for the effort but I was after the lisp code not the drawing ! That's why the topic is created under Visual LISP, AutoLISP and General Customization section

[devitg]

I ask if it, is what you need 

[dbroad]

Is this a request for a complete program or are you trying to learn to code using AutoLISP?  If interested in coding, what have you tried so far?

[Anonymous]

Well, I must admit I went to point then I stuck because I realised the path I am following is getting me to a stage where ultimately the text string will split and be displayed on the console whereas I am willing to have the text object to be replaced by two new text object (not just been displayed on console). That is where I don't know what to do !

Here is what I have comeup with so far (the sdtol subfunction is not for me though - I found it from one of CAD forums which I can't recall where exactly)

;;-------------------------------Subfunction-------------------------------------
(defun sdtol (str del / step strlist)
  (defun step (/ pos)
    (setq
      pos (vl-string-search del str)
      strlist (append strlist (list (substr str 1 pos)))
      str (substr str (+ pos (strlen del) 1))
    )
  )
  (while (and str (wcmatch str (strcat "*" del "*"))) 
	(step)
  )
   (setq strlist (append strlist (if (/= str "") (list str))))
   
)
;;-------------------------------Main-------------------------------------
(defun TA:Code9 ( p1 p2 / sel1)
  (if (setq s (ssget "_X" '((0 . "TEXT") (1 . "*shop*"))))
    (repeat (setq i (sslength s))
      (setq e (entget (ssname s (setq i (1- i)))))
    )
  )
  (princ)	
)
(TA:Code9 '(0 0) '(100 65))

[ВeekeeCZ · Accepted solution]

Perhaps like this... not very smart, just for this goal.

Spoiler

(defun c:SplitShop ( / s i e)
  (if (setq s (ssget "_X" '((0 . "TEXT") (1 . "#*SHOP"))))
    (repeat (setq i (sslength s))
      (setq e (entget (ssname s (setq i (1- i)))))
      (entmake (append e
		       (list (cons 10 (polar (cdr (assoc 10 e)) 0 8.5))
			     (cons 1 "SHOP"))))
      (entmod (append e
		      (list (cons 1 (itoa (atoi (cdr (assoc 1 e))))))))
    )
    (princ "\nNo text '#*SHOP' to split.")
  )
  (princ)
)

[phanaem]

Consider this lisp as a start. It doesn't work for "Fit" or "Aligned" dtexts and I didn't test it on 3D rotated entities. 

;Split text by space
;Stefan M. 01.06.2016
(defun c:test ( / *error* ss e o el r s l b x o1 s1 b1 p) (vl-load-com)
  ;(setq *error* (err))
  (if
    (setq ss (ssget ":L" '((0 . "TEXT"))))
    (repeat (setq i (sslength ss))
      (setq e  (ssname ss (setq i (1- i)))
            o  (vlax-ename->vla-object e)
            el (entget e)
            r  (cdr (assoc 50 el))
            s  (cdr (assoc  1 el))
            l  (vl-remove-if-not '(lambda (a) (member (car a) '(7 40 41))) el)
            b  (textbox el)
            )
      (while
        (setq x  (vl-string-position 32 s))
        (setq s1 (substr s 1 x)
              s  (vl-string-left-trim " " (substr s (1+ x)))
              b1 (textbox (cons (cons 1 s) l))
              p  (vla-get-InsertionPoint o)
              )
        (if (> x 0)
          (progn
            (setq o1 (vla-copy o))
            (vla-put-textstring o1 s1)
            (vla-move o1 (vla-get-InsertionPoint o1) p)
          )
        )
        (vla-put-textstring o s)
        (vla-move o (vla-get-InsertionPoint o) p)
        (vla-move o
          (vlax-3d-point 0 0 0)
          (vlax-3d-point (polar '(0 0 0) r (- (caadr b) (caadr b1))))
        )
        
        (setq b b1)
      )
    )
  )
  ;(*error* nil)
  (princ)
)

[phanaem]

Sorry BK, my previous post is addressed to OP. 🙂

[Anonymous]

Thanks for the code. Just for the learning purposes, would you please elaborate more on following two lines?

(entmake	(append	e (list (cons 10 (polar (cdr (assoc 10 e)) 0 8.5))  (cons 1 "SHOP"))))
(entmod (append	e (list (cons 1 (itoa (atoi (cdr (assoc 1 e))))))))

[ВeekeeCZ]

See the code

Spoiler

(entmake 	; make new entity from
  (append 			; list created from
    e 						; current text entity definition list given by (entget)
    (list 					; to which was added list of
      (cons 10  							; pair of code 10 (=insertion point) 
	    (polar 								; and a point given by polar function (new position of text=move) from  
	      (cdr 											; point which was the last member of
		(assoc 10 e)													; pair of code 10 and current point list (= insertion point)
		)
	      0												; and angle 
	      8.5											; and distance
	      ))
      (cons 1 "SHOP")							; and pair of code 1 (= text content) and its new value (*)
      )))

(entmod		; modify entity give by
  (append			; list created from
    e						; current text entity definition list given by (entget)
    (list					; to which was added list of (*)
      (cons 1								; a pair of code 1 (= text content) and its new value
	    (itoa												; which was converted to string from integer value 
	      (atoi															; which was converted to integer from string value (**)
		(cdr																	; which was the last member of 
		  (assoc 1 e))))))))																; pair of code 1 and string (=text content) given by assoc.

There are two things that may be confusing.

Note (*)

Spoiler

(entmake (append '((-1 . <Entity name: 7ffff867600>)
		   (0 . "TEXT")
		   (330 . <Entity name: 7ffff85a1f0>)
		   ...
		   (10 694.265 670.175 0.0)
		   (40 . 2.5)
		   (1 . "10  SHOP")
		   (50 . 0.0)
		   ...
		   (73 . 0))
		 (list (cons 1 . "NEW TEXT")
		       (10 694.265 670.175 0.0))))

I can add new pairs to current entity definition list... even if they already are in the list... If a list can contain just single instance of a pair, it takes the last one. Some of pairs are ingnored if is new entity created (ename, handle). See HELP

Note (**)

Where you got rid of all the strings behind a number?

That's a nature of (atoi) function. It converts the first characters if they are numbers and cuts all strings behing if there are. I would say see HELP, but there is no such an example. So try it yourself: (atoi "20a"), (atoi "10 a b s") or (atoi "a20") (atoi "twenty")

HTH

[dbroad]

Glad to see that you want to learn lisp.  The learning part of the process got a bit short circuited with the solutions just plopped in.  I was hoping to have an evolving dialog.  You've got a complete solution with looping.  If you're interested, consider this approach too.  I would suggest you start with the legacy methods and then move on to activex methods.  This solution is focussed on just changing one string.  You've already got the loop.

;;split a text at a given pattern.
;;select a string object (no type checking here)
(setq e (car(entsel)))
(setq ei (entget e))
;;text value of string
(setq str (cdr(assoc 1 ei)))
;;string to split before
(setq pat "SHOP")
(setq loc (vl-string-search pat str))
(setq slist(list (substr str 1 loc)(substr str (1+ loc))))
;;Note:  textbox ignores spaces and ignores rotation
;;Get the rotated textbox for the text string before changes
(setq ext (rotptlst (textbox ei)(cdr(assoc 50 ei))))
;modify first entity to hold first part of text
(setq ei (entmod (subst (cons 1 (car slist)) (assoc 1 ei) ei)))
;;when using command methods to move and copy toggle osmode off
(setq osm (getvar "osmode"))
(setvar "osmode" 0)
;;make a copy of the entity keeping the layer, style, location etc.
(command "copy" e "" '(0 0)"")
;;save the last entity
(setq e2 (entlast))
;;entity 2 info
(setq ei2 (entget e2))
;;change ei2's text content to second part
(setq ei2 (entmod (subst (cons 1 (cadr slist)) (assoc 1 ei2) ei2)))
;;get a textbox rotated to text rotation
(setq ext2 (rotptlst(textbox ei2)(cdr(assoc 50 ei))))
;;move the 2nd text string to align to where the orginal text string ended
;;Trans accomodates changed coordinate systems
(command "move" e2 "" (trans(cadr ext2) e2 1)(trans (cadr ext) e2 1))
;;restore settings
(setvar "osmode" osm)

;;Rotates points counterclockwise positive about origin
(defun rotptlst (lst ang)
  (setq ang (- ang))
  (mapcar '(lambda (pt)
	     (list (+ (* (car pt)(cos ang))(* (cadr pt)(sin ang)))
		   (+ (* (car pt)(-(sin ang)))(* (cadr pt)(cos ang)))))
	  lst))

  This solution above is intended to be tested in vlide.  Double click at the end of each line and load selected.  After each step, use the vlide console to verify the contents of the variables set in that line.  Good lisping. 

[Anonymous]

Thanks heaps guys. I have to spend sometime now and chew these !

[symoin]

Hi,

How to modify this to include = as a second condition to split the text.

Thanks all