INCATT

[pmxcad]

Hi everybody,
I have a lisp that works perfectly. But I want to add a function to it.
The lisp as he is now counts/increase an attribute by selecting a block.
Add the feature I want is a room number. That will simultaneously put the number in the block / attribute. This does not count but remains constant.
So if I run the lisp, he asks to enter the room number ("room-nr" TAG) and a number with the increase ("TEXT1" TAG).
I do not know much about lisp. I do know this: (setq room=nr (getString T "room number")) to get the room number and i think to get the block selection by the (setq o (ssget "_+.:E:S:L" '((0 . "INSERT") (66 . 1)))) part .
I peeked into the Attributes lisps at the site of Lee Mac, but I would not know where and how I should place them.

(defun c:INCATT 
    ( / f str i f tag num pre post OOv
        
;        *StartStr121007
;        *IncreaseN121007
        
        HUE:DivideNum
        HUE:memoVar
        HUE:stringsubst
        HUE:StringCal
        HUE:start
        HUE:end
        
        _divideStr
        
    )
    ;-------------------------------------------------------------------------
    ; Sub Function
    ;-------------------------------------------------------------------------
    (defun HUE:DivideNum ( str / lst s m v1 v2 i j c _NumP _Cal)
        (defun _NumP ( x ) (<= 48 x 57))
        (defun _Cal ( ty v )
            (set v (cons (vl-list->string (reverse (eval ty))) (eval v))) 
            (set ty nil)
        )
        
        (setq lst (vl-string->list str) i -1 j -1)
        
        (repeat (length lst)
            (setq c (nth (setq i (+ i 1)) lst))
            
            (cond
                (    (_NumP c) 
                    (setq s (cons c s) ) (cond ( m (_Cal 'm 'v1) (setq j (+ 1 j)))))
                
                (    (and (= c 46) (> i 0) (_NumP (nth (- i 1) lst)) (_NumP (nth (+ i 1) lst)))
                    (setq s (cons c s))
                )
                (t  (setq m (cons c m))
                    (cond ( s (_Cal 's 'v1) (setq v2 (cons (setq j (+ 1 j)) v2))))
                )
            )
        )
        (cond
            ( m (_Cal 'm 'v1))
            ( t (_Cal 's 'v1) (setq v2 (cons (setq j (+ 1 j)) v2)))
        ) (list (reverse v1) (reverse v2))
    )
    
    ;-------------------------------------------------------------------------
    ; Sub Function
    ;-------------------------------------------------------------------------
    (defun HUE:memoVar ( va f m s / v )
        (setq v (if (member (eval va) '(nil "")) s  (eval va)))
        (mapcar 'princ (list "\n" m " <" v "> : "))
        (set va ( f ))
        (if (member(eval va) '(nil "")) (set va v)) (eval va) 
    )
    
    ;-------------------------------------------------------------------------
    ; Sub Function
    ;-------------------------------------------------------------------------
    (defun HUE:stringsubst ( new old str / l i ) (setq l (strlen new) i 0)
        (while (setq i (vl-string-search old str i))
            (setq str (vl-string-subst new old str i) i (+ i l))
        ) str
    )
    
    ;-------------------------------------------------------------------------
    ; Sub Function
    ;-------------------------------------------------------------------------
    (defun HUE:StringCal ( str f n / _GetPP data1 data2 num i DIMZIN )
        (defun _GetPP ( str / lst l post pre flag )
            (setq lst  (vl-remove  45 (vl-string->list str))
                  post (if (setq l (member 46 lst)) (- (length l) 1) 0)
                  pre  (if (setq l (member 46 (reverse lst))) (- (length l) 1) (length lst))
                  flag (minusp (atof str))
            ) (list pre post flag)
        )
        
        (setq DIMZIN (getvar 'DIMZIN))
        
        (setvar 'DIMZIN 0)
        (setq data1 (_GetPP str)
              num   (vl-string->list (rtos (f (atof str) n) 2 (cadr data1)))
              data2 (_GetPP (vl-list->string num))
              num   (vl-remove 45 num)
        )
        (setvar 'DIMZIN DIMZIN)
        (if (< 0 (setq i (- (car  data1) (car  data2)))) 
            (repeat i (setq num (cons 48 num)))
        )
        (if (< 0 (setq i (- (cadr data1) (cadr data2)))) 
            (repeat i (setq num (append num '(48))))
        )
        (if (caddr data2) (setq num (cons 45 num)))
        (vl-list->string num)
    )
    
    ;-------------------------------------------------------------------------
    ; Sub Function
    ;-------------------------------------------------------------------------
    (defun HUE:start( lst ) 
        (vla-startundomark (HUE:end nil))
        (list lst (mapcar 'getvar lst))
    )
    
    ;-------------------------------------------------------------------------
    ; Sub Function
    ;-------------------------------------------------------------------------
    (defun HUE:end ( d / doc )
        (setq doc (vla-get-activedocument (vlax-get-acad-object)))
        (and (cadr d) (mapcar 'setvar (car d) (cadr d)))
        (if (= 8 (logand 8 (getvar 'UNDOCTL))) (vla-endundomark doc)) doc
    )
    
    ;-------------------------------------------------------------------------
    ; Sub Function
    ;-------------------------------------------------------------------------
    (defun _divideStr ( str / data i j k pre post )
        (setq data (HUE:DivideNum str)
              k    (last (cadr data))
              j    0
              pre  ""
              post ""
        )
        
        (foreach s (car data)
            (cond
                (    (< j k) (setq pre (strcat pre  s)))
                (    (> j k) (setq post(strcat post s)))
                (    (= j k) (setq i s))
            )
            (setq j (+ 1 j))
        )
        (list pre i post)
    )
    
    ;-------------------------------------------------------------------------
    ; Error Function
    ;-------------------------------------------------------------------------
    (defun *error* (s)
        (if OOv (HUE:End OOv)) (princ s)
    )
    ;-----------------------------------------------------------------------------------
    ; Main Function                                                                     
    ;-----------------------------------------------------------------------------------
;=============================================================   
 (SETQ RMTE (GETSTRING T"\n Room nr:"))
;=============================================================   
 (setq str  (HUE:MemoVar '*StartStr121007  getstring "StartString  " "100")
          i    (HUE:MemoVar '*IncreaseN121007 getreal   "Increase Num " 1.)
          OOv  (HUE:Start '(DIMZIN))
    )
    
    (and 
        (vl-string-search "," str)
        (setq str (HUE:StringSubst "." "," str)  f t)
    )
    
    (mapcar 'set '(pre num post) (_DivideStr str))
    (setq tag  "TEXT1"
          num  (HUE:StringCal num - i)
    )
;=============================================================  
(setq tag2 "Room-nr")
;=============================================================   
(setvar 'ERRNO 0)
    (setvar 'DIMZIN 8)
    (while (= 0 (getvar 'ERRNO))
        (and
            (setq o (ssget "_+.:E:S:L" '((0 . "INSERT") (66 . 1))))
            (vl-some
                '(lambda ( att )
                    (if (= tag (vla-get-tagstring att))
	                              (progn
                            (setq num (HUE:StringCal num + i)
                                  str (strcat pre num post)
                            )
		 (if f (setq str (HUE:StringSubst "," "." str)))
                            (vla-put-textstring att str)
	                        )
                    )
                ) (vlax-invoke (vlax-ename->vla-object (ssname o 0)) 'getattributes)
            )
        )
    )
    (HUE:End OOv)
    (princ)
)(vl-load-com)

thank you in advance

Jaap M.

[hencoop]

Here is a slightly modified version of my attribute increment app.  Just select each attribute you want to update in numerical succession.

It requires the subroutine UINT.LSP (included below).

In order to format the test as you want edit this line:

(VLAX-PUT-PROPERTY anobj 'TextString (STRCAT (ITOA room-nr) "-" (ITOA incr-cnt)))

 The "-" separates the room number from the incrementing number.  Change the order of the parts and/or replace "-"  within the (STRCAT...) function.

(defun c:incratt ( / )
  (vl-load-com)
  (IF uint NIL (LOAD "uint" "\nFile UINT.LSP not loaded! "))
  (SETQ incr-cnt (uint 1 "" "Starting number" (IF incr-cnt incr-cnt 1)))
  (SETQ room-nr (uint 1 "" "Room number" (IF room-nr room-nr 1)))
  (IF incr-cnt NIL
    (SETQ incr-cnt 1)
  )
  (WHILE
  (setq it(nentselp))
  (setq ename (car it))
  (setq anobj (vlax-ename->vla-object ename))
  (IF (VLAX-PROPERTY-AVAILABLE-P anobj 'TextString T)
    (PROGN
      (VLAX-PUT-PROPERTY anobj 'TextString (STRCAT (ITOA room-nr) "-" (ITOA incr-cnt)))
      (SETQ incr-cnt (1+ incr-cnt))
    )
  )
  )
)

(defun uint (bit kwd msg def / inp)
  (if def 
    (setq msg (strcat "\n" msg " <" (if (eq (type def) 'REAL) (rtos def 2 0)(if (eq (type def) 'INT) (itoa def) def)) ">: ")
          bit (* 2 (fix (/ bit 2)))
    )
    (setq msg (strcat "\n" msg ": "))
  );if
  (initget bit kwd)
  (setq inp (getint msg))
  (if inp inp def)
);defun

[pmxcad]

Hello Henkoop. Thanks for your quick replay.

you lisp does not work as I had hoped. I may not have explained well. If you use my lisp, you will see that he is different. I do not need to click on  the attribute but only the block. The fact is that usually the drawings are new and therefore no attributes yet been filled in. i use this TAG for part adress .The counter is placed in the attribute TEXT1 and the room number in the attribute ROOM NO. When you lisp they are put back together but that is not the intention. You will see if you use my lisp that I can use letters. The room numbers may also contain letters. My lisp I have not homemade but picked up again from the Internet. I myself do not know **** about. What I myself admitted add to my lisp between ========= but does not work of course.
I hope you can do with this info and you know miaybe a solution. Would be great.
Thanks in advance,

Jaap M.

[hencoop]

Perhaps this will come closer to your needs:

It is possible to loop the selection of the block and include only prompts for only the values that change for each block insertion

Notice that the ATTRIBUTE TAG NAMES in your block should replace those I've used below.

(defun c:incratt ( / it ename anobj att new TagLst)
  (vl-load-com)
  (IF ustr NIL (LOAD "ustr" "\nFile USTR.LSP not loaded! "))
  (SETQ #address (ustr 1 "Address" (IF #address #address "ADDRESS") T))
  (SETQ incr-cnt (ustr 1 "Starting number" (IF incr-cnt incr-cnt "1") T))
  (SETQ room-nr (ustr 1 "Room number" (IF room-nr room-nr "1") T))
  (SETQ TagLst (LIST
                 ;     ATTRIBUTE TAG    NEW VALUE 
                 (LIST "TAG"		#address)
                 (LIST "TEXT1"		incr-cnt)
                 (LIST "ROOM_NO."	room-nr)
               )
  )
    (setq it(nentselp))
    (setq ename (car (last it)))
    (setq anobj (vlax-ename->vla-object ename))
        (cond
          ((= "AcDbBlockReference" (vla-get-objectname anobj))
            (if (= :vlax-true (vla-get-hasattributes anobj))
              (foreach att (vlax-invoke anobj 'getattributes)
                (if (setq new (assoc (vla-get-tagstring att) tagLst))
                  (progn
                    (vla-put-textstring att (cadr new))
                  )
                )
              )
            )

          )
          ((= "AcDbAttributeDefinition" (vla-get-objectname anobj))
            (if (setq new (assoc (vla-get-tagstring anobj) tagLst))
              (progn
                (vla-put-textstring anobj (cadr new))
              )
            )
          )
        )
)
(DEFUN ustr (bit msg def spflag / inp nval)
  (IF (AND def (/= def ""))
    (SETQ msg (STRCAT "\n" msg " <" def ">: ")
	  inp (GETSTRING msg spflag)
	  inp (IF (= inp "")
		def
		inp
	      ) ;_ end of if
    ) ;_ end of setq
    (PROGN
      (SETQ msg (STRCAT "\n" msg ": "))
      (IF (= bit 1)
	(WHILE (= "" (SETQ inp (GETSTRING msg spflag))))
	(SETQ inp (GETSTRING msg spflag))
      ) ;_ end of if
    ) ;_ end of progn
  ) ;_ end of if
    inp
) ;_ end of defun

[pmxcad]

I get an error after fill in a number (adress)

Address <200>: 1
; error: bad argument type: stringp 111

Jaap

[hencoop]

Sorry, that is because the variables are already set as integers in your session and now they need to be strings

Enter this at the command line first and then it should run:

.

(SETQ incr-cnt NIL room-nr NIL)

[pmxcad]

Hencoop it works.......it place de data in the goot tags. But..............it stops after 1 click and 1 have run the lisp again. Can it be made in a loop en stop it with esc or so?

Can i modify the lisp that it also works letters? like the adress A-100, c100 and the room number like room A10.

Almost perfect.

Jaap

[hencoop]

Yes that can be done.

Will the letters always be before the number or do you need them to be allowed at any place in the string?

Also, do you need to increment the numbers in TEXT1 or ROOM NO.?

[pmxcad]

At any place in the string?

Increment only in TEXT1

[pmxcad]

At any place in the string

Increment only in TEXT1

[hencoop]

EDIT: Commented out my (ALERT ...)s
This will do it for me.  BE CAREFUL to select only blocks.

This is a bit more than I can typically do here.  I hope that it helps you.

(defun c:incratt ( / it ename anobj att new TagLst)
  (vl-load-com)
  (IF ustr NIL (LOAD "ustr" "\nFile USTR.LSP not loaded! "))
  (IF uint NIL (LOAD "uint" "\nFile UINT.LSP not loaded! "))
  (SETQ #address (ustr 1 "Address" (IF #address #address "ADDRESS") T))
  (SETQ incr-cnt (uint 1 "" "Starting number" (if (and incr-cnt (eq (type incr-cnt) 'INT)) incr-cnt 1)))
  (SETQ room-nr (ustr 1 "Room number" (IF room-nr room-nr "1") T))
  (SETQ TagLst (LIST
                 ;     ATTRIBUTE TAG    NEW VALUE 
                 (LIST "TAG"		#address)
                 (LIST "TEXT1"		incr-cnt)
                 (LIST "ROOM_NO."	room-nr)
                 ;The tags below are my attribute tags for testing. You may list as many tag - value pairs as you
                 ;want but you must set the values of the variables by some means, e.g. as done above beginning with #address.
                 ;Also, only tags in the list that exist in your INSERT instances will be affected so if you want any tags to remain unchanged, remove them from this list.
                 (LIST "SEC_DET_REF"    #address)
                 (LIST "SHT_CALL_ON"    room-nr)
                 (LIST "SHT_DRAW_ON"    incr-cnt)
               )
  )
  (WHILE
    (and(setq it(nentselp))(>(length it)2))
    (setq ename (last (last it)))
    (setq anobj (vlax-ename->vla-object ename))
    (cond
      ((= "AcDbBlockReference" (vla-get-objectname anobj))
        (if (= :vlax-true (vla-get-hasattributes anobj))
          (foreach att (vlax-invoke anobj 'getattributes)
            (if (setq this-taglst (assoc (setq this-tagstr (vla-get-tagstring att)) tagLst))
              (progn
                (setq this-txtstr (vla-get-textstring att))
                (setq new-str NIL)
                (if (wcmatch this-tagstr "TEXT1,SHT_DRAW_ON")
                  (progn
                    (set-txtstr this-txtstr att)
                    (if new-str
                      (vla-put-textstring att new-str)
                    )
                  )
                  (vla-put-textstring att (cadr this-taglst))
                )
              )
            )
          )
        )
      )
      ((= "AcDbAttributeDefinition" (vla-get-objectname anobj))
        (if (setq this-taglst (assoc (setq this-tagstr (vla-get-tagstring anobj)) tagLst))
          (progn
              (setq this-txtstr (vla-get-textstring anobj))
              (setq new-str NIL)
              (if (wcmatch this-tagstr "TEXT1,SHT_DRAW_ON")
                (progn
                  (set-txtstr this-txtstr anobj)
                  (if new-str
                    (vla-put-textstring anobj new-str)
                  )
                )
                (vla-put-textstring anobj (cadr this-taglst))
              )
          )
        )
      )
      ((= "AcDbAttribute" (vla-get-objectname anobj))
        (if (setq this-taglst (assoc (setq this-tagstr (vla-get-tagstring anobj)) TagLst))
          (progn
              (setq this-txtstr (vla-get-textstring anobj))
              (setq new-str NIL)
              (if (wcmatch this-tagstr "TEXT1,SHT_DRAW_ON")
                (progn
                  (set-txtstr this-txtstr anobj)
                  (if new-str
                    (vla-put-textstring anobj new-str)
                  )
                )
                (vla-put-textstring anobj (cadr this-taglst))
              )
          )
        )
      )
    )
    (if new-str
      (progn
        (princ "\n")
        (princ new-str)
        (princ)
      )
    )
    (setq incr-cnt (1+ incr-cnt))
  )
)
(defun set-txtstr (txtstr obj /)
                (cond
                  ((wcmatch txtstr "@*#*@")
;;;                   (alert "1")
                   (setq str-cnt 1)
                   (while (not (wcmatch (substr txtstr str-cnt 1) "#"))
                     (setq str-cnt (1+ str-cnt))
                   )
                   (setq str-start-cnt str-cnt)
                   (while (not (wcmatch (substr txtstr str-cnt 1) "[@ ]"))
                     (setq str-cnt (1+ str-cnt))
                   )
                   (setq str-end-cnt str-cnt)
                   (setq number-str (substr txtstr str-start-cnt (- str-end-cnt str-start-cnt))
;;;                         number-int (1+ (ATOI number-str)); Use this line instead of the next to increment the existing value by 1
                         number-int incr-cnt
                         number-prefix (substr txtstr 1 (1- str-start-cnt))
                         number-suffix (substr txtstr str-end-cnt)
                   ))
                  ((wcmatch txtstr "@*#")
;;;                   (alert "2")
                   (setq str-cnt 1)
                   (while (not (wcmatch (substr txtstr str-cnt 1) "#"))
                     (setq str-cnt (1+ str-cnt))
                   )
                   (setq str-start-cnt str-cnt)
                   (setq number-str (substr txtstr str-start-cnt)
;;;                         number-int (1+ (ATOI number-str)); Use this line instead of the next to increment the existing value by 1
                         number-int incr-cnt
                         number-prefix (substr txtstr 1 (1- str-start-cnt))
                         number-suffix ""
                   ))
                  ((wcmatch txtstr "#*@")
;;;                   (alert "3")
                   (setq str-cnt 1)
                   (while (not (wcmatch (substr txtstr str-cnt 1) "[@ ]"))
                     (setq str-cnt (1+ str-cnt))
                   )
                   (setq number-str (substr txtstr 1 (1- str-cnt))
;;;                         number-int (1+ (ATOI number-str)); Use this line instead of the next to increment the existing number value by 1
                         number-int incr-cnt
                         number-prefix ""
                         number-suffix (substr txtstr str-cnt)
                   ))
                  ((wcmatch txtstr "#,##,###,####,#####,######,#######")
;;;                   (alert "4")
                   (setq number-str txtstr
;;;                         number-int (1+ (ATOI number-str)); Use this line instead of the next to increment the existing number value by 1
                         number-int incr-cnt
                         number-prefix ""
                         number-suffix ""
                   ))
                  (txtstr
;;;                   (alert "5")
                   (setq number-str ""
;;;                         number-int (1+ (ATOI number-str)); Use this line instead of the next to increment the existing number value by 1
                         number-int incr-cnt
                         number-prefix txtstr
                         number-suffix ""
                   ))
                )
                (if (and number-prefix number-int number-suffix)
                  (setq new-str (STRCAT number-prefix (ITOA number-int) number-suffix))
                  (setq new-str NIL)
                )
)
(DEFUN ustr (bit msg def spflag / inp nval)
  (IF (AND def (/= def ""))
    (SETQ msg (STRCAT "\n" msg " <" def ">: ")
	  inp (GETSTRING msg spflag)
	  inp (IF (= inp "")
		def
		inp
	      ) ;_ end of if
    ) ;_ end of setq
    (PROGN
      (SETQ msg (STRCAT "\n" msg ": "))
      (IF (= bit 1)
	(WHILE (= "" (SETQ inp (GETSTRING msg spflag))))
	(SETQ inp (GETSTRING msg spflag))
      ) ;_ end of if
    ) ;_ end of progn
  ) ;_ end of if
    inp
) ;_ end of defun
(defun uint (bit kwd msg def / inp)
  (if def 
    (setq msg (strcat "\n" msg " <" (if (eq (type def) 'REAL) (rtos def 2 0)(if (eq (type def) 'INT) (itoa def) def)) ">: ")
          bit (* 2 (fix (/ bit 2)))
    )
    (setq msg (strcat "\n" msg ": "))
  );if
  (initget bit kwd)
  (setq inp (getint msg))
  (if inp inp def)
) ;_ end of defun 

[pmxcad · Accepted solution]

Hello Hancoop,

A small thing, it can be made that the address code also can contain letters and numbers that begin with for example 100, 101, 102 etc or C100, C101.

Thanks

Jaap M.

[pmxcad]

Hacoop,
you deserve a statue.
thanks again.

[hencoop]

You are welcome.

Did you get that Address to accept letters and numbers?  I failed to follow up on that.

[Anonymous]

Hello,

I used this lisp (first one/top) fore a couple of weeks. Works almost perfect.

it is possible to set the number of steps lock to zero
so this question can be skipped? I think it has to be changed about here: 

 (setq str  (HUE:MemoVar '*StartStr121007  getstring "StartString  " "100")
          i    (HUE:MemoVar '*IncreaseN121007 getreal   "Increase Num " 1.)

And is there a simple way to add a attribute "Doornumber"?
So i can use (setq dnr (getstring "Roomnumber:.....")
This attribute dont needs increment.

So i click on blocks (TAG1) gets increment number and Doornumber gets te dnr value.

thank you in advance,

CAD5226

e (default 1)