Jump to content

change incatt.lsp to work with numbers with point, comma etc etc

pmxcad

By pmxcad
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

pmxcad Rising Star

pmxcad

Posted
Posted

Hello,

i have a lisp routine incatt.lsp dat increase a attribute. It does only numbers like:

1, 2, 3 etc etc.

Is it possible to change the lisp that it changes/increment(attributes) numbers like: 4.32, 4.33, 4.34 etc So with numbers with a . or , or - and with steps .01?

 

Thanks

incatt.lsp

Link to comment
Share on other sites
pBe Grand Master

pBe

Posted
Posted
Hello,

i have a lisp routine incatt.lsp dat increase a attribute. It does only numbers like:

1, 2, 3 etc etc.

Is it possible to change the lisp that it changes/increment(attributes) numbers like: 4.32, 4.33, 4.34 etc So with numbers with a . or , or - and with steps .01?

 

Thanks

 

Yes, it is possible :)

Link to comment
Share on other sites
pBe Grand Master

pBe

Posted
Posted (edited)
Can you help me?

 

But of course i'll help. listen pmxcad, the way the code is written, the existing value of the attribute doesn't come into play at any way. so whats the deal with "," and "-" ? Will those be the supplied value at prompt? or the resulting incremented value for the attribute entity. if the former, we cant use getreal nor getint for it would not accept those symbols.

 

if the latter, i suppose we can reverse the sequence by asking to select an attribute first then use the pattern of the existing string to determine the proper prompt (getint/getreal)

 

Bottom line: How would you prompt for value? or is it numbers after "," and "-" symbols?

 

Show us an example dude.

Edited by pBe
Link to comment
Share on other sites
BIGAL Grand Master

BIGAL

Posted
Posted

Just change a couple of lines in code and add increment step this can be just press enter for 1

 

 (getreal (Strcat  "\nSpecify Starting Number
and
(setq inc (getreal "\nSpecify increment "))

(setq *num* (+ inc *num*))

Link to comment
Share on other sites
pBe Grand Master

pBe

Posted
Posted
Just change a couple of lines in code and add increment step this can be just press enter for 1

 

What i'm after is this Bigal ---- > "," or "-" , when and where does these symbols fit in?

Link to comment
Share on other sites
pBe Grand Master

pBe

Posted
Posted

Quick mod [untested]

 

(defun c:incatt ( / tag pre ss1 ) (vl-load-com)
[color="blue"](defun determine (str)
 (list 
 (setq pre (vl-string-right-trim "0123456789" str))
 	 (atoi (substr str (1+(strlen pre))))))[/color]
 	
 (setq tag "E_TEXT1")

 (if (setq *num* (cond ( (getint (strcat "\nSpecify Starting Number"  (if *num* (strcat " <" (itoa *num*) "> : ") ": ")))) ( *num* )))
   (while (setq ss1 (ssget "_+.:E:S:L" '((0 . "INSERT") (66 . 1))))
     (if
       (vl-some
         (function
           (lambda ( x )
             (if (eq tag (vla-get-tagstring x))
               (not (vla-put-textstring x [color="blue"](strcat
                          (car (setq p (determine (vla-get-textstring x))))
                               (strcat (if (and (< 0 (cadr p) 9)
                                                (not (eq (car p) "")))
                                             "0" "") (itoa (+ (cadr p) *num*))))))[/color]
             )
           )
         )
         (vlax-invoke (vlax-ename->vla-object (ssname ss1 0)) 'getattributes)
       )
       (princ (strcat tag " Attribute not found."))
     )
   )
 )
 (princ)
)

 

HTH

Link to comment
Share on other sites
pmxcad Rising Star

pmxcad

Posted
  • Author
Posted

Thanks for the replay, but sorry PBE, its not working correct.

 

When i give a starting number like 1.25, Autocad returns "Requires an integer value".

And when give a number like "1" it gives all the blocks selected, the number "1" and it doesnt count.

 

PmxCAD

Link to comment
Share on other sites
pBe Grand Master

pBe

Posted
Posted (edited)

That is what i wanted to know from the get-go. Tell me. is the existing string on the attribute relevant to the input value?

 

The modified code increments the "existing value". thats the way i saw it from you attached example.

 

Are you telling me that there are times that you would input "1-25" or "1,25"?

 

And when give a number like "1" it gives all the blocks selected, the number "1" and it doesnt count.

 

Are you sure about this? it should work on your "test.dwg"

 

It's getting pretty late here pmxcad. we'll "increment" tomorrow :)

Edited by pBe
Link to comment
Share on other sites
Arin9916 Contributor

Arin9916

Posted
Posted

Increase the number of characters in the last.

;; ______________________.`' Customized Programs  '`._____________________;;
;;                                                                        ;;
;;  Made By ...... TaeEun  12/10/07                                       ;;
;;------------------------------------------------------------------------;;
;;  Contact me ... [email="arin9916@naver.com"]arin9916@naver.com[/email]                                     ;;
;;             ... [url]http://cafe.naver.com/ptelisp[/url]                          ;;
;;------------------------------------------------------------------------;;
;;  Client ....... CADTUTOR                                               ;;
;;------------------------------------------------------------------------;;
(defun c:aa 
   ( / f str i f tag num pre post OOv
       
;        *StartStr121007
;        *IncreaseN121007
       
       HUE:DivideNum
       HUE:memoVar
       HUE:stringsubst
       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: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 (atof s)))
           )
           (setq j (+ 1 j))
       )
       (list pre i post)
   )
   
   ;-------------------------------------------------------------------------
   ; Error Function
   ;-------------------------------------------------------------------------
   (defun *error* (s)
       (if OOv (HUE:End OOv)) (princ s)
   )
   ;-----------------------------------------------------------------------------------
   ; Main Function                                                                     
   ;-----------------------------------------------------------------------------------
   
   (setq str  (HUE:MemoVar '*StartStr121007  getstring "StartString  " "A1")
         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  "E_TEXT1"
         num  (- num i)
   )
   
   (setvar 'ERRNO 0)
   (setvar 'DIMZIN 
   
   (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 (+ num i)
                                 str (strcat pre (rtos num 2  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)

Link to comment
Share on other sites
pmxcad Rising Star

pmxcad

Posted
  • Author
Posted

Ok PBE, thanks so far.

 

your first question: is the existing string on the attribute relevant to the input value? No.

your second question: Are you telling me that there are times that you would input "1-25" or "1,25"? Yes I like to start with give a number like 1.25 and select the first block it gets the value 1.25 and the second one gets the value of 1.26 etc.

Al the block attributes are empty.

 

PmxCAD

Link to comment
Share on other sites
pBe Grand Master

pBe

Posted
Posted

sheepish_.gif

 

FWIW:

 

(defun c:incatt ( / del rtoa p x tag pre ss1 i ) (vl-load-com)
[color="blue"](defun del (str)
 (if (numberp (read str))
 		str (vl-string-translate "-," ".." str)))[/color]
 (setq tag "E_TEXT1" pre "")
 [color="blue"](setq rtoa  (lambda (k)
               (if (zerop (- k (fix k))) (itoa (fix k))
                 (rtos k 2 2)
                 )))[/color]
               
 [color="blue"](while (not (progn
(if (null pr)(setq pr "1")) 
(setq *num* (getstring (strcat "\nEnter Start number <" pr ">: ")))
(if (/= *num* "")(setq pr *num*)(setq *num* pr))
           (if (and (setq p (del *num*)) (numberp (read p)))
              T (prompt "\nInvalid Value"))))) 
              
 (setq inc (cond ((getreal
         (strcat "\nEnter Increment Value: "
           (if inc (strcat " <" (rtoa inc) "> ")
                      ": "))))(inc)))
(setq x (vl-some '(lambda (j)
                      (if (vl-string-position (ascii j) *num*) j))
		'("," "-")))[/color]
(while (setq ss1 (ssget "_+.:E:S:L" '((0 . "INSERT") (66 . 1))))
     (if
       (vl-some
         (function
           (lambda ( x )
             (if (eq tag (vla-get-tagstring x))
               (not (vla-put-textstring x (strcat pre *num*)))
             )
           )
         )
         (vlax-invoke (vlax-ename->vla-object (ssname ss1 0)) 'getattributes)
       )
[color="blue"](setq v (+ (read p) inc)
	p (rtoa v)
	*num* (vl-string-translate  "."  (if x x "") p) pr *num*)[/color]
       (princ (strcat tag " Attribute not found."))
     )
   )
 (princ)
 )

 

HTH

Link to comment
Share on other sites
Arin9916 Contributor

Arin9916

Posted
Posted 
;; ______________________.`' Customized Programs  '`._____________________;;
;;                                                                        ;;
;;  Made By ...... TaeEun  12/10/07                                       ;;
;;------------------------------------------------------------------------;;
;;  Contact me ... [email="arin9916@naver.com"]arin9916@naver.com[/email]                                     ;;
;;             ... [url]http://cafe.naver.com/ptelisp[/url]                          ;;
;;------------------------------------------------------------------------;;
;;  Ver 1.0 ...... Design & Created                                       ;;
;;      1.1 ...... Add StringCal Function                                 ;;
;;------------------------------------------------------------------------;;
;;  Client ....... CADTUTOR                                               ;;
;;------------------------------------------------------------------------;;
(defun c:aa 
   ( / 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 str  (HUE:MemoVar '*StartStr121007  getstring "StartString  " "A1")
         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  "E_TEXT1"
         num  (HUE:StringCal num - i)
   )
   
   (setvar 'ERRNO 0)
   (setvar 'DIMZIN 
   
   (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)

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.

×
 Share
Go to topic listing
×
×
  • Create New...