Help with code : Adding Prefix
Hi David Bethel .I know that this is a very old post but i need a litle help with your code. I have someattribute blocks and i use your code to add add Suffix or Prefix. The problem that most of them have thee tags and i want to add Suffix or Prefix only to the fistIn this 3 blocks i need to add Suffix or Prefix only in the tag with the name Point
;define a function named addstr ;the c: creates a command line call ;(/ local_variable_list)(defun c:addstr (/ atype ns ss en ed an ad av nv i) ;initialize a (getxxxx) call ;if bit1 is set in (getkword), it forces an input of 1 of of the keywords ;"Keyword List" (initget 1 "Suffix Prefix") ;Select the type of action needed (setq atype (getkword "\nAdd Suffix or Prefix (S/P): ")) ;if bit 1 is set , this forces a non nil input (initget 1) ;get user input of NewString ;allow spaces , case sensitive (setq ns (getstring t "\nString To Add:")) ;if user creates a SelectionSet of INSERTs with ATTRIButes (and (setq ss (ssget '((0 . "INSERT")(66 . 1)))) ;Initialize an integer counter (setq i 0) ; step thru the selection SS 1 EName at a time (while (setq en (ssname ss i)) ;retrieve the EntityDefinition (setq ed (entget en) ;retrieve the 1st Attribute eName an (entnext en) ;retrieve the 1st Attribute Definition ad (entget an)) ;step thru the INSERT definition and ;retrieve each attribute until a SEQEND entity is returned (while (/= "SEQEND" (cdr (assoc 0 ad))) ;retrieve the current Attribute Value (setq av (cdr (assoc 1 ad)) ; concatenate the New Value nv (if (= atype "Prefix") (strcat ns av) (strcat av ns))) ;modify the attribute entity definition with the new value (entmod (subst (cons 1 nv) (assoc 1 ad) ad)) ; go to the next Attribute Name and Definition (setq an (entnext an) ad (entget an))) ;update the main insert Entity Name (entupd en) ;increase the integer counter (setq i (1+ i))));exit the routine cleanly(prin1))
Any ideas. Thanks
Point.dwg
STATION.dwg
trigonom.dwg I have and this code but i have the same problem
defun c:PSBLOCK ( / as el en i ss str typ ) (initget "Prefix Suffix") (setq typ (cond ((getkword "\nAdd Suffix or Prefix: ")) ("Prefix"))) (setq str (getstring t (strcat typ " to Add: "))) (if (setq ss (ssget '((0 . "INSERT") (66 . 1)))) (repeat (setq i (sslength ss)) (setq en (ssname ss (setq i (1- i)))) (while (eq "ATTRIB" (cdr (assoc 0 (setq el (entget (setq en (entnext en))))))) (setq as (cdr (assoc 1 el))) (if (eq "Prefix" typ) (if (not (wcmatch as (strcat str "*"))) (entmod (subst (cons 1 (strcat str as)) (assoc 1 el) el)) ) (if (not (wcmatch as (strcat "*" str))) (entmod (subst (cons 1 (strcat as str)) (assoc 1 el) el)) ) ) ) ) ) (princ)) Try this:
(defun c:psblock (/ as el en i n pat ss str tag typ) ;; Change tag to suit (setq tag "POINT") (initget "Prefix Suffix") (if (and (setq typ (cond ((getkword "\nAdd Suffix or Prefix: ")) ("Prefix") ) ) (/= "" (setq str (getstring t (strcat typ " to Add: ")))) (setq ss (ssget ":L" '((0 . "INSERT") (66 . 1)))) ) (repeat (setq i (sslength ss)) (setq en (ssname ss (setq i (1- i)))) (while (eq "ATTRIB" (cdr (assoc 0 (setq el (entget (setq en (entnext en)))))))(setq as(cdr (assoc 1 el)) pat (cond ((eq "Prefix" typ) (strcat str as)) ((strcat as str)) ) n (vl-string-search (strcase str) (strcase as)));; Check that tagname matches and the text is different(if (and (= tag (cdr (assoc 2 el))) (or (null n) (not (wcmatch (strcase as) (strcase (cond ((= 0 n) (strcat str "*")) ((strcat "*" str)) ) ) ) ) ) )(entmod (subst (cons 1 pat) (assoc 1 el) el))) ) ) ) (princ)) Hi ronjonp thanks for the help.For thePrefix work fine but when i select Suffix delete all the exist text and insert only the Suffix leter.Any idea ? My bad .. give the code above a try again. Thank you for the help :D You're welcome If you only want to change the 1st attribute you can do this without knowing the tag name, actaully can change any attribute by supplying its order number.
Here is an example
(defun blpos ( / ss1 blname x num inc)(setq blname(cdr (assoc 2 (entget (car (entsel "pick a block"))))))(setq ss1 (ssget "x"(list (cons 0"INSERT") (cons 2blname))))(setq num (- (getint "\nEnter attribute position") 1)) ; attributes start at zero hence -1(setq pref "ASDF")(repeat (setq inc (sslength ss1))(setq atts (vlax-invoke (vlax-ename->vla-object (ssname SS1 (setq inc (1- inc)) )) 'getattributes))(vla-put-textstring (nth num atts) (strcat pref (vla-get-textstring (nth num atts))))) ; end repeat) ; end defun(blpos) Here's something that may be useful :
;;; Edit ATTRIButes By Number 1st/2nd/3rd Replace/Suffix/Prefix(defun c:att-ean (/ n et ns ss i en an ad x et nv);(SetUndo) (initget 7) (setq n (getint "\nATTRIBute Number To Edit:")) (initget 1 "Replace Prefix Suffix") (setq et (getkword "\nEdit Type - Replace Prefix Suffix: ")) (cond ((= et "Replace") (setq ns (getstring t (strcat "\nReplacement String For ATTRIBute " (itoa n) ": ")))) ((= et "Prefix") (setq ns (getstring t (strcat "\nPrefix To Add To ATTRIBute " (itoa n) ": ")))) ((= et "Suffix") (setq ns (getstring t (strcat "\nSuffix To Add To ATTRIBute " (itoa n) ": "))))) (while (not ss) (setq ss (ssget (list (cons 0 "INSERT") (cons 66 1))))) (setq i 0) (while (setq en (ssname ss i)) (setq an (entnext en) ad (entget an) x 1) (while (= "ATTRIB" (cdr (assoc 0 ad))) (and (= x n) (setq nv (cond ((= et "Replace") ns) ((= et "Prefix")(strcat ns (cdr (assoc 1 ad)))) ((= et "Suffix")(strcat (cdr (assoc 1 ad)) ns)))) (setq ad (subst (cons 1 nv) (assoc 1 ad) ad)) (entmod ad)) (setq x (1+ x) an (entnext an) ad (entget an))) (entupd en) (setq i (1+ i)));(EndUndo) (prin1))
-David
页:
[1]