Text.Text to Block with 2 attributes

[braudpat]

Hello

Please I am looking for a Lisp/VLisp routine to create a Block (without graphic) but with 2 attributes ATT1, ATT2
coming from a "special" classic text with a separator (".") - A few samples :
Text = "COD.123" --> ATT1 = "COD" , ATT2 = "123"
Text = "XY" --> ATT1 = "XY" , ATT2 = ""
Text = "XY." --> ATT1 = "XY" , ATT2 = ""
Text = ".MN" --> ATT1 = "" , ATT2 = "MN"
etc

The Block (created into the routine with ENTMAKE if possible - Attributes on Layer ZERO)

will inserted at the justification point of the "special" text on the current layer.

OR I can use my own Block with the 2 attributes ATT1 & ATT2, SO the routine wil be "easier" !

Please at the beginning of the routine something like :

(setq separator ".") to be able to use it with an other separator !

I hope I am clear !? Please see the DWG ...

Thanks in advance, The Health, Bye, Patrice

[Sea-Haven]

If you look at any block with 2 atts, now the text has a seperator could be "." "," " " and so on, if you use this can set seperator and make a list of the text ie pull it apart, for a 3 part text "XY A B" as example the space is the seperator.

; thanks to Lee-mac for this defun 
; www.lee-mac.com
; 44 is comma 32 is space . is 46
(defun _csv->lst ( strtxt / pos )
	(if (setq pos (vl-string-position sep strtxt))
		(cons (substr strtxt 1 pos) (_csv->lst (substr strtxt (+ pos 2))))
		(list strtxt)
    )
)

(setq sep (ascii (getstring "\nEnter seperator ")))
(setq ans (_csv->lst "123.45"))
--> ("123" "45")

[ВeekeeCZ · Accepted solution]

@braudpat 

no entmake. it's not so simple with atts. you gotta make your own block.

(vl-load-com)

(defun c:Text-Text ( / *error* doc ov sv LM:str->lst s i d x p b)
  
  
  (setq delimiter "."
	blockname "Text-Text")
  
  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
      (princ (strcat "\nError: " errmsg)))
    (if ov (mapcar 'setvar sv ov))
    (vla-endundomark doc)
    (princ))
  
  
  ;; 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 (or (tblsearch "BLOCK" blockname)
	       (prompt (strcat "\nSo sorry The Old French EE Froggy, you need to somehow get '" blockname " block into the drawing!")))
	   (not (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object)))))
	   (setq s (ssget '((0 . "TEXT"))))
	   (setq sv '("attdia" "attreq" "cmdecho"))
	   (setq ov (mapcar 'getvar sv))
	   (mapcar 'setvar sv '(0 0 0))
	   )
    
    (repeat (setq i (sslength s))
      (if (and (setq e (ssname s (setq i (1- i)))
		     d (entget e)
		     x (cdr (assoc 1 d))
		     p (cdr (assoc 10 d)))
	       (setq x (LM:str->lst x delimiter))
	       (not (command "_.-insert" blockname "_s" 1 "_r" 0 "_non" p))
	       )
	(progn
	  (setpropertyvalue (entlast) "ATT1" (car x))
	  (setpropertyvalue (entlast) "ATT2" (cond ((cadr x)) ("")))
	  (entdel e)
	  ))))
  (*error* "end")
  )

[braudpat]

 Hello  @ВeekeeCZ  &  @Sea-Haven 

1) Thanks for your help !

2) The routine "Text-Text" is perfect, except that the Blocks are inserted on Layer ZERO

and not on the current layer ... Not Important ...

I like Humour :

(prompt (strcat "\nSo sorry The Old French EE Froggy, you need to somehow get '" blockname " block into the drawing!")))

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

[ВeekeeCZ]

---

@braudpat wrote:

... except that the Blocks are inserted on Layer ZERO

and not on the current layer ... 

....

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

---

Sorry, misread that. To fix it just remove "0" from this expression.

(mapcar 'setvar sv '(0 0 0 "0"))

[braudpat]

Hello @ВeekeeCZ 

Thanks for the small improvment :

;; (mapcar 'setvar sv '(0 0 0 "0" )) ;; Insert on Layer ZERO
   (mapcar 'setvar sv '(0 0 0 )) ;; Insert on CURRENT Layer

And I have added 2 lines at the beginning and at the end :

(command "._undo" "_begin")

(command "._undo" "_end")

So now YOUR routine is PERFECT !

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

[ВeekeeCZ]

@braudpat 

thank you.

Please take the updated code at msg 3

I needed to change that very last line of code - because the routine did not restore changed system variables! oops!