INCATT addon
Hello,
can someone help me withe following lisp:
Code:;; ;; ;; Made By ...... TaeEun 12/10/07 ;; ;;------------------------------------------------------------------------;; ;; Contact me ... arin9916@naver.com ;; ;; ... http://cafe.naver.com/ptelisp ;; ;;------------------------------------------------------------------------;; ;; Ver 1.0 ...... Design & Created ;; ;; 1.1 ...... Add StringCal Function ;; ;;------------------------------------------------------------------------;; ;; Client ....... CADTUTOR ;; ;;------------------------------------------------------------------------;; (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 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 "TEXT1" num (HUE:StringCal num - i) ) (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)
Is it possible to add a function to put a room number ("room-nr" TAG) to the same selected block?
So when i run the lisp, it asked for a number and the rest of the lisp stay as it is. But no auto count on this part. When i run it again it ask again for a room number but it starts with the previous one. The room numbers can also be text.
thank you in advance,
Jaap
Reply With Quote
Originally Posted by pmxcad
