数字递增，求改进
;;; 拷贝数字 数字自动增加程序;;;原代码参 wowan1314
;;;1.1 修改 by netbee 2013.04.05
;;;1.2 修改 by netbee 2013.04.05
;;;可以包含其他对象，如圆中数字。
;;;1.3 修改 by netbee 2013.04.06
;;;修复DIMZIN变量影响。
;;;可再次优化为中间数字递增，字母递增等
;;
(defun c:zf (/ fun_setinifun_closefun_errorFUN_GETdigit old_error old_DIMZIN ureal last_ent
Plus1 String_To_Numbers buchang1 $buchang SS SS1 e0 ent
PT i loop ENTL E-1 NEWTX ENT_TMP
)
(defun fun_setini ()
(setq old_error *error*
old_DIMZIN(getvar "DIMZIN")
*error* fun_error
)
(or NBTV_TXT_CopyADD (setq NBTV_TXT_CopyADD 1.0))
(setvar "cmdecho" 0)
(setvar "DIMZIN" 0)
(vl-cmdf "_.undo" "be")
)
(defun fun_error (msg) (princ msg) (fun_close))
(defun fun_close () (vl-cmdf "_.undo" "e") (setvar "DIMZIN" old_DIMZIN)(setvar "cmdecho" 1) (setq *error* old_error))
(defun ureal (bit kwd msg def / inp)
(ifdef
(setq msg(strcat "\n" msg "<" (rtos def 2) ">: ")
bit(* 2 (fix (/ bit 2)))
)
(setq msg (strcat "\n" msg ": "))
)
(initget bit kwd)
(setq inp (getreal msg))
(ifinp
inp
def
)
)
(defun String_To_Numbers (inStr
;;Input string
/ Flush_BufRes
;;Result list
Buf
;;String buffer
Inx
;;Character location
CH
;;Character
) (defun Flush_Buf ()
(if (not (wcmatch Buf "[+-.]"));is it not just +-. ;[...] 匹配括号中的任意一个字符
(progn ;Clean it up first
(if (= (substr Buf 1 1) ".")
(setq Buf (strcat "0" Buf))
)
;;add zero to front if .# ;# (磅值符号)匹配任意单个数值字符,. (句号)
匹配任意单个非字母数值字符
(if (= (substr Buf (strlen Buf)) ".")
(setq Buf (substr Buf 1 (1- (strlen Buf))))
)
;;remove decimal if #.
;Add to RES list
(setq RES (cons Buf RES))
)
)
(setq Buf "")
;;reset Buf
)
(setq Inx 1 ;start at the beginning of the string
Buf "" ;init buffer to empty
) ;
; Loop until the end of the string.
; (I indicates where we are in the string)
;
(while (<= Inx (strlen inStr));
; Get the character at position Inx, increment position indicator
(setq CH(substr inStr Inx 1)
Inx(1+ Inx)
) ;
(cond ; Test to see if character is a digit.
((wcmatch CH "")
(if (= CH ".") ;is it decimal
(if (not (wcmatch Buf "*`.*")) ;not already in there
(setq Buf (strcat Buf CH))
(Flush_Buf)
) ;
(setq Buf (strcat Buf CH))
)
)
((= Buf "") ;is the buffer empty
;Is CH minus
(if (= CH "-")
(setq Buf CH) ;Yes, save in Buf
)
)
('T ;else buffer is not empty
(Flush_Buf)
(if (= CH "-")
(setq Buf CH)
)
)
) ; End of COND
) ; End of WHILE
;
(if(and (/= Buf "") (not (wcmatch Buf "[+-.]")))
(Flush_Buf)
)
(reverse Res)
)
(defun FUN_GETdigit (sNum)
(IF(vl-string-search "." sNum)
(STRLEN (substr sNum (+ 2 (vl-string-search "." sNum))))
0
)
)
(defun Plus1 (str buchang / d1 d2 h num1 num2)
(setq str (vl-string-translate "-" (chr 1) str))
(or (setq d1 (last (string_to_numbers str))) (setq d1 "0"))
(setq h (vl-string-right-trim d1 str))
(setq num1 (FUN_GETdigit d1))
(setq d2 (vl-string-right-trim "." (vl-string-right-trim "0" (RTOS (+ (read d1) buchang) 2 12))))
(setq num2 (FUN_GETdigit d2))
(if(and (= num2 0) (> num1 0))
(setq d2 (strcat d2 "."))
)
(repeat (- num1 num2) (setq d2 (strcat d2 "0")))
;;(setq d2 (vl-princ-to-string (+ (read d1) buchang)))
(while (< (strlen d2) (strlen d1)) (setq d2 (strcat "0" d2)))
(vl-string-translate (chr 1) "-" (strcat h d2))
)
(defun last_ent (en / ss)
(ifen
(progn (setq ss (ssadd))
(while (setq en (entnext en))
(if (not (member (cdr (assoc 0 (entget en))) '("ATTRIB" "VERTEX" "SEQEND")))
(ssadd en ss)
) ;if
) ;while
(if (zerop (sslength ss))
(setq ss nil)
)
ss
) ;progn
(ssget "_x")
) ;if
)
;;-------------
(fun_setini)
(if (setq $buchang (ureal 1 "" "\n增减值(正为增,负为减)" NBTV_TXT_CopyADD))
(setq NBTV_TXT_CopyADD $buchang)
)
(setq ss (ssget ))
(setq e0 (entlast))
(setq pt (getpoint "指定基点:"))
(command "copy" ss "" pt pause)
(setq loop T)
(if (= 0 (distance (setq Point (getvar "LastPoint")) pt)) ;判断最后一点是不是pt点.
(progn (setq loop nil) ;Right Button
(setq ent_tmp (LAST_ENT e0));ent_tmp 是e0后生成的物体.
(command "_.erase" ent_tmp "")
)
(setq pt Point)
)
(while loop
(SETQ SS1 (last_ent E0)
I 0
)
(repeat (sslength ss1)
(setq ent (ssname ss1 i)
i (1+ i)
entl (entget ent)
) ;图元资料
(if (wcmatch (cdr (assoc 0 entl)) "*TEXT")
(progn (setq e-1 (cdr (assoc 1 entl))
;;文字内容
NEWTX (Plus1 E-1 NBTV_TXT_CopyADD)
)
(entmod (subst (cons 1 NEWTX) (assoc 1 entl) entl)) ;更新文字
)
)
) ;end repeat
(setq e0 (entlast))
(command "copy" ss1 "" pt pause)
(setq Point (getvar "LastPoint"))
(if(= 0 (distance Point pt));判断最后一点是不是pt点.
(progn (setq loop nil) ;Right Button
(setq ent_tmp (LAST_ENT e0)) ;ent_tmp 是e0后生成的物体.
(command "_.erase" ent_tmp "")
)
(progn (setq pt Point)
;;(setq ss (LAST_ENT e0))
)
)
)
(fun_close)
(princ)
)
(princ "复制文字增加数字 NBTC_TXTCopyadd")
http://bbs.mjtd.com/xwb/images/bgimg/icon_logo.png 该贴已经同步到 俊林霖的微博 希望论坛内的高手帮个忙再进行优化哈对数值进行加减 如7.50（800.00） 1.先对括号前的数字进行加减 （若我输入0.5）后，提示第二步 2.对括号内的数字进行加减（若我输入-0.5）后，提示第三部3.选择基点 进行复制 在下感激不尽 俊林霖 发表于 2014-6-17 11:29 static/image/common/back.gif
希望论坛内的高手帮个忙再进行优化哈对数值进行加减 如7.50（800.00） 1.先对括号前的数字进行加减 （ ...
xyp1964 发表于 2014-6-17 12:52 static/image/common/back.gif
高手很是感激！！ 但是我加载后出现：no function definition: XYP-CMDLA0怎么回事？ 加载上xcad.vlx
思路大概是：
1.选取文本，分别分割出实数部分及文本部分（ NUM1 STR1 NUM2 STR2 NUM3 STR3 NUM4 STR4......），论坛有相关的函数代码，搜搜即可。
2.设置递增参数n1 n2 n3 n4......，点选位置（getpoint）.
3.实数部分按参数递增（setqNUM1 (+NUM1 n1 ) ......），然后（strcat NUM1 STR1 NUM2 STR2 NUM3 STR3 NUM4 STR4......）连接起来
4.在点选位置（enmake ）插入文字.
能不能修改下,成为第02#箱,第03#箱,第04#箱------ 收藏，学习 怎样增加回退处理？ 学习了，谢谢楼主分享，辛苦了
页:
[1]