pmxcad Posted October 5, 2012 Share Posted October 5, 2012 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 Quote Link to comment Share on other sites More sharing options...
pBe Posted October 5, 2012 Share Posted October 5, 2012 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 Quote Link to comment Share on other sites More sharing options...
pmxcad Posted October 5, 2012 Author Share Posted October 5, 2012 Can you help me? Thanks Pmxcad Quote Link to comment Share on other sites More sharing options...
pBe Posted October 6, 2012 Share Posted October 6, 2012 (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 October 6, 2012 by pBe Quote Link to comment Share on other sites More sharing options...
BIGAL Posted October 6, 2012 Share Posted October 6, 2012 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*)) Quote Link to comment Share on other sites More sharing options...
pBe Posted October 6, 2012 Share Posted October 6, 2012 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? Quote Link to comment Share on other sites More sharing options...
pmxcad Posted October 6, 2012 Author Share Posted October 6, 2012 Hello PBE, the numbers could be: 1.25, 1.26, 1.27 or 1-25, 1-26, 1-27 etc etc see example. PmxCAD test.dwg Quote Link to comment Share on other sites More sharing options...
pBe Posted October 6, 2012 Share Posted October 6, 2012 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 Quote Link to comment Share on other sites More sharing options...
pmxcad Posted October 6, 2012 Author Share Posted October 6, 2012 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 Quote Link to comment Share on other sites More sharing options...
pBe Posted October 6, 2012 Share Posted October 6, 2012 (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 October 6, 2012 by pBe Quote Link to comment Share on other sites More sharing options...
Arin9916 Posted October 6, 2012 Share Posted October 6, 2012 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) Quote Link to comment Share on other sites More sharing options...
pmxcad Posted October 6, 2012 Author Share Posted October 6, 2012 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 Quote Link to comment Share on other sites More sharing options...
pmxcad Posted October 6, 2012 Author Share Posted October 6, 2012 Wow Arnin this works great....super. It is exactly what I meant. Many Thanks..... PmxCAD Quote Link to comment Share on other sites More sharing options...
pBe Posted October 7, 2012 Share Posted October 7, 2012 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 Quote Link to comment Share on other sites More sharing options...
pmxcad Posted October 7, 2012 Author Share Posted October 7, 2012 pBe & Arnin both works ok, but........... when it cums from 1.29 to 1.30 it gives 1.3 instead of 1.30. PmxCAD Quote Link to comment Share on other sites More sharing options...
pBe Posted October 7, 2012 Share Posted October 7, 2012 pBe & Arnin both works ok, but........... when it cums from 1.29 to 1.30 it gives 1.3instead of 1.30. PmxCAD Dimzin = 0 Quote Link to comment Share on other sites More sharing options...
Arin9916 Posted October 7, 2012 Share Posted October 7, 2012 ;; ______________________.`' 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) Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.