Topic: Help needed to mod lisp to be more flexible - add integer to attribute numbers

[jaydee]

Hi.
I have used this routine for sometime from Stig Madsen, jan. 2002, but limited usage because the way it add multiple numbers in a attribute string.
What this lisp does is add/subtract INTEGER  number to existing attribute numbers.
ie. add 5
bla123bla  ==>
bla128bla

ie. add 2
bla-123bla.456/bla678  ==>
bla-125bla.458/bla680

But more often then not, I only need to add integer to the first set, or second set or third set of numbers in the string.

What i would like to accomplish is with additional options
(prompt "add to first number, add to second number, add to last number?")

ie. add 5 to first number
bla123bla  ==>
bla128bla

ie. add 2 to first number
bla-123bla.456/bla678  ==>
bla-125bla.456/bla678

ie. add 10 to second number
bla-123bla.456bla  ==>
bla-123bla.466bla

ie. add 10 to last number
bla-123bla.456/bla678  ==>
bla-123bla.456/bla778

Please show me the way.

Thankyou in advance

Code: [Select]

;;; ****************************************************
;;; ATTCALC - calculate numbers in attributes          *
;;; Stig Madsen, jan. 2002                             *
;;; ****************************************************

;; pflag is used if more consecutive numbers are
;; separated with periods. First period turns it
;; on and second numbers turns it off.

(defun makelist (str / alist a astr ch num test pflag pch)
  (setq a 1
        astr ""
        pflag nil
  )
  (if (<= 48 (ascii (substr str 1 1)) 57)
    (setq num T)
    (setq num nil)
  )
  (repeat (strlen str)
    (setq ch (substr str a 1))
    (setq test num)
    (cond
      ((= ch ".")
       (if (>= a 2)
         (if (and (<= 48 (ascii (substr str (1- a) 1)) 57)
                  (<= 48 (ascii (substr str (1+ a) 1)) 57)
             )
           (progn
             (if pflag
               (setq num (not test))
               (progn (setq num T) (setq pflag T))
             )
           )
           (setq num nil)
         )
         (setq num nil)
       )
      )
      ((<= 48 (ascii ch) 57) (setq num T))
      (T (setq num nil))
    )
    (if (= test num)
      (setq astr (strcat astr ch))
      (progn
        (setq alist (cons astr alist))
        (setq astr ch)
      )
    )
    (setq a (1+ a))
  )
  (setq alist (cons astr alist))
  (reverse alist)
)

(defun strcalc (str func arg / alist)
  (setq alist (makelist str))
  (setq alist
         (mapcar
           '(lambda (n)
              (cond
                ((<= 48 (ascii (substr n 1 1)) 57)
                 (if (setq pos (vl-string-position (ascii ".") n))
                   (setq dec (- (strlen n) (1+ pos)))
                   (setq dec 0)
                 )
                 (cond
                   ((null arg)
                    (setq n (rtos (apply func (list (read n))) 2 dec))
                   )
                   ((listp arg)
                    (setq n (rtos (apply func (append (list (read n)) arg)) 2 dec))
                   )
                   (T
                    (setq n (rtos (apply func (list (read n) arg)) 2 dec))
                   )
                 )
                )
                (T n)
              )

            )
           alist
         )
  )
  (apply 'strcat alist)
)

;;; Simply lists any attribute tags in ent
(defun listattribs (ent / i enttype entl name)
  (setq i 0
        enttype nil
  )
  (setq entl (entget ent))
  (while (/= enttype "SEQEND")
    (setq ent  (entnext ent)
          entl (entget ent)
    )
    (setq enttype (cdr (assoc 0 entl)))
    (if (setq name (cdr (assoc 2 entl)))
      (princ (strcat "\n" name))
    )
    (setq i (1+ i))
  )
)

;;; Searches the block in ent and calculates the tags
(defun calcattribs (ent tag incr / i i enttype entl enttag val)
  (setq i 0
        j 0
        enttype nil
  )
  (setq entl (entget ent))
  (while (/= enttype "SEQEND")
    (setq ent  (entnext ent)
          entl (entget ent)
    )
    (setq enttype (cdr (assoc 0 entl))
          enttag  (cdr (assoc 2 entl))
    )
    (if (setq val (cdr (assoc 1 entl)))
      (progn
        (setq j (1+ j))
        (cond
          ((= tag "*")
           (setq val (strcalc val '+ incr)
                 i   (1+ i)
           )
           (entmod (subst (cons 1 val) (assoc 1 entl) entl))
          )
          ((= tag enttag)
           (setq val (strcalc val '+ incr)
                 i   (1+ i)
           )
           (entmod (subst (cons 1 val) (assoc 1 entl) entl))
          )
          (T nil)
        )
      )
    )
    (entupd ent)
  )
  (cons i j)
)

;;; Main function
;;; Filters out wanted blocks and attributes and calls
;;; function calcattribs to calculate the tag values
(defun C:ATTCALC (/ a att tag sset count cmd tmp tmpval)
  (setq cmd (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (command "UNDO" "Begin")
  (initget 128 "Pick")
  (setq att (getkword "\nEnter block name or Pick <*>: "))
  (cond ((or (null att) (= att "") (= att "*"))
         (setq sset (ssget "X" (list (cons 0 "INSERT") (cons 2 "*"))))
        )
        ((= att "Pick")
         (setq sset (ssget '((0 . "INSERT"))))
        )
        ((= (type att) 'STR)
         (setq sset (ssget "X" (list (cons 0 "INSERT") (cons 2 att))))
        )
        (T nil)
  )
  (while (null tag)
    (initget 128 "?")
    (setq tag (getkword "\nEnter tag name ?/<*>: "))
    (cond ((or (null tag) (= tag "") (= tag "*"))
           (setq tag "*")
          )
          ((= tag "?")
           (if sset
             (listattribs (ssname sset 0))
             (princ "\nNo attributes found")
           )
           (setq tag nil)
          )
    )
  )
  (if (numberp nval)
    (cond
      ((= (type nval) 'REAL)
       (setq tmpval
              (getreal (strcat "\nEnter increment value <" (rtos nval) ">: "))
       )
       (if tmpval (setq nval tmpval))
      )
      ((= (type nval) 'INT)
       (setq
         tmpval (getreal (strcat "\nEnter increment value <" (itoa nval) ">: "))
       )
       (if tmpval (setq nval tmpval))
      )
    )
    (setq nval (getreal "\nEnter increment value <0>: "))
  )
  (if (null nval)
    (setq nval 0)
  )
  (if (= (- nval (fix nval)) 0)(setq nval (fix nval)))
  (setq a 0
        ccount 0
        scount 0
  )
  (if sset
    (repeat (sslength sset)
      (if (> (cdr (assoc 66 (entget (ssname sset a)))) 0)
        (progn
          (setq tmp (calcattribs (ssname sset a) (strcase tag) nval))
          (setq ccount (+ ccount (car tmp)))
          (setq scount (+ scount (cdr tmp)))
        )
      )
      (setq a (1+ a))
    )
    (princ "\No blocks found")
  )
  (princ (strcat "\nSearched "
                 (itoa scount)
                 " attributes ("
                 (itoa ccount)
                 " changed)"
         )
  )
  (command "UNDO" "End")
  (setvar "CMDECHO" cmd)
  (princ)
)



[CAB]

Doesn't Lee Mac have a routine to do just that?

<edit>
OK Lee's does not deal with existing text but this subroutine will work for you.
http://lee-mac.com/parsenumbers.html

[Lee Mac]

Thanks Alan 

[jaydee]

Thankyou cab. Thats a good link. I will take a closer look. I did visit lees websie a few time. I probaly didnnot know what to look for.  Also a few good similar lisp posted from lee, i just couldn't make much out of it.

[pBe]

Have time to write one:

Code: [Select]

(defun c:IncAtt ( / *IntGet1 AddTonth Mr parse gr g1 g2 nVal att)
(vl-load-com) 
(defun *IntGet1 (fn msg)
   (initget 1)
   (setq val ((eval fn) msg))
   (if (eq val "")
   (progn
     (princ "Null Input Try again")
   (*IntGet1 fn msg)))
  val     
  )
(defun AddTonth (str num val / stl orgstr attEnt)
  (setq str (strcat  "©" str))
  (if (and (setq stl (parse (reverse (vl-string->list str))))
    (setq orgstr  (nth (1- num) stl)))
    (substr
    (vl-string-subst (strcat (substr orgstr 1 1)(itoa
( + (atoi (substr orgstr 2)) val)))
  orgstr str) 2)
        )
  )
(defun parse (lst / a b c pr d)
  (while (setq a (car lst))
    (setq b (cdr lst))
    (if (and
      (>= a 48)
      (<= a 57))
      (setq c (cons a c))
(if c  (setq d (append  (list (cons (car lst) c)) d ) c nil))
  )
    (setq lst b))
  (mapcar 'vl-list->string d)
  )
(setq MR nil)
  (while (null Mr)
  (princ (strcat "\nSelected Tag: "
(if (or (null att)
(/= (cdr (assoc 0 (entget att))) "ATTRIB"))
"None" (cdr (assoc 2 (entget att))))
"\tInteger position: "
(itoa (if (null pst) (setq pst 1) pst))
"\tIncrement Value:  "
(itoa (if (null val) (setq val 1) val))
"\nSelect texts or [Position/Value]<Enter when done:\n"
)
)
(setq gr (grread nil 14 2)
                  g1 (car  gr)
                  g2 (cadr gr)
            )
(cond
                   ((and (= 2 g1)
(member g2 '(118 86 )))
    (setq val (*IntGet1 'Getint "\nEnter Increment Value: ")))
   ((and (= 2 g1)
(member g2 '(112 80 )))
    (setq pst (*IntGet1 'Getint "\nEnter Integer Position: ")))
   ((= 3 g1)
        (if (and (setq att (car (nentselp g2)))
(eq (cdr (assoc 0 (entget att))) "ATTRIB"))
(vla-put-TextString (vlax-ename->vla-object att)
(if (setq nVal (AddTonth (cdr (assoc 1 (entget att))) pst val))
  nVal (cdr (assoc 1 (entget att)))))
  (princ "\nNone Selected and/or No Integer Found\n"))
    )
   ((and (= 2 g1)
(member g2 '(32 13 )))(setq Mr T)
    )
)
)
(princ)
)
Hope this helps

[jaydee]

Thankyou pBe for the lisp, its a great code. I like the bit where user enter position/value without hitting Enter.

What i had in mind was being able select a bunch of existing blocks with the tagname.

Code: [Select]

(setq getent (entsel "\nPick Visible Attribute for Reference. "))
(setq getentity (car getent))
(setq enlist (entget getentity))
(setq tag (cdr (assoc 2 (entget (car (nentselp (car (cdr getent))))))))
(setq enlist (entget (car (nentselp (car (cdr getent))))))

(setq ss (ssget (list '(0 . "INSERT")(assoc 2 (entget (cdr (assoc 330 enlist)))))))

     (repeat
      (setq n (sslength ss))
      (setq ent (ssname ss (setq n (1- n))) att (entnext ent))

       (while
        (= (cdr (assoc 0 (setq enlist (entget att)))) "ATTRIB")
         (if (= (cdr (assoc 2 enlist)) tag))

           (IncAtt)

         )
        (setq att (entnext att))
       )

     )


[jaydee]

Hi pBe
Heres is the version i modified to allow selection set.
I replaced your codes from line
(setq MR nil)
with the following untidy codes. It seems to work.

Code: [Select]

(if (/= (type #val) 'STR)(setq #val "1"))
(if (/= (type #pst) 'STR)(setq #pst "1"))

(if (setq val (Getint (strcat"\nEnter Increment Value:    <"#val">: ")))
    (setq #val (itoa val))
    (setq val (atoi #val))
)

(if (setq pst (Getint (strcat"\nEnter Integer Position:     <"#pst">:")))
    (setq #pst (itoa pst))
    (setq pst (atoi #pst))
)

(setq getent (entsel "\nPick Visible Attribute for Reference. "))
(setq getentity (car getent))
(setq enlist (entget getentity))
(setq tag (cdr (assoc 2 (entget (car (nentselp (car (cdr getent))))))))

(setq enlist (entget (car (nentselp (car (cdr getent))))))
(setq ss (ssget (list '(0 . "INSERT")(assoc 2 (entget (cdr (assoc 330 enlist)))))))

     (repeat
      (setq n (sslength ss))
      (setq ent (ssname ss (setq n (1- n))) att (entnext ent))

       (while
        (= (cdr (assoc 0 (setq enlist (entget att)))) "ATTRIB")
         (if (= (cdr (assoc 2 enlist)) tag)

         (progn

          (vla-put-textstring
           (vlax-ename->vla-object att)
           (if (setq nval (addtonth (cdr (assoc 1 (entget att))) pst val))
            nval
            (cdr (assoc 1 (entget att)))
           )
          )

          )

         )
        (setq att (entnext att))
       )

     )

 (princ)
)


[pBe]

glad it worked for you jaydee

for your consideration:

Code: [Select]

(defun c:IncAtt (/ pbe:AddTonth pbe:parse aDoc getent ent ss attObj)
(vl-load-com)
(defun pbe:AddTonth (str num val / stl orgstr attEnt)
  (setq str (strcat  "©" str))
  (if (and (setq stl (pbe:parse (reverse (vl-string->list str))))
    (setq orgstr  (nth (1- num) stl)))
    (substr
    (vl-string-subst (strcat (substr orgstr 1 1)(itoa
( + (atoi (substr orgstr 2)) val)))
  orgstr str) 2)
        )
  )
(defun pbe:parse (lst / a b c pr d)
  (while (setq a (car lst))
    (setq b (cdr lst))
    (if (and
      (>= a 48)
      (<= a 57))
      (setq c (cons a c))
(if c  (setq d (append  (list (cons (car lst) c)) d ) c nil))
  )
    (setq lst b))
  (mapcar 'vl-list->string d)
  )
(setq aDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(foreach
  nm
    '("pst"
      "val"
     )
  (if (not (eval (read nm)))
    (set (setq ss (read nm)) 1)
  )
)
  (setq pst (cond
      ((getint (strcat "\nEnter Integer Position: <" (itoa pst) ">: ")))
                       (pst))
      val (cond
((getint (strcat "\nEnter Increment Value:  <" (itoa val) ">: ")))
                       (val)))
  (if (and
      (setq getent
     (car (nentsel "\nPick Visible Attribute for Reference. "))
      )
      (eq (cdr (assoc 0 (setq ent (entget getent)))) "ATTRIB")
      (ssget (list '(0 . "INSERT")
   (cons 2
(vla-get-name
   (vla-ObjectIdToObject
     aDoc
     (vla-get-OwnerId
       (vlax-ename->vla-object
getent
       )
     )
   )
)
   )
     )
      )
    )
  (vlax-for sBlk (setq ss (vla-get-activeselectionset aDoc))
    (if (setq
  attObj (assoc
   (cdr (assoc 2 ent))
   (mapcar '(lambda (j) (list (vla-get-tagstring j) j))
   (vlax-invoke sBlk 'GetAttributes)
   )
)
)
      (vla-put-textstring
(cadr attObj)
(if (setq
      nval (pbe:AddTonth (vla-get-textstring (cadr attObj)) pst val)
    )
  nval
  (vla-get-textstring (cadr attObj))
)
      )
      (vla-delete ss)
    )
  )
)
  (princ)
  )

[jaydee]

Thankyou verymuch pBe
Verymuch appriciated.
Another very useful lisp in my toolbox.

Your code is very elegant, compare selectio set part ,my like scripting.

I thing this lisp skould moved to the Show your stuff section.

Another thing it might be usefull is to add real number to RL levels
Ie.  Level 1 - rl 12.123 (ffl - 3.750)

Cheers

[econnerly]

Nice routine and it got me thinking about something that I need that is similar but does not use attributes. Its used for drainage fixture units on waste & vent plans.
Example:
We use basic dtext strings that look like this 4"(6)
I would like to be able to add or subtract to the number that is ONLY in parenthesis and would like to be able to pick multiple text strings at one time. Does anyone have anything that can do something like this? I have a code that I have tried to modify, but have had no success.

[sultanmimar]

can anyone explain me how can ı run and use this lisp.Sorry I am new at autocad lisp.