Jump to content

incatt modifiaction


Panomax

Recommended Posts

Hello,

Can someone help met with the following lisp?

iam using a lisp (incatt) to increase a attribute of selected block. this works perfect.

I want to add a function. in the blocks there is also an attribute with the tag "room-nr".

iam using the lisp for coding safety symbols/blocks. I like to add the function room-nr to the lisp. So when i run the lisp, it asked for the room number and the rest stays the same. It increase the number ("TEXT1" tag) and adds the room number to the block. By the next run it prompts again with the room number and starts with the previous number. But NO auto count on thr room number part.

 

;; ______________________.`' Customized Programs  '`._____________________;;
;;                                                                        ;;
;;  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)

 

thank you in advance,

 

Jaap

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.

×
×
  • Create New...