Originally Posted by
waynekay24792565
Hi All,
I hope I am on the right forum.
I have been looking for a lisp routine that will replace multiple text entities with a block.
The block should be at the same insertion point as the text and the same rotation.
I found similar threads online, but not quite the same thing.
Does anyone have a routine to share?
I am not able to write the routine myself, so I was looking for an existing one.
Kind Regards,
WayneSA
Try this:
Code:
;;liviu_dova@yahoo.com
(vl-load-com)
(DEFUN C:REP-TXBK (/ *error* $Name bName EgEnt ENT lsBlN)
(defun *error* (s)
(or (wcmatch (strcase s) "*BREAK,*CANCEL*,*EXIT*") (prompt (strcat "\nError: " s)))
(princ)
) ;;*error*
;List of block names
(vlax-for
itm
(vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
(if (and
(vlax-property-available-p itm "Name")
(/= (substr (setq $Name (vla-get-name itm)) 1 1) "*")
)
(setq lsBlN (cons $Name lsBlN))
)
)
(if lsBlN
(progn
;;Choose the block
(while (not bName)
(setq bName (getstring T "\nEnter block name or [?]: "))
(cond
( (= bName "?")
(textscr)
(prompt "\nDefined blocks:")
(foreach el lsBlN (prompt (strcat "\n" el)))
(prompt "\nClick or Press any key to continue...")
(vl-catch-all-apply (function grread) (list nil 14 0))
(setq bName (graphscr))
)
( (= bName "")
(setq bName nil)
)
( (and bName (not (vl-position (strcase bName) (mapcar (function strcase) lsBlN))))
(setq bName (prompt (strcat "\nCould not find block name \"" bName "\".")))
)
(T nil)
)
)
;;Choose the text and replace it with the choosed block.
(while (and (setq ENT (car (entsel "\nSelect the text to be replaced: ")))
(= (cdr (assoc 0 (setq EgEnt (entget ENT)))) "TEXT")
)
(if (= (logand 4 (cdr (assoc 70 (entget (tblobjname "LAYER" (cdr (assoc 8 EgEnt))))))) 0) ;;Layer not locked
(progn
(entdel ENT)
(entmake
(list
(quote (0 . "INSERT"))
(quote (100 . "AcDbEntity"))
(cons 67 (cdr (assoc 67 EgEnt)))
(cons 410 (cdr (assoc 410 EgEnt)))
(cons 8 (cdr (assoc 8 EgEnt)))
(quote (100 . "AcDbBlockReference"))
(cons 2 bName)
(cons 10 (cdr (assoc 10 EgEnt)))
(cons 50 (cdr (assoc 50 EgEnt)))
)
)
)
(prompt "\nText is on a locked layer.")
)
)
)
(prompt "\nNo block definitions in the drawing.")
)
(princ)
) ;;REP-TXBK