Split 1 attribute to 3 others attributes of the same block

[braudpat]

Hello

Please I am looking for a Lisp/VLisp routine to split 1 attribute to 3 others attribute of the same Block !?

The text is delimited by a "." but sometimes it could be an other delimiter, so please I need into the routine : 

( setq  delimiter  "."  )

And a few other variables like :

( setq  AttToSplit  "COD" )

( setq   Att1  "COD1"   Att2  "COD2"   Att3  "COD3" )

The routine is asking for ONE Block to retrieve the Block Name with the attribute to split ...

And then a classic AutoCAD selection ...

And the routine will try to split the "main" attribute (AttToSplit) to 3 others attributes (Att1 / Att2 / Att3)

without updating / erasing the "main" attribute and the other attributes !

ATTENTION : The Block can be classic or dynamic !

See the DWG joined with the Block "BATT6" before and after ...

Please look at this topic :

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/text-text-to-block-with-2-attributes...

where I asked for something very similar with Text.Text to Attributes ...

Thanks again to @ВeekeeCZ & @Sea-Haven for the work on the previous routine !

I hope that I am clear !?

The Health, Bye, Patrice (The Old French EE Froggy)

[ВeekeeCZ · Accepted solution]

You can pre-set tags, you can pick them, you can type them, anything you want. The only cons are that there is a weird cursor when you pick atts.

(vl-load-com)

(defun c:SplitAtts ( / LM:str->lst i d s e v)
  
  (or *sa-i* (setq *sa-i* "COD"))
  (or *sa-d* (setq *sa-d* "."))
  (or *sa-o* (setq *sa-o* '("COD1" "COD2" "COD3")))
    
  ;; String to List  -  Lee Mac ;; http://www.lee-mac.com/stringtolist.html
  (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)))
    
  (if (and (not (initget 128))
	   (setq *sa-i* (cond ((setq e (getpoint (strcat "\nPick/type Source att <" *sa-i* ">: ")))
			       (if (listp e)
				 (if (setq e (car (nentselp e)))
				   (cdr (assoc 2 (entget e))))
				 e))
			      (*sa-i*)))
	   (princ (strcat "\nSource tag: " *sa-i*))
	   
	   (not (initget 128))
	   (setq *sa-o* (cond ((setq e (getpoint (strcat "\nPick/type Destination att1 <" (vl-princ-to-string *sa-o*) ">: ")))
			       (and (setq *sa-o* (cons (if (listp e)
							 (if (setq e (car (nentselp e)))
							   (cdr (assoc 2 (entget e))))
							 e) nil))
				    (princ (strcat "\nDestination tags: " (vl-princ-to-string *sa-o*)))
				    (setq i 1)
				    (setq *sa-o* (progn
						   (while (progn
							    (initget 128)
							    (setq e (getpoint (strcat "\nPick/typeDestination att" (itoa (setq i (1+ i))) " : "))))
						     (setq *sa-o* (cons (if (listp e)
									  (if (setq e (car (nentselp e)))
									    (cdr (assoc 2 (entget e))))
									  e)
									*sa-o*))
						     (princ (strcat "\nDestination tags: " (vl-princ-to-string *sa-o*))))
						   (reverse *sa-o*)))
				    )
			       *sa-o*)
			      (*sa-o*)))
	   
	   (setq d (getstring (strcat "\nDelimiter <" *sa-d* ">: ")))
	   (setq *sa-d* (if (= d "") *sa-d* d))
	   
	   (setq s (ssget '((0 . "INSERT") (66 . 1))))
	   )
    
    (repeat (setq i (sslength s))
      (and (setq e (ssname s (setq i (1- i))))
	   (not (vl-catch-all-error-p (setq v (vl-catch-all-apply 'getpropertyvalue (list e *sa-i*)))))
	   (setq v (LM:str->lst v *sa-d*))
	   (mapcar '(lambda (a x) (vl-catch-all-apply 'setpropertyvalue (list e a x))) *sa-o* v))))
  (princ)
  )

[braudpat]

Hello @ВeekeeCZ 

Your routine is PERFECT ! ... Exactly what I was asking for ...

THANKS, The Health, Regards, Patrice