Jump to content

Need help to change a script o found one


Alerie

Recommended Posts

Hi,

I need a script to add a value "n" at last number in a text string. If possible that also work on block and multiselection.

 

Example:

TT-1530 -> TT-1890

10-TT-1530 -> 10-TT-1890

 

Can you help me please ?

I dont know how edit or write script, but I found two script on internet

 

First Script:

This script add the value at the first number of string and not at last and dont work on block.

 

(defun DXF (code elist)

; finds the association pair, strips 1st element
   (cdr (assoc code elist))
)
(princ)

(defun c:CEL (/ me ce hl rm bm bmoff dprec i j en ed ety lay ss len etxt wtxt elen pretxt txt posttxt ex ey ez ntxt nz old new nxyz mod)

(prompt "\n\nChange Bench Mark for Annotation Text  v2.2      2/10/93")
;
  (setq me (getvar "menuecho"))
  (setvar "menuecho" 0)
  (setq ce (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq rm (getvar "regenmode"))
  (setvar "regenmode" 0)
  (setq bm (getvar "blipmode"))
  (setvar "blipmode" 0)

;  Prompt for bench mark offset

   (print)
   (initget 1)
   (setq bmoff (getreal "\nEnter value for bench mark offset, <0> to exit? "))
   (if (/= bmoff 0)
       (progn
           (initget 1)
            (setq dprec (getint "Enter decimal precision for annotation? "))
            (prompt "\n\nBench Mark Offset value:            ")(princ bmoff)
            (prompt   "\nDecimal precision on annotation:    ")(princ dprec)

;  Locate text to change and select all text on that layer

; prompt user to pick text entity
       
;  Create selection set of all annotation text entities


              (setq ss (ssget (list (cons 0 "TEXT"))))


;  Process text and modify based on bench mark offset
           (setq i 0
                 mod 0)
           (setq len (sslength ss))
           (while (< i len)
               (setq en (ssname ss i)
                       ed (entget en)
                       txt ""
                       pretxt ""
                       posttxt ""
                       noproc 0)
                   (setq etxt (dxf 1 ed))
                   (setq wtxt etxt)
                 (setq ex (car (dxf 10 ed)))
                 (setq ey (cadr (dxf 10 ed)))
                 (setq ez (caddr (dxf 10 ed)))

               (setq elen (strlen etxt))
               (setq j 1)
; Locate PRE-text
               (if (not (member (substr etxt j 1) '("1" "2" "3" "4" "5" "6" "7" "8" "9" "0" ".")))
                   (progn
                       (while (< j  (1+ elen))
                           (if (not (member (setq cc (substr etxt j 1)) '("1" "2" "3" "4" "5" "6" "7" "8" "9" "0" ".")))
                               (setq j (1+ j))
                               (progn
                                   (setq pretxt (substr etxt 1 (- j 1)))
                                   (setq etxt (substr etxt j elen))
                                   (setq j (+ elen 2))
                                   (setq noproc 1)
                               );progn
                           );if
                       );while
                       (if (= j (1+ elen))
                           (setq noproc 1)
                       );if
                   );progn
                   (setq pretxt "")
               );if
;
; Locate text to modify
;
               (setq j 1)
               (setq elen (strlen etxt))
               (if (> elen 0)
                   (progn
                       (while (< j  (1+ elen))
                           (if (member (setq cc (substr etxt j 1)) '("1" "2" "3" "4" "5" "6" "7" "8" "9" "0" "."))
                               (setq j (1+ j))
                               (progn
                                   (if (member cc '("\"" "\'"))
                                       (progn
                                           (setq noproc 1)
                                           (setq j (1+ elen))
                                       );progn
                                       (progn
                                           (setq txt (substr etxt 1 (- j 1)))
                                           (setq posttxt (substr etxt j elen))
                                           (setq j (1+ elen))
                                       );progn
                                   );if
                               );progn
                           );if
                           (if (= j elen)
                               (progn
                                   (setq txt etxt)
                                   (setq posttxt "")
                               );progn
                           );if
                       );while
                   );progn
               );if
;
; Add BM Change
;

                    (if (= noproc 0)
                        (progn
                            (setq ztxt (rtos (+ (atof txt) bmoff) 2 dprec))
                         (setq ntxt (strcat pretxt ztxt posttxt))
                       (setq nz (+ ez bmoff))
;
;  Modifying entity data
;
                       (setq old (assoc 1 ed))
                       (setq new (cons 1 ntxt))        ; Text value
                       (setq ed (subst new old ed))
                       (setq ed (subst new old ed))
                       (entmod ed)
                       (setq mod (1+ mod))
                   );progn
                   (progn
                   );progn
               );if
               (setq i (+ i 1))
              );while
       ) ;progn

;
; result to BM OFFSET = 0
;
       (prompt "\n\nProgram terminated.  ")

   );endif
   (princ "\n\nThere were ")(princ len)(princ " entities processed and ")
       (princ mod)(princ " entities modified.")


; reset system variables
   (setvar "regenmode" rm)
   (setvar "blipmode" bm)
   (setvar "cmdecho" ce)
   (setvar "menuecho" me)


   (princ)

) ;End of CEL

 

 

Second Script:

This script add the value at every number on the string and add the decimal (dont work on block)

 

(defun c:Text_Inc (/ *error* ParseNumbers uFlag ss)
(vl-load-com)
;; Lee Mac ~ 10.03.10

(defun *error* (msg)
(setvar 'NOMUTT 0)
(and uFlag (vla-EndUndoMark *doc))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ))


(defun ParseNumbers (str / lst Num Aph x rtn)
;; Lee Mac ~ 20.09.09
(setq lst (vl-string->list str) Num "" Aph "")

(while (setq x (car lst))
(setq lst (cdr lst))

(cond ( (and (/= "" Num) (= 46 x))
(setq Num (strcat Num (chr x))))

( (< 47 x 58)
(setq Num (strcat Num (chr x))
rtn (cons Aph rtn) Aph ""))

(t (setq Aph (strcat Aph (chr x))
rtn (cons (read Num) rtn) Num ""))))

(vl-remove nil
(vl-remove "" (reverse (cons Aph (cons (read Num) rtn))))))


(setq *inc* (cond (*inc*) (1.0)))
(setq *inc* (cond ((getreal (strcat "\nSpecify Increment <"
(vl-princ-to-string *inc*) "> : ")))
(*inc*)))

(setq *doc (cond (*doc) ((vla-get-ActiveDocument (vlax-get-acad-object)))))

(setvar 'NOMUTT 1)
(princ "\nSelect Text to Increment <All> : ")
(if (or (ssget "_:L" '((0 . "MTEXT,TEXT")))
(ssget "_X" '((0 . "MTEXT,TEXT"))))
(progn
(setq uFlag (not (vla-StartUndoMark *doc)))

(vlax-for obj (setq ss (vla-get-ActiveSelectionSet *doc))
(vla-put-TextString obj
(apply (function strcat)
(mapcar
(function
(lambda (x) (if (vl-position (type x) '(INT REAL))
(rtos (+ x *inc*) (getvar 'LUNITS) 3) x)))

(ParseNumbers (vla-get-TextString obj))))))

(vla-delete ss)
(setq uFlag (vla-EndUndoMark *doc)))) 

(setvar 'NOMUTT 0)
(princ))

Link to comment
Share on other sites

Only if delimiter is like in your example "-" and not at all tested...

 

(defun c:lastattnumaddition ( / f-MR numstrchk ss n i bl str splitstr lastnumber pref newpref newstr attlst )

 (vl-load-com)

 (defun f-MR ( d s / d1 dl k ss c pl z l )
   (while (and (setq d1 (substr d 1 1)) (/= d1 ""))
     (setq d (substr d 2))
     (setq dl (cons d1 dl))
   )
   (foreach d1 dl
     (setq k -1 ss s)
     (while (and (setq c (substr ss 1 1)) (/= c ""))
       (setq ss (substr ss 2))
       (setq k (1+ k))
       (if (= c d1)
         (setq pl (cons k pl))
       )
     )
   )
   (if pl
     (progn
       (setq pl (vl-sort pl '<))
       (foreach p pl
         (if (null z)
           (setq z 1)
         )
         (setq l (cons (substr s z (1+ (- p z))) l))
         (setq z (+ p 2))
       )
       (setq l (cons (substr s z) l))
       (vl-remove "" (reverse l))
     )
     s
   )
 )

 (defun numstrchk ( s / ss ssl )
   (while (and (setq ss (substr s 1 1)) (/= ss ""))
     (setq s (substr s 2))
     (setq ssl (cons ss ssl))
   )
   (vl-every '(lambda ( x ) (vl-position x '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))) ssl)
 )

 (prompt "\nSelect blocks to perform operation on...")
 (setq ss (ssget "_:L" '((0 . "INSERT") (66 . 1))))
 (if ss
   (progn
     (initget 3)
     (setq n (getint "\nSpecify number for addition to last number of blocks attributes : "))
     (repeat (setq i (sslength ss))
       (setq bl (ssname ss (setq i (1- i))))
       (foreach att (append (vlax-invoke (vlax-ename->vla-object bl) 'getattributes) (vlax-invoke (vlax-ename->vla-object bl) 'getconstantattributes))
         (if (not (vl-position att attlst))
           (progn
             (setq str (vla-get-textstring att))
             (if (and 
                   (/= str "")
                   (or 
                     (and (listp (f-MR "/" str)) (listp (f-MR "-" (car (f-MR "/" str)))) (numstrchk (last (f-MR "-" (car (f-MR "/" str))))))
                     (and (listp (f-MR "/" str)) (= (type (f-MR "-" (car (f-MR "/" str)))) 'str) (numstrchk (f-MR "-" (car (f-MR "/" str)))))
                     (and (= (type (f-MR "/" str)) 'str) (listp (f-MR "-" str)) (numstrchk (last (f-MR "-" str))))
                   )
                 ) 
               (progn
                 (setq splitstr (f-MR "/" str))
                 (if (listp splitstr)
                   (progn
                     (setq pref (car splitstr))
                     (setq pref (f-MR "-" pref))
                     (if (listp pref)
                       (progn
                         (setq lastnumber (last pref))
                         (setq lastnumber (itoa (+ (atoi lastnumber) n)))
                         (setq pref (reverse (cons lastnumber (cdr (reverse pref)))))
                         (setq newpref "")
                         (foreach s (reverse pref)
                           (setq newpref (strcat s "-" newpref))
                         )
                         (setq newpref (vl-string-right-trim "-" newpref))
                         (setq newstr (strcat newpref "/" (last splitstr)))
                       )
                       (progn
                         (setq lastnumber (itoa (+ (atoi pref) n)))
                         (setq newstr (strcat lastnumber "/" (last splitstr)))
                       )
                     )
                   )
                   (progn
                     (setq splitstr (f-MR "-" splitstr))
                     (if (listp splitstr)
                       (progn
                         (setq lastnumber (last splitstr))
                         (setq lastnumber (itoa (+ (atoi lastnumber) n)))
                         (setq splitstr (reverse (cons lastnumber (cdr (reverse splitstr)))))
                         (setq newstr "")
                         (foreach s (reverse splitstr)
                           (setq newstr (strcat s "-" newstr))
                         )
                         (setq newstr (vl-string-right-trim "-" newstr))
                       )
                     )
                   )
                 )
                 (vla-put-textstring att newstr)
                 (setq attlst (cons att attlst))
               )
             )
           )
         )
       )
     )
   )
 )
 (princ)
)

M.R.

Edited by marko_ribar
Link to comment
Share on other sites

Thanks You for the Answer.

 

I tested just now and i recived this error:

 

; error: no function definition: VLA-PUT-TEXTSTREING

 

ps: is there a chance to let it work also with normal string of text ?

 

sorry for my bad english.

 

Andrea.

Link to comment
Share on other sites

I saw that typo... It seems that you grabbed the code as soon as I firstly posted, then I corrected that... Maybe try grabbing now once again... What do you mean normal text strings? That would be very similar, but I'd suggest another lisp based on my post... Now try on by yourself, you have something to start with... Report if you're stuck somewhere and post your code for revision...

 

M.R.

Link to comment
Share on other sites

I never write in LISP, I start soon. I writed only in C,C++, Java, Visual Basic, HTML. To String I thought a text that contains letters numbers and symbols. I must edit Text Box and Attribute of Box. Excuse the misunderstanding.

 

Do you know good lisp manual to read ? or guide to learn ?

 

Andrea

Link to comment
Share on other sites

Hi,

Marko Ribar.

 

I tried your scritp today and I could see that:

 

-Work on B1r5Qbc.png

 

-Dont Work on y9stmlf.png

 

-When you select multiply objects, the script change only the last object selected.

 

Sorry to bother you again, but can you help me again ?

I do not think I can read and learn the manual in time and I need this macro to work.

 

Thanks You.

Kind Regards

Andrea

Link to comment
Share on other sites

Hi,

Marko Ribar.

 

I tried your scritp today and I could see that:

 

-Work on "Block Reference"

 

-Dont Work on "Text"

 

-When you select multiply objects, the script change only the last object selected.

 

Sorry to bother you again, but can you help me again ?

I do not think I can read and learn the manual in time and I need this macro to work.

 

Thanks You.

Kind Regards

Andrea

Link to comment
Share on other sites

I've updated my previous code, and try this for texts...

 

(defun c:lasttxtnumaddition ( / f-MR ss n i txt str splitstr lastnumber pref newpref newstr )

 (vl-load-com)

 (defun f-MR ( d s / d1 dl k ss c pl z l )
   (while (and (setq d1 (substr d 1 1)) (/= d1 ""))
     (setq d (substr d 2))
     (setq dl (cons d1 dl))
   )
   (foreach d1 dl
     (setq k -1 ss s)
     (while (and (setq c (substr ss 1 1)) (/= c ""))
       (setq ss (substr ss 2))
       (setq k (1+ k))
       (if (= c d1)
         (setq pl (cons k pl))
       )
     )
   )
   (if pl
     (progn
       (setq pl (vl-sort pl '<))
       (foreach p pl
         (if (null z)
           (setq z 1)
         )
         (setq l (cons (substr s z (1+ (- p z))) l))
         (setq z (+ p 2))
       )
       (setq l (cons (substr s z) l))
       (vl-remove "" (reverse l))
     )
     s
   )
 )

 (prompt "\nSelect texts to perform operation on...")
 (setq ss (ssget "_:L" '((0 . "TEXT"))))
 (if ss
   (progn
     (initget 3)
     (setq n (getint "\nSpecify number for addition to last number of texts : "))
     (repeat (setq i (sslength ss))
       (setq txt (ssname ss (setq i (1- i))))
       (setq str (cdr (assoc 1 (entget txt))))
       (setq splitstr (f-MR "/" str))
       (if (listp splitstr)
         (progn
           (setq pref (car splitstr))
           (setq pref (f-MR "-" pref))
           (if (listp pref)
             (progn
               (setq lastnumber (last pref))
               (setq lastnumber (itoa (+ (atoi lastnumber) n)))
               (setq pref (reverse (cons lastnumber (cdr (reverse pref)))))
               (setq newpref "")
               (foreach s (reverse pref)
                 (setq newpref (strcat s "-" newpref))
               )
               (setq newpref (vl-string-right-trim "-" newpref))
               (setq newstr (strcat newpref "/" (last splitstr)))
             )
             (progn
               (setq lastnumber (itoa (+ (atoi pref) n)))
               (setq newstr (strcat lastnumber "/" (last splitstr)))
             )
           )
         )
         (progn
           (setq splitstr (f-MR "-" splitstr))
           (if (listp splitstr)
             (progn
               (setq lastnumber (last splitstr))
               (setq lastnumber (itoa (+ (atoi lastnumber) n)))
               (setq splitstr (reverse (cons lastnumber (cdr (reverse splitstr)))))
               (setq newstr "")
               (foreach s (reverse splitstr)
                 (setq newstr (strcat s "-" newstr))
               )
               (setq newstr (vl-string-right-trim "-" newstr))
             )
           )
         )
       )
       (entupd (cdr (assoc -1 (entmod (subst (cons 1 newstr) (assoc 1 (entget txt)) (entget txt))))))
     )
   )
 )
 (princ)
)

HTH, M.R.

Edited by marko_ribar
Link to comment
Share on other sites

Andrea, can you upload DWG showing before situation, and DWG showing after situation what should *.lsp do... You can manually create after situation just on few blocks, but DWG should show what do you need and *.lsp isn't doing as desired...

Link to comment
Share on other sites

My post at 9.17 It is the same of 9.22. Anyway I'll show you what I have to do. You script work fine 2/4 of case as you can see from the dwg and the script for Block dont work on Multiselection. I have 1,700 pages of dwg to edit and already the script you gave me helps me a lot. If you want to continue to help me I appreciate it, but I would not bother you too.

 

 

PS: I did all in one dwg in a table.

PSS: if you want add me to skype : Andrea Bacciarelli ( as avatar i have a guy with a lot knife in the back and a girl with a wrist bleeding)

edit: added 4th case

WORK.dwg

Link to comment
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
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.

×
×
  • Create New...