Rename block with getkword

[sivapathasunderam]

This is a simple rename block routine

(defun c:renameBlock (/ ent elst oldName newName)
    (while (and (setq ent (car (entsel "\nSelect block: ")))
                (= (cdr (assoc 0 (setq elst (entget ent)))) "INSERT"))
           (setq oldName (cdr (assoc 2 elst))
                 newName (getstring (strcat "\nCurrent name: '" oldName "'. New bloc name: ")));setq
           (while (tblsearch "BLOCK" newName)
               (setq newName (getstring (strcat "\n'" newName "' already exists. New bloc name: "))));while
           (entmod (subst (cons 2 newName)
                          (cons 2 oldName)
                          (entget (cdr (assoc 330 (entget (tblobjname "BLOCK" oldName))))))));Main while
 (princ))

 

I want to modify the above routine with getkword function

(initget "Main-Title-block Sub-Title-block")
(strcat "\n'" newName "' is already exists. Your new block name is: ")
(getkword  "\nChoose [Main-Tittle-block/Sub-Tittle-block]: ")

I wanted to correct many blocks names without typing !

[Lee Mac]

Try the following sample -

(defun c:rnb ( / ent enx new opt )

    (setq opt
       '(
        ;;    Keyword .  Block Name
            ("Main"   . "Main-Title-block")
            ("Sub"    . "Sub-Title-block")
        )
    )

    (cond
        (   (null (setq opt (vl-remove-if '(lambda ( x ) (tblsearch "block" (cdr x))) opt)))
            (princ "\nAll target block names already exist in the active drawing.")
        )
        (   (progn
                (while
                    (progn
                        (setvar 'errno 0)
                        (setq ent (car (entsel "\nSelect block to be renamed: ")))
                        (cond
                            (   (= 7 (getvar 'errno))
                                (princ "\nMissed, try again.")
                            )
                            (   (null ent)
                                nil
                            )
                            (   (/= "INSERT" (cdr (assoc 0 (entget ent))))
                                (princ "\nThe selected object is not a block.")
                            )
                        )
                    )
                )
                (null ent)
            )
            (princ "\n*Cancel*")
        )
        (   (progn
                (initget (LM:lst->str (mapcar 'car opt) " "))
                (setq new (getkword (strcat "\nNew block name [" (LM:lst->str (mapcar 'car opt) "/") "]: ")))
            )
            (setq enx (entget (cdr (assoc 330 (entget (tblobjname "block" (LM:name->effectivename (cdr (assoc 2 (entget ent))))))))))
            (entmod (subst (cons 2 (cdr (assoc new opt))) (assoc 2 enx) enx))
        )
        (   (princ "\n*Cancel*"))
    )
    (princ)
)

;; Block Name -> Effective Block Name  -  Lee Mac
;; blk - [str] Block name

(defun LM:name->effectivename ( blk / rep )
    (if
        (and (wcmatch blk "`**")
            (setq rep
                (cdadr
                    (assoc -3
                        (entget
                            (cdr (assoc 330 (entget (tblobjname "block" blk))))
                           '("AcDbBlockRepBTag")
                        )
                    )
                )
            )
            (setq rep (handent (cdr (assoc 1005 rep))))
        )
        (cdr (assoc 2 (entget rep)))
        blk
    )
)


;; List to String  -  Lee Mac
;; Concatenates each string in a supplied list, separated by a given delimiter
;; lst - [lst] List of strings to concatenate
;; del - [str] Delimiter string to separate each item

(defun LM:lst->str ( lst del )
    (if (cdr lst)
        (strcat (car lst) del (LM:lst->str (cdr lst) del))
        (car lst)
    )
)

(princ)