View Full Version : Text prefix/suffix
s0r0l7
2004-07-29, 07:28 PM
Need simple autolisp to add parethesis (...text...) to front and back of text string.
Lemons
2004-07-29, 08:40 PM
Here's a routine that does it...
From the lisp guild many moons ago, sorry but I don't remember who wrote it.
(defun c:be (/ CNT ss pre suf ents val new)
(vl-load-com)
(setq CNT 0
ss (ssget
'((-4 . "<or") (0 . "TEXT") (0 . "MTEXT") (-4 . "OR>"))
)
)
(if ss
(progn
(setq pre (getstring "\nPrefix to add [Enter to skip]: ")
suf (getstring "\nSuffix to add [Enter to skip]: ")
)
(repeat (sslength ss)
(setq ents (entget (ssname ss CNT))
val (cdr (assoc 1 ents))
new (strcat pre val suf)
)
(setq ents
(subst (cons 1 new)
(assoc 1 ents)
ents
)
)
(entmod ents)
(setq CNT (1+ CNT))
)
)
(prompt "\nNothing Selected.")
)
(princ)
)
;;end defun[ Moderator Action = ON ] What are [ CODE ] tags... (http://forums.augi.com/misc.php?do=bbcode#code) [ Moderator Action = OFF ]
bbapties
2004-07-29, 09:14 PM
This is an interesting lisp.....I was trying to figure out when this would be good to have... Can you give an example of when this would come in handy..
peter
2004-07-30, 11:24 AM
Just for another way of doing it (with vl commands)
Peter Jamtgaard
(defun C:TextPS (/ intCount objSelection strPrefix strSuffix ssSelections)
(princ "\nSelect text and mtext: ")
(setq ssSelections (ssget (list (cons 0 "TEXT,MTEXT")))
strPrefix (getstring "\nEnter Prefix: " 't)
strSuffix (getstring "\nEnter Suffix: " 't)
)
(repeat (setq intCount (sslength ssSelections))
(setq intCount (1- intCount)
objSelection (vlax-ename->vla-object
(ssname ssSelections intCount)
)
)
(vla-put-textstring objSelection
(strcat
strPrefix
(vla-get-textstring objSelection)
strSuffix
)
)
)
(prin1)
)
Lemons
2004-08-02, 04:59 PM
This is an interesting lisp.....I was trying to figure out when this would be good to have... Can you give an example of when this would come in handy..
You'll know when you need it.
And thanks for the updated version, Peter. Less code is always better in my opinion.
Celie
Tom Beauford
2004-08-02, 07:27 PM
"APTXT" from Cadalyst is a dialog based routine that allows you to add prefixes or suffixes to any text with many options. I use it at least once a week.
Tip1527A: DDAPTXT.LSP Append to Text (c)June 1999, Scott A. Matthews
added support for MTEXT & DIMENSION's March 2003, Tom Beauford
;Tip1527A: DDAPTXT.LSP Append to Text (c)June 1999, Scott A. Matthews
;added support for MTEXT & DIMENSION's March 2003, Tom Beauford
(defun c:aptxt ( / cnt ent elist prefix ss suffix value) ; begin append text command
(aptxt_setup) ; run setup
(if (< (setq dcl_id (load_dialog "ddaptxt.dcl")) 0) ; if dialog file is not loaded
(exit) ; then exit
) ; end if
(while (< 2 what_next) ; continue until ok or cancel is picked
(if (not (new_dialog "ddaptxt" dcl_id)) ; if dialog box is not loaded
(exit) ; then exit
) ; end if
; start dialog box setup
(if (/= ss nil) ; if objects have been selected
(set_tile "select_txt" (rtos (sslength ss) 2 0)) ; then display number of objects
) ;end if
(if (/= prefix nil) ; if prefix is set
(set_tile "prefix_eb" prefix) ; then display prefix
) ; end if
(if (= prefix_space 1) ; if prefix is set
(set_tile "prefix_tb" "1") ; then display prefix
) ; end if
(if (= suffix_space 1) ; if prefix is set
(set_tile "suffix_tb" "1") ; then display prefix
) ; end if
(if (/= suffix nil) ; if suffix is set
(set_tile "suffix_eb" suffix) ; then display suffix
) ; end if
; end dialog box setup
; start actions for tiles
(action_tile "accept" "(setq key $key)(done_dialog 0)")
(action_tile "cancel" "(setq key $key)(done_dialog 0)")
(action_tile "select_pb" "(setq key $key)(done_dialog 3)")
(action_tile "prefix_eb" "(setq prefix $value)")
(action_tile "prefix_tb" "(setq prefix_space (atoi $value))")
(action_tile "suffix_eb" "(setq suffix $value)")
(action_tile "suffix_tb" "(setq suffix_space (atoi $value))")
; end actions for tiles
(setq what_next (start_dialog)) ; throw up the dialog
(cond
((= key "accept") ; if ok button is picked
(if (= ss nil) ; if no text objects have been selected
(progn ; then
(setq what_next 5) ; continue with append text command
(alert "No text objects selected.") ; prompt user to select objects
) ; end progn
(while (setq ent (ssname ss cnt)) ; while there are still text entities to process
(setq cnt (1+ cnt) ; add one to counter
elist (entget ent) ; get entity list
old (dxf 1 elist) ; get text value
new old ; set new same as old
) ; end setq
(if (= new "")(setq new "<>")) ; if DIMENSION
(if (/= prefix nil) ; if text prefix is set
(if (= prefix_space 1) ; if space after prefix is on
(setq new (strcat prefix " " new)) ; then add the prefix plus a space to text string
(setq new (strcat prefix new)) ; else add the prefix to text string
) ; end if
) ; end if
(if (/= suffix nil) ; if text prefix is set
(if (= suffix_space 1) ; if space before suffix is on
(setq new (strcat new " " suffix)) ; then add the suffix plus a space to text string
(setq new (strcat new suffix)) ; else add the suffix to text string
) ; end if
) ; end if
(entmod (subst (cons 1 new) (cons 1 old) elist)) ; update text with new value
) ; end while
) ; end if
) ; end if
((= key "select_pb") ; if select button is picked
; (setq ss (ssget (list (cons 0 "TEXT")))) ; create a selection set of text objects
(setq ss (ssget (list (cons 0 "TEXT,MTEXT,DIMENSION")))) ; create a selection set of text objects
) ; end if
) ; end cond
) ; end while
(aptxt_reset) ; run reset
) ; begin append text command
(defun aptxt_err (s) ; begin error function
(if (not (member s '("console break" "Function canceled" "Invalid selection"))) ; if command is aborted
(princ (strcat "\nError: " s)) ; then prompt user
) ; end if
(command ".undo" "b") ; undo back to mark
(aptxt_reset) ; run reset
) ; end error function
(defun aptxt_reset () ; begin reset function
(setvar "cmdecho" cmde) ; reset command echo
(setq *error* olderr) ; reset error function to old error function
(princ "\n \n \n") ; clean up command prompt
(princ) ; clean up command prompt
) ; end reset function
(defun aptxt_setup () ; begin setup function
(setq olderr *error* *error* aptxt_err ; set error function to append text's error function
cmde (getvar "cmdecho") ; get current value of command echo
cnt 0 ; set counter to zero
prefix_space 1
suffix_space 1
what_next 5 ; continue main function until ok or cancel is picked
) ; end setq
(setvar "cmdecho" 0) ; set command echo to zero
(command ".undo" "m") ; set undo mark in drawing database
) ; end setup function
(defun dxf (list_itn ent_list) ; begin dxf function
(cdr (assoc list_itn ent_list)) ; get value of item from entity list
) ; end dxf function
(princ)
//Tip1527B: DDAPTXT.DCL Append to Text (c)1999, Scott A. Matthews
ddaptxt : dialog {
label = "Append Text";
: row {
: button {
key = "select_pb";
label = "Select <";
mnemonic = "S";
} // end select button
: concatenation {
: text_part {
value = "Objects Found:";
width = 13;
} // end text part
: text_part {
key = "select_txt";
value = "0";
width = 5; } // end text part
} // end text concatenation
} // end row
spacer_1;
: edit_box {
key = "prefix_eb";
label = "Prefix";
mnemonic = "P";
} // end prefix edit box
: toggle {
key = "prefix_tb";
label = "Space after prefix?";
mnemonic = "a";
} // end add space toggle button
: toggle {
key = "suffix_tb";
label = "Space before suffix?";
mnemonic = "b";
} // end add space toggle button
: edit_box {
key = "suffix_eb";
label = "Suffix";
mnemonic = "u";
} // end suffix edit box
spacer_1;
ok_cancel;
spacer_1;
} // end main dialog box
LanceMcHatton
2004-08-03, 05:48 PM
Here's mine if you're interested. I don't know who originally wrote it but it automatically provides ( and ) without having to type them in.
(defun c:addpar ()
(setvar "cmdecho" 0)
(command "UNDO" "M")
(setq B 0)
(setq C 0)
(princ "\nSelect text entities to change: ")
(setq SSET (ssget))
(setq PRE "(")
(setq SUF ")")
(while (= B 0)
(setq ENT (ssname SSET C))
(if (= ENT nil)
(setq B 1)
(progn
(setq ED (entget ENT))
(setq TYPE1 (cdr (assoc 0 ED)))
(if (= TYPE1 "TEXT")
(setq D 0)
(if (= TYPE1 "ATTDEF")
(setq D 0)
(progn
(setq SSET (ssdel ENT SSET))
(setq c (- c 1))
)
)
)
(if (= D 0)
(progn
(setq STRING (cdr (assoc 1 ED)))
(setq STRING (strcat PRE STRING SUF))
(setq ED (subst (cons 1 STRING) (assoc 1 ED) ED))
(entmod ED)
)
)
(setq D 1)
(setq C (+ C 1))
)
)
)
(setvar "cmdecho" 1)
(princ)
)[ Moderator Action = ON ] What are [ CODE ] tags... (http://forums.augi.com/misc.php?do=bbcode#code) [ Moderator Action = OFF ]
Powered by vBulletin® Version 4.1.11 Copyright © 2013 vBulletin Solutions, Inc. All rights reserved.