incatt公司
大家好，我有一个Lisp程序的作品完美。但我想给它添加一个函数。
现在的Lisp程序通过选择块来计算/增加属性。
添加我想要的功能是房间号。这将同时将数字放入块/属性中。这不算，但保持不变。
因此，如果我运行lisp，他会要求输入房间号（“房间编号”标记）和一个带递增的数字（“TEXT1”标记）。
我对lisp了解不多。我确实知道：（setq room=nr（getString T“room number”））来获得房间号，我想通过（setq o（ssget“_+：E:S:L”'（（0。“INSERT”）（66.1）））部分获得块选择。
我在Lee Mac的网站上查看了属性LISP，但我不知道应该在哪里以及如何放置它们。
;; ;;
;;Made By ...... TaeEun12/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-remove45 (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 (- (cardata1) (cardata2))))
(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 pres)))
( (> 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 '*StartStr121007getstring "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)
提前感谢您，
Jaap M公司
页:
[1]