Jump to content

Lisp to add a prefix or suffix to selected text

Guest JB_In_FLA

By Guest JB_In_FLA
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Guest JB_In_FLA

Guest JB_In_FLA

Posted
Posted

I am finding myself lost at my new job without a few lisp routines that really made my life easier. All the routines did was allow you to select text and type in a prefix to add to it and the other allowed you to type a suffix to add to it. Does anyone have anything similar that they wouldn't mind posting for me? Any help is appreciated.

David Bethel Grand Master

David Bethel

Posted
Posted

;| HTH -David|;

 

 

;=======================================================================
;    AddFix.Lsp                                    Mar 14, 2000
;    Add Either Suffix Or Prefix To Selected Strings
;================== Start Program ======================================
(princ "\nCopyright (C) 2000, Fabricated Designs, Inc.")
(princ "\nLoading AddFix v1.0 ")
(setq af_ nil lsp_file "AddFix")

;================== Macros =============================================
(defun PDot ()(princ "."))

(PDot);++++++++++++ Set Modes & Error ++++++++++++++++++++++++++++++++++
(defun af_smd ()
(SetUndo)
(setq olderr *error*
     *error* (lambda (e)
               (while (> (getvar "CMDACTIVE") 0)
                      (command))
               (and (/= e "quit / exit abort")
                    (princ (strcat "\nError: *** " e " *** ")))
               (and (= (logand (getvar "UNDOCTL")  8)
                    (command "_.UNDO" "_END" "_.U"))
               (af_rmd))
      af_var '(("CMDECHO"   . 0) ("MENUECHO"   . 0)
               ("MENUCTL"   . 0) ("MACROTRACE" . 0)
               ("OSMODE"    . 0) ("SORTENTS"   . 119)
               ("MODEMACRO" . ".")
               ("BLIPMODE"  . 0) ("EXPERT"     . 0)
               ("SNAPMODE"  . 1) 
               ("ORTHOMODE" . 1) ("GRIDMODE"   . 0)
               ("ELEVATION" . 0) ("THICKNESS"  . 0)
               ("FILEDIA"   . 0) ("FILLMODE"   . 0)
               ("SPLFRAME"  . 0) ("UNITMODE"   . 0)
               ("UCSICON"    . 1)
               ("HIGHLIGHT" . 1) ("REGENMODE"  . 1)
               ("COORDS"    . 2) ("DRAGMODE"   . 2)
               ("CECOLOR"   . "BYLAYER")
               ("CELTYPE"   . "BYLAYER")))
(foreach v af_var
  (and (getvar (car v))
       (setq af_rst (cons (cons (car v) (getvar (car v))) af_rst))
       (setvar (car v) (cdr v))))
(princ (strcat (getvar "PLATFORM") " Release " (ver)
       " -  Add Text Prefix/Suffix ....\n"))
(princ))

(PDot);++++++++++++ Return Modes & Error +++++++++++++++++++++++++++++++
(defun af_rmd ()
 (setq *error* olderr)
 (foreach v af_rst (setvar (car v) (cdr v)))
 (command "_.UNDO" "_END")
 (prin1))

(PDot);++++++++++++ Set And Start An Undo Group ++++++++++++++++++++++++
(defun SetUndo ()
(and (zerop (getvar "UNDOCTL"))
     (command "_.UNDO" "_ALL"))
(and (= (logand (getvar "UNDOCTL") 2) 2)
     (command "_.UNDO" "_CONTROL" "_ALL"))
(and (= (logand (getvar "UNDOCTL")  8)
     (command "_.UNDO" "_END"))
(command "_.UNDO" "_GROUP"))

(PDot);************ Main Program ***************************************
(defun af_ (/ olderr af_var af_rst st ns ss i en ed tv)
 (af_smd)

 (initget 1 "Prefix Suffix")
 (setq st (getkword "\nAdd Prefix/Suffix (P/S):   "))

 (setq ns (getstring t "\nNew String To Add:   "))

 (and (setq ss (ssget '((0 . "*TEXT"))))
      (setq i (sslength ss))
      (while (not (minusp (setq i (1- i))))
             (setq en (ssname ss i)
                   ed (entget en)
                   tv (cdr (assoc 1 ed))
                   ed (subst
                        (cons 1 (if (= st "Suffix")
                                    (strcat tv ns)
                                    (strcat ns tv)))
                        (assoc 1 ed) ed))
              (entmod ed)))

 (af_rmd))

(PDot);************ Load Program ***************************************
(defun C:AddFix () (af_))
(if af_ (princ "\nAddFix Loaded\n"))
(prin1)
;|================== End Program =======================================

Guest JB_In_FLA

Guest JB_In_FLA

Posted
Posted

Exactly what the doctor ordered! Thank you.

 

- Joe

  • 2 months later...
Adesu Rookie

Adesu

Posted
Posted

Hi JB_In_FLA,you can try my code

 

; aft is stand for add front text

; Design by Ade Suharna

; 11 August 2004

; program no. 67/09/2004

; edit by Ade Suharna 10 September 2004

; 06 October 2004

(defun c:aft (/ ent info1 opt ed)

(while

(setq ent (entget (car (entsel "\nCLICK TEXT FOR EDIT:")))

info1 (cdr (assoc 1 ent))

opt

(getstring T

(strcat "\nENTER NEW TEXT" "" ":"))

ed (subst (cons 1 (strcat opt info1))(assoc 1 ent) ent))

(entmod ed)

)

(princ)

)

 

; ta is stand for text add

; Design by Ade Suharna

; 10 September 2004

; program no. 65/09/2004

; edit by Ade Suharna 06/10/2004

(defun c:ta (/ ent info1 opt ed)

(while

(setq ent (entget (car (entsel "\nCLICK TEXT FOR EDIT:"))))

(setq info1 (cdr (assoc 1 ent)))

(setq opt (getstring (strcat "\nENTER NEW TEXT" "" ": ")))

(setq ed (subst (cons 1 (strcat info1 " " opt))(assoc 1 ent) ent))

(entmod ed)

)

(princ)

)

  • 4 years later...
  • 3 months later...
asos2000 Mentor

asos2000

Posted
Posted

thanx alanjt

its great but not working with attribute

alanjt Grand Master

alanjt

Posted
Posted
thanx alanjt

its great but not working with attribute

it's not supposed to. i had no interest in adding a prefix/suffix to attributes when i created it.

;;; Allows user to add a Prefix and/or Suffix to selected

;;; Text, Mtext and Multileaders.

are you saying you would want to add a prefix/suffix to all attributes in a selected block, or just selected attributes within a block? if i have time today, when i get to work, i'll add it as an option.
asos2000 Mentor

asos2000

Posted
Posted

Yes I would want to add a prefix/suffix to all attributes in selected blocks.

 

Could be optional to deal with all attributes in selected blocks and selected attributes withen a block?

alanjt Grand Master

alanjt

Posted
Posted
Yes I would want to add a prefix/suffix to all attributes in selected blocks.

 

Could be optional to deal with all attributes in selected blocks and selected attributes withen a block?

totally possible, i've got class in a few, but i'll look at it after i get to work.

 

the code is free to the world, you are more than welcome to attempt to edit it yourself, just make note of it in the preface.

  • 1 month later...
funkkybebel Rookie

funkkybebel

Posted
Posted

So did you looked for attribute suffix and prefix ?

Thank you for your help.

alanjt Grand Master

alanjt

Posted
Posted
So did you looked for attribute suffix and prefix ?

Thank you for your help.

 

I really haven't had the time. However, the code is there and you are more than welcome to give it a try.

  • 1 year later...
Cad64 Grand Master

Cad64

Posted
Posted
here's what i do. i had to completely write a new one after switching to annotative text & beginning the use of mleaders.

 

This is an old thread, but thank you for this Alan. You just saved me from several hours of very tedious work. :thumbsup:

  • 10 years later...
xpr0 Enthusiast

xpr0

Posted
Posted (edited)

 

 

On 7/27/2004 at 8:51 PM, David Bethel said:

;| HTH -David|;

 

 

  








;=======================================================================
;    AddFix.Lsp                                    Mar 14, 2000
;    Add Either Suffix Or Prefix To Selected Strings
;================== Start Program ======================================
(princ "\nCopyright (C) 2000, Fabricated Designs, Inc.")
(princ "\nLoading AddFix v1.0 ")
(setq af_ nil lsp_file "AddFix")

;================== Macros =============================================
(defun PDot ()(princ "."))

(PDot);++++++++++++ Set Modes & Error ++++++++++++++++++++++++++++++++++
(defun af_smd ()
(SetUndo)
(setq olderr *error*
     *error* (lambda (e)
               (while (> (getvar "CMDACTIVE") 0)
                      (command))
               (and (/= e "quit / exit abort")
                    (princ (strcat "\nError: *** " e " *** ")))
               (and (= (logand (getvar "UNDOCTL")  8)
                    (command "_.UNDO" "_END" "_.U"))
               (af_rmd))
      af_var '(("CMDECHO"   . 0) ("MENUECHO"   . 0)
               ("MENUCTL"   . 0) ("MACROTRACE" . 0)
               ("OSMODE"    . 0) ("SORTENTS"   . 119)
               ("MODEMACRO" . ".")
               ("BLIPMODE"  . 0) ("EXPERT"     . 0)
               ("SNAPMODE"  . 1) 
               ("ORTHOMODE" . 1) ("GRIDMODE"   . 0)
               ("ELEVATION" . 0) ("THICKNESS"  . 0)
               ("FILEDIA"   . 0) ("FILLMODE"   . 0)
               ("SPLFRAME"  . 0) ("UNITMODE"   . 0)
               ("UCSICON"    . 1)
               ("HIGHLIGHT" . 1) ("REGENMODE"  . 1)
               ("COORDS"    . 2) ("DRAGMODE"   . 2)
               ("CECOLOR"   . "BYLAYER")
               ("CELTYPE"   . "BYLAYER")))
(foreach v af_var
  (and (getvar (car v))
       (setq af_rst (cons (cons (car v) (getvar (car v))) af_rst))
       (setvar (car v) (cdr v))))
(princ (strcat (getvar "PLATFORM") " Release " (ver)
       " -  Add Text Prefix/Suffix ....\n"))
(princ))

(PDot);++++++++++++ Return Modes & Error +++++++++++++++++++++++++++++++
(defun af_rmd ()
 (setq *error* olderr)
 (foreach v af_rst (setvar (car v) (cdr v)))
 (command "_.UNDO" "_END")
 (prin1))

(PDot);++++++++++++ Set And Start An Undo Group ++++++++++++++++++++++++
(defun SetUndo ()
(and (zerop (getvar "UNDOCTL"))
     (command "_.UNDO" "_ALL"))
(and (= (logand (getvar "UNDOCTL") 2) 2)
     (command "_.UNDO" "_CONTROL" "_ALL"))
(and (= (logand (getvar "UNDOCTL")  8)
     (command "_.UNDO" "_END"))
(command "_.UNDO" "_GROUP"))

(PDot);************ Main Program ***************************************
(defun af_ (/ olderr af_var af_rst st ns ss i en ed tv)
 (af_smd)

 (initget 1 "Prefix Suffix")
 (setq st (getkword "\nAdd Prefix/Suffix (P/S):   "))

 (setq ns (getstring t "\nNew String To Add:   "))

 (and (setq ss (ssget '((0 . "*TEXT"))))
      (setq i (sslength ss))
      (while (not (minusp (setq i (1- i))))
             (setq en (ssname ss i)
                   ed (entget en)
                   tv (cdr (assoc 1 ed))
                   ed (subst
                        (cons 1 (if (= st "Suffix")
                                    (strcat tv ns)
                                    (strcat ns tv)))
                        (assoc 1 ed) ed))
              (entmod ed)))

 (af_rmd))

(PDot);************ Load Program ***************************************
(defun C:AddFix () (af_))
(if af_ (princ "\nAddFix Loaded\n"))
(prin1)
;|================== End Program =======================================
 

 

 

 i m trying to load this lisp but its throwing up this error in autocad 2017

 

Quote

Command: AP
APPLOAD Addfix.lsp successfully loaded.
Command:
Copyright (C) 2000, Fabricated Designs, Inc.
Loading AddFix v1.0 .; error: malformed list on input 

 Untitled.png.6cc2dd7638c6e90910cdec4a043429b5.png

Edited by xpr0
marko_ribar Veteran

marko_ribar

Posted
Posted (edited)

I haven't checked it deeply, but I believe here is the bug :

 

(and (= (logand (getvar "UNDOCTL") 8) 8) (command "_.UNDO" "_END" "_.U"))

(and (= (logand (getvar "UNDOCTL") 8) 8) (command "_.UNDO" "_END"))

 

Probably bug occured when site changed style - this is typical consequence - there are many examples where 8) was missing due to the fact that 8) represent similey with black glasses so it was erased...

Edited by marko_ribar
replace all smileys with 8) to see correctly... can't find disable smileys option...
mhupp Grand Master

mhupp

Posted
Posted (edited)

Here one I came up with. variable is saved to registry so it will persist between drawings. 

;;----------------------------------------------------------------------------;;
;; ADD TEXT PREFIX OR SUFFIX TO EXISTING TEXT
(defun C:ADDTXT (/ rep str *str ss txt sn vl e)
  (vl-load-com)
  (initget "Prefix Suffix")
  (setq rep
    (cond
      ((getkword "\nWhere to add Text [Prefix/Suffix]<Suffix>:")) ( "Suffix")
    )
  )
  (or (setq *str (getenv "Insert-Text")) (setq *str "Here"))
  (if (= "" (setq str (getstring (strcat "\nEnter " rep " Text \"" *str "\": "))))
    (setq str *str)
  )
  (setenv "Insert-Text" str)
  (setq ss (ssget "_:L" '((0 . "*TEXT"))))
  (foreach txt (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))
    (setq vl (vlax-ename->vla-object txt))
    (setq e (entget txt))
    (cond
      ((= rep "Prefix")
          (vla-put-textstring vl (strcat str (cdr (assoc 1 e))))
      )
      ((= rep "Suffix")
          (vla-put-textstring vl (strcat (cdr (assoc 1 e)) str))
      )
    )
  )
  (princ)
)

 

Edited by mhupp
added vl-load-com incase you don't have it loaded already.

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
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  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.

×
 Share
Go to topic listing
×
×
  • Create New...