Prefix suffix increment output modify

[Speedster2]

Hi everyone... I have a lisp (created by AutoCAD Guru Lee Mac).... I modified it as per my requirement... Now I m struck... Output of this lisp creates new text... I need to output replace existing entity like attributed block....

inc1.lsp

[Lee Mac]

(Original source)

 

Here's a very quick modification to provide the option to switch between either creating new text and replacing the content held by existing text/mtext/attributes:

(defun c:inc1 ( / *error* alp ang enx flg hgt ins lay num ocs sty )

    (defun *error* ( msg )
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )
    
    (setq sty (getvar 'textstyle) ;; Text Style
          hgt (getvar 'textsize)  ;; Text Height
          lay (getvar 'clayer)    ;; Text Layer
          ocs (trans '(0 0 1) 1 0 t)
          ang (angle '(0 0) (trans (getvar 'ucsxdir) 0 ocs t))
    )
    
    (if (not inc:alp) (setq inc:alp "A"))
    (if (not inc:num) (setq inc:num   1))
    (if (not (tblsearch "style" sty)) (setq sty (getvar 'textstyle)))
    
    
    (initget 4)
    (if (setq num (getint (strcat "\nSpecify numerical prefix <" (itoa inc:num) ">: ")))
        (setq inc:num num)
        (setq num inc:num)
    )
    
    (while
        (not
            (or
                (= "" (setq alp (strcase (getstring (strcat "\nSpecify alpha suffix <" inc:alp ">: ")))))
                (wcmatch alp "~*[~A-Z]*")
            )
        )
        (princ "\nSufix may only contain the characters A-Z.")
    )
    (if (= "" alp)
        (setq alp inc:alp)
        (setq inc:alp alp)
    )
    (while
        (progn
            (if flg
                (progn
                    (initget "Prefix Suffix Object Exit")
                    (setq ins (getpoint (strcat "\rSpecify point for " (itoa num) alp " [Prefix/Suffix/Object/Exit] <Exit>: ")))
                )
                (progn
                    (initget "Prefix Suffix pOint Exit")
                    (setq ins (nentsel (strcat "\nSelect text, mtext or attribute for " (itoa num) alp " [Prefix/Suffix/pOint/Exit] <Exit>: ")))
                )
            )
            (and ins (/= "Exit" ins))
        )
        (cond
            (   (member ins '("pOint" "Object")) (setq flg (not flg)))
            (   (= "Prefix" ins) (setq num (1+ num) alp inc:alp))
            (   (= "Suffix" ins) (setq alp (LM:alpha++ alp)))
            (   (= 'ename (type (car ins)))
                (if
                    (and
                        (= 2 (length ins))
                        (wcmatch (cdr (assoc 0 (setq enx (entget (car ins))))) "TEXT,MTEXT,ATTRIB")
                    )
                    (progn
                        (entmod (subst (cons 1 (strcat (itoa num) alp)) (assoc 1 enx) enx))
                        (setq alp (LM:alpha++ alp))
                    )
                    (princ "\nThe selected object is not text, mtext or attribute.")
                )
            )       
            (   (entmake
                    (list
                       '(000 . "TEXT")
                        (cons 008 lay)
                        (cons 007 sty)
                        (cons 040 hgt)
                        (cons 050 ang)
                        (cons 010 (trans ins 1 ocs))
                        (cons 001 (strcat (itoa num) alp))
                        (cons 210 ocs)
                    )
                )
                (setq alp (LM:alpha++ alp))
            )
        )
    )
    (princ)
)

;; Alpha++  -  Lee Mac
;; Increments an uppercase alphabetical string by one, e.g. AZ => BA
;; a - [str] uppercase alphabetical string

(defun LM:alpha++ ( a / n )
    (if (= "" a)
        "A"
        (if (= "Z" (substr a (setq n (strlen a))))
            (strcat (LM:alpha++ (substr a 1 (1- n))) "A")
            (strcat (substr a 1 (1- n)) (chr (1+ (ascii (substr a n)))))
        )
    )
)

(princ)

 

[Speedster2]

Thanks for your reply Lee Mac.... It worked... Saves my day.... Hats off to you....

[Lee Mac]

You're most welcome @Speedster2, glad it helps