[编程交流] incatt公司

;;                                                                        ;;
;;  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 
 
   (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)