Jump to content
Speedster2

Prefix suffix increment output modify

Recommended Posts

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

Share this post


Link to post
Share on other sites
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)

 

  • Thanks 1

Share this post


Link to post
Share on other sites
Speedster2

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

emoticon-with-thank-you-sign-vector-27155415.jpg

Share this post


Link to post
Share on other sites
Lee Mac

You're most welcome @Speedster2, glad it helps :)

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...