Text to be replaced with Attibute text block

[YSRINY2I]

Dear Friends,

I want to replace normal text to be replaced with attribute text block. From selected text need to be consider width and rotation and place the attribute text block in the same place with rotation and width. text to be deleted after placing the attribute text block (Line code) . I have attached cad file and mentioned what text to be replaced and with which block to be replaced. I need lisp like select one more text at a time and need to replaced selected texts with attribute block one time. Please help me out, i need to update 120 PID file like this.

 

Kind regards,

Srinivasa rao.

TEST.dwg

[BIGAL]

This is real quick, requires a block you can rename, used bedit 1 attribute, attdef insert 0,0,0 text ht 2.5, text style ISO. Tested and went exactly over top.

 

I have set new layer ? if required or set to Lay, same with erase remove ; for testing 1st check all is ok.

 

(defun c:test ( / oldlay x ss ent txt ins)
(setq lay (cdr (assoc 8 (entget (car (entsel "\nPick text for layer" ))))))
(setq ss (ssget (list (cons 8 lay))))
(setq oldlay (getvar 'clayer))
;(setvar 'clayer newlayer)
(repeat (setq x (sslength ss))
(setq ent (ssname ss (setq x (- x 1))))
(setq txt (cdr (assoc 1 (entget ent))))
(setq ins (cdr (assoc 10 (entget ent))))
;(command "erase" ent "")
(command "-insert" "block1att" ins 1 1 0 txt)
)
(setvar 'clayer oldlay)
(princ)
)

 

 

Edited June 20, 2020 by BIGAL

[pBe]

To make things complicated 

 

(defun c:DemonstrationOfChangingTextToAttribute
       (/			 selectionset
	increment		 TheSelectedTextObject
	dataFromSelectedTextObject
       )
  (if (and
	(tblsearch "BLOCK" "Line code")
	(setq selectionset (ssget "_:L" '((0 . "TEXT"))))
      )
    (repeat (setq increment (sslength selectionset))
      (setq TheSelectedTextObject
	     (ssname selectionset
		     (setq increment (1- increment))
	     )
      )
      (setq dataFromSelectedTextObject (entget TheSelectedTextObject))
      (setq dataIneedFromSelectedTextObject
	     (mapcar
	       (function
		 (lambda (dxfcodes)
		   (assoc
		     dxfcodes
		     dataFromSelectedTextObject
		   )
		 )
	       )
	       '(1 40 7 10 50 41 8)
	     )
      )
      (entmake
	(append
	  (list	'(0 . "INSERT")
		'(66 . 1)
		'(2 .  "Line code")
	  )
	  (cdddr dataIneedFromSelectedTextObject)
	)
      )

      (entmake
	(append
	  (list
	    '(0 . "ATTRIB")
	    '(2 . "LINE_CODE")
	    '(70 . 0)
	  )
	  dataIneedFromSelectedTextObject
	)
      )
      (entmake '((0 . "SEQEND")))
      (entdel TheSelectedTextObject)
    )
  )
  (princ)
)

 

Edited June 21, 2020 by pBe

[YSRINY2I]

50 minutes ago, pBe said:

To make things complicated 

 

Dear PBE, Tool is working perfect. Thanks for the Help.

(defun c:DemonstrationOfChangingTextToAttribute
       (/			 selectionset
	increment		 TheSelectedTextObject
	dataFromSelectedTextObject
       )
  (if (and
	(tblsearch "BLOCK" "Line code")
	(setq selectionset (ssget "_:L" '((0 . "TEXT"))))
      )
    (repeat (setq increment (sslength selectionset))
      (setq TheSelectedTextObject
	     (ssname selectionset
		     (setq increment (1- increment))
	     )
      )
      (setq dataFromSelectedTextObject (entget TheSelectedTextObject))
      (setq dataIneedFromSelectedTextObject
	     (mapcar
	       (function
		 (lambda (dxfcodes)
		   (assoc
		     dxfcodes
		     dataFromSelectedTextObject
		   )
		 )
	       )
	       '(1 40 7 10 50 41 8)
	     )
      )
      (entmake
	(append
	  (list	'(0 . "INSERT")
		'(66 . 1)
		(cons 2 "Line code")
	  )
	  (cdddr dataIneedFromSelectedTextObject)
	)
      )

      (entmake
	(append
	  (list
	    '(0 . "ATTRIB")
	    (cons 2 "LINE_CODE")
	    '(70 . 0)
	  )
	  dataIneedFromSelectedTextObject
	)
      )
      (entmake '((0 . "SEQEND")))
      (entdel TheSelectedTextObject)
    )
  )
  (princ)
)

 

 

[YSRINY2I]

1 hour ago, BIGAL said:

This is real quick, requires a block you can rename, used bedit 1 attribute, attdef insert 0,0,0 text ht 2.5, text style ISO. Tested and went exactly over top.

 

I have set new layer ? if required or set to Lay, same with erase remove ; for testing 1st check all is ok.

 

(defun c:test ( / oldlay x ss ent txt ins)
(setq lay (cdr (assoc 8 (entget (car (entsel "\nPick text for layer" ))))))
(setq ss (ssget (list (cons 8 lay))))
(setq oldlay (getvar 'clayer))
;(setvar 'clayer newlayer)
(repeat (setq x (sslength ss))
(setq ent (ssname ss (setq x (- x 1))))
(setq txt (cdr (assoc 1 (entget ent))))
(setq ins (cdr (assoc 10 ((entget ent))))
;(command "erase" ent "")
(command "-insert" "block1att" ins 1 1 0 txt)
)
(setvar 'clayer oldlay)
(princ)
)

 

 

Dear Bigal, Thanks for the Effort. But tool is not working. Thanks for the commitment.

[BIGAL]

When I pasted dropped a closing bracket code updated sorry about that, Pbe has provided a good alternative.