求改进复制递增 A-009 变 A-0010 改为 A-009 变 A-010

669423907 · 发表于 2020-1-10 09:03

本帖最后由 669423907 于 2020-1-10 09:05 编辑

非常感谢网友的分享，程序运行中遇到一个问题 A-009 会变成 A-0010 ，想要的效果是 A-009 变 A-010，
哪位大师帮忙改一下，谢谢了

;复制递增 carrot1983 2008-1-13 http://bbs.mjtd.com/forum.php?mo ... 31&page=1#pid347118
(defun c:13(/ txt_add ss slen i na data
 txt txt_len nub k txt_each num
 num_len n temp txt0 n0 expt_num
 faq1 faq2 int
 )
; (setq int (getint "\n不考虑后缀字符的位数<0>:"))
 (if (= nil int)
(setq int 0)
 ) ;_ end if
; (setq txt_add (getint "\n请输入增值(默认为1):"))
 (if (= nil txt_add)
(setq txt_add 1)
 ) ;_ end if
 (if (setq ss (ssget '((0 . "*text"))))
(progn
 (command "._copy" ss "" '(0 0 0) '(0 0 0))
 (setq ss (ssget "p"))
 (princ "指定基点")
 (command "._move" ss"" pause)
 (setq slen (- (sslength ss) 1))
 (setq i 0)
 (while (<= i slen)
(setq na (ssname ss i))
(setq data (entget na))
(setq txt (cdr (assoc '1 data)))
(setq v10 (cdr (assoc '10 data)))
(setq txt_len (strlen txt)) ;9
(setq txt_cut (substr txt 1 (- txt_len int))) ;abc02
(setq txt_len_cut (strlen txt_cut)) ;5
(setq txt_43 (substr txt (- txt_len (1- int)) int)) ;(03)
(setq nub "")
(setq k txt_len_cut)
(while (>= k 1)
(setq txt_each (substr txt_cut k 1))
(if (and (>= (ascii txt_each) 48) (<= (ascii txt_each) 57))
 ;取字串中"0~9"中的ascii字符txt_each.
 (progn
 (setq nub (strcat txt_each nub))
 (setq k (1- k))
 ) ;end progn
 (setq k 0)
) ;end if
) ;end while
(if (= nub "")
(progn
 (princ "\n末尾不是数字")
 (exit)
) ;_ end progn
) ;_ end if
(setq num (atoi nub)) ;nub="02" num=2
(setq num_len (strlen nub)) ;2
;;;以下是考虑数字串中的零的问题
(setq n 1)
(setq temp 0)
(while (and (<= n num_len) (= temp 0))
(setq txt0 (atof (substr nub n 1)))
(if (/= txt0 0)
 (progn
 (setq n0 (1- n))
 (setq temp 1)
 ) ;_ end progn
) ;_ end if
(setq n (1+ n))
) ;end while
(setq
expt_num (substr txt_cut 1 (+ n0 (- txt_len num_len int)))
)
(setq faq1 (itoa (+ num txt_add)))
(setq faq2 (strcat expt_num faq1 txt_43))
(setq data (subst (cons 1 faq2) (assoc '1 data) data))
(entmod data)
(setq i (+ i 1))
 ) ;end while
)
 )
 (prin1)
)

satan421 · 发表于 2020-1-10 09:03

;;简单改了下，没怎么测试，建议测试下再用

江南十笑 · 发表于 2020-1-10 21:57

不错的程序谢谢分享

cq4920 · 发表于 2020-1-13 09:23

本帖最后由 cq4920 于 2020-1-13 09:30 编辑

你那个不能连续复制！
我这里有一个程序！可以动态递增，输入复制间距，连续复制，可以自定递增数！
但是这个程序的问题是会对字符串中每个数字进行增加，如A1#-P-01 递增后会变成 A2#-P-02
希望大神可以优化一下！！

;;-----------------------=={ Incremental Array }==----------------------;;
(defun c:incarray nil (LM:incarray nil)) ;; Standard version
(defun c:incarrayd nil (LM:incarray t )) ;; Dynamic version
;;----------------------------------------------------------------------;;
(defun LM:incarray ( dyn / *error* bpt dim dis ept inc lst obl qty tmp vxu vxw )
(defun *error* ( msg )
(if (= 'int (type dim))
(setvar 'dimzin dim)
)
(foreach obj obl
(if (and (= 'vla-object (type obj)) (not (vlax-erased-p obj)) (vlax-write-enabled-p obj))
(vla-delete obj)
)
)
(incarray:endundo (incarray:acdoc))
(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
(princ (strcat "\nError: " msg))
)
(redraw) (princ)
)
(if (not (and (setq inc (getenv "LMac\\incarray")) (setq inc (distof inc))))
(setq inc 1)
)
(if (setq tmp (getreal (strcat "\nSpecify increment <" (incarray:num->str inc) ">: ")))
(setenv "LMac\\incarray" (incarray:num->str (setq inc tmp)))
)
(incarray:startundo (incarray:acdoc))
(setq dim (getvar 'dimzin))
(setvar 'dimzin 0)
(cond
( (not
(and
(setq lst (incarray:selection->list (ssget "_:L" '((0 . "~VIEWPORT")))))
(setq bpt (getpoint "\nSpecify base point: "))
(progn
(while
(and
(setq vxu (getpoint "\nSpecify array vector: " bpt))
(equal bpt vxu 1e-8)
)
(princ "\nInvalid array vector.")
)
vxu
)
(setq vxu (mapcar '- vxu bpt)
vxw (trans vxu 1 0 t)
dis (distance '(0.0 0.0 0.0) vxw)
)
)
)
)
( dyn
(princ "\nSpecify array end point: ")
(while (= 5 (car (setq ept (grread t 13 0))))
(redraw)
(foreach obj obl (vla-delete obj))
(setq qty (/ (caddr (trans (mapcar '- (cadr ept) bpt) 1 vxw t)) dis)
obl (incarray:copyvector lst (mapcar (if (minusp qty) '- '+) vxw) (abs (fix qty)) inc)
)
(grvecs (list -3 bpt (mapcar '(lambda ( a b ) (+ (* a qty) b)) vxu bpt)))
)
)
( (setq ept (getpoint bpt "\nSpecify array end point: "))
(setq qty (fix (/ (caddr (trans (mapcar '- ept bpt) 1 vxw t)) dis)))
(incarray:copyvector lst (mapcar (if (minusp qty) '- '+) vxw) (abs (fix qty)) inc)
)
)
(setvar 'dimzin dim)
(incarray:endundo (incarray:acdoc))
(redraw) (princ)
)
;;----------------------------------------------------------------------;;
(defun incarray:num->str ( x / dim rtn )
(if (equal x (atof (rtos x 2 0)) 1e-8)
(rtos x 2 0)
(progn
(setq dim (getvar 'dimzin))
(setvar 'dimzin 8)
(setq rtn (vl-catch-all-apply 'rtos (list x 2 15)))
(setvar 'dimzin dim)
(if (not (vl-catch-all-error-p rtn)) rtn)
)
)
)
;;----------------------------------------------------------------------;;
(defun incarray:copyvector ( lst vec qty inc / cnt obj obl org )
(setq org (vlax-3D-point 0 0)
cnt 1
)
(repeat qty
(foreach itm lst
(setq obj (vla-copy (car itm))
obl (cons obj obl)
)
(vla-move obj org (vlax-3D-point (mapcar '* vec (list cnt cnt cnt))))
(if (= "AcDbBlockReference" (vla-get-objectname obj))
(mapcar
(function
(lambda ( att prp )
(vl-catch-all-apply 'vlax-put-property
(list att (car prp)
(apply 'strcat
(mapcar '(lambda ( x ) (incarray:increment x (* cnt inc)))
(cdr prp)
)
)
)
)
)
)
(vlax-invoke obj 'getattributes)
(cdr itm)
)
(foreach prp (cdr itm)
(vlax-put-property obj (car prp)
(apply 'strcat
(mapcar '(lambda ( x ) (incarray:increment x (* cnt inc)))
(cdr prp)
)
)
)
)
)
)
(setq cnt (1+ cnt))
)
obl
)
;;----------------------------------------------------------------------;;
(defun incarray:selection->list ( sel / idx lst obj obn )
(if sel
(repeat (setq idx (sslength sel))
(setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx))))
obn (vla-get-objectname obj)
)
(if (and (= "AcDbBlockReference" obn) (= :vlax-true (vla-get-hasattributes obj)))
(setq lst
(cons
(cons obj
(mapcar '(lambda ( a ) (vl-list* 'textstring (incarray:splitstring (vla-get-textstring a))))
(vlax-invoke obj 'getattributes)
)
)
lst
)
)
(setq lst
(cons
(cons obj
(mapcar '(lambda ( p ) (vl-list* p (incarray:splitstring (vlax-get-property obj p))))
(cond
( (wcmatch obn "AcDb*Text,AcDbMLeader") '(textstring))
( (wcmatch obn "AcDb*Dimension") '(textoverride))
( (= "AcDbAttributeDefinition" obn) '(tagstring promptstring textstring))
)
)
)
lst
)
)
)
)
)
)
;;----------------------------------------------------------------------;;
(defun incarray:splitstring ( str / lst )
(setq lst (vl-string->list str))
(read (vl-list->string (vl-list* 40 34 (incarray:split lst (< 47 (car lst) 58)))))
)
;;----------------------------------------------------------------------;;
(defun incarray:split ( lst flg )
(cond
( (null lst) '(34 41))
( (= 92 (car lst))
(if flg
(vl-list* 34 32 34 92 92 (incarray:split (cdr lst) nil))
(vl-list* 92 92 (incarray:split (cdr lst) flg))
)
)
( (or (< 47 (car lst) 58) (and (= 46 (car lst)) flg (< 47 (cadr lst) 58)))
(if flg
(vl-list* (car lst) (incarray:split (cdr lst) flg))
(vl-list* 34 32 34 (car lst) (incarray:split (cdr lst) t))
)
)
( flg (vl-list* 34 32 34 (car lst) (incarray:split (cdr lst) nil)))
( (vl-list* (car lst) (incarray:split (cdr lst) nil)))
)
)
;;----------------------------------------------------------------------;;
(defun incarray:increment ( str inc / dci dcs len num )
(if (numberp (read str))
(progn
(setq num (+ (distof str) inc)
inc (incarray:num->str inc)
str (vl-string-left-trim "-" str)
inc (vl-string-left-trim "-" inc)
dci (incarray:decimalplaces inc)
dcs (incarray:decimalplaces str)
len (strlen str)
str (vl-string-left-trim "-" (rtos num 2 (max dci dcs)))
)
(cond
( (< 0 dcs) (setq len (+ (- len dcs) (max dci dcs))))
( (< 0 dci) (setq len (+ dci len 1)))
)
(repeat (- len (strlen str))
(setq str (strcat "0" str))
)
(if (minusp num)
(strcat "-" str)
str
)
)
str
)
)
;;----------------------------------------------------------------------;;
(defun incarray:decimalplaces ( str / pos )
(if (setq pos (vl-string-position 46 str))
(- (strlen str) pos 1)
0
)
)
;;----------------------------------------------------------------------;;
(defun incarray:startundo ( doc )
(incarray:endundo doc)
(vla-startundomark doc)
)
;;----------------------------------------------------------------------;;
(defun incarray:endundo ( doc )
(while (= 8 (logand 8 (getvar 'undoctl)))
(vla-endundomark doc)
)
)
;;----------------------------------------------------------------------;;
(defun incarray:acdoc nil
(eval (list 'defun 'incarray:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
(incarray:acdoc)
)
;;----------------------------------------------------------------------;;
(vl-load-com)
(princ
(strcat
(menucmd "m=$(edtime,0,yyyy)")
)
)
(princ)
;;----------------------------------------------------------------------;;
;; End of File ;;
;;----------------------------------------------------------------------;;

;;-----------------------=={ Incremental Array }==----------------------;; 
 
(defun c:incarray nil (LM:incarray nil)) ;; Standard version 
(defun c:incarrayd nil (LM:incarray t )) ;; Dynamic version 
 
;;----------------------------------------------------------------------;; 
 
(defun LM:incarray ( dyn / *error* bpt dim dis ept inc lst obl qty tmp vxu vxw ) 
 
(defun *error* ( msg ) 
(if (= 'int (type dim)) 
(setvar 'dimzin dim) 
) 
(foreach obj obl 
(if (and (= 'vla-object (type obj)) (not (vlax-erased-p obj)) (vlax-write-enabled-p obj)) 
(vla-delete obj) 
) 
) 
(incarray:endundo (incarray:acdoc)) 
(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) 
(princ (strcat "\nError: " msg)) 
) 
(redraw) (princ) 
) 
 
(if (not (and (setq inc (getenv "LMac\\incarray")) (setq inc (distof inc)))) 
(setq inc 1) 
) 
(if (setq tmp (getreal (strcat "\nSpecify increment <" (incarray:num->str inc) ">: "))) 
(setenv "LMac\\incarray" (incarray:num->str (setq inc tmp))) 
) 
(incarray:startundo (incarray:acdoc)) 
(setq dim (getvar 'dimzin)) 
(setvar 'dimzin 0) 
(cond 
( (not 
(and 
(setq lst (incarray:selection->list (ssget "_:L" '((0 . "~VIEWPORT"))))) 
(setq bpt (getpoint "\nSpecify base point: ")) 
(progn 
(while 
(and 
(setq vxu (getpoint "\nSpecify array vector: " bpt)) 
(equal bpt vxu 1e-8) 
) 
(princ "\nInvalid array vector.") 
) 
vxu 
) 
(setq vxu (mapcar '- vxu bpt) 
vxw (trans vxu 1 0 t) 
dis (distance '(0.0 0.0 0.0) vxw) 
) 
) 
) 
) 
( dyn 
(princ "\nSpecify array end point: ") 
(while (= 5 (car (setq ept (grread t 13 0)))) 
(redraw) 
(foreach obj obl (vla-delete obj)) 
(setq qty (/ (caddr (trans (mapcar '- (cadr ept) bpt) 1 vxw t)) dis) 
obl (incarray:copyvector lst (mapcar (if (minusp qty) '- '+) vxw) (abs (fix qty)) inc) 
) 
(grvecs (list -3 bpt (mapcar '(lambda ( a b ) (+ (* a qty) b)) vxu bpt))) 
) 
) 
( (setq ept (getpoint bpt "\nSpecify array end point: ")) 
(setq qty (fix (/ (caddr (trans (mapcar '- ept bpt) 1 vxw t)) dis))) 
(incarray:copyvector lst (mapcar (if (minusp qty) '- '+) vxw) (abs (fix qty)) inc) 
) 
) 
(setvar 'dimzin dim) 
(incarray:endundo (incarray:acdoc)) 
(redraw) (princ) 
) 
 
;;----------------------------------------------------------------------;; 
 
(defun incarray:num->str ( x / dim rtn ) 
(if (equal x (atof (rtos x 2 0)) 1e-8) 
(rtos x 2 0) 
(progn 
(setq dim (getvar 'dimzin)) 
(setvar 'dimzin 8) 
(setq rtn (vl-catch-all-apply 'rtos (list x 2 15))) 
(setvar 'dimzin dim) 
(if (not (vl-catch-all-error-p rtn)) rtn) 
) 
) 
) 
 
;;----------------------------------------------------------------------;; 
 
(defun incarray:copyvector ( lst vec qty inc / cnt obj obl org ) 
(setq org (vlax-3D-point 0 0) 
cnt 1 
) 
(repeat qty 
(foreach itm lst 
(setq obj (vla-copy (car itm)) 
obl (cons obj obl) 
) 
(vla-move obj org (vlax-3D-point (mapcar '* vec (list cnt cnt cnt)))) 
(if (= "AcDbBlockReference" (vla-get-objectname obj)) 
(mapcar 
(function 
(lambda ( att prp ) 
(vl-catch-all-apply 'vlax-put-property 
(list att (car prp) 
(apply 'strcat 
(mapcar '(lambda ( x ) (incarray:increment x (* cnt inc))) 
(cdr prp) 
) 
) 
) 
) 
) 
) 
(vlax-invoke obj 'getattributes) 
(cdr itm) 
) 
(foreach prp (cdr itm) 
(vlax-put-property obj (car prp) 
(apply 'strcat 
(mapcar '(lambda ( x ) (incarray:increment x (* cnt inc))) 
(cdr prp) 
) 
) 
) 
) 
) 
) 
(setq cnt (1+ cnt)) 
) 
obl 
) 
 
;;----------------------------------------------------------------------;; 
 
(defun incarray:selection->list ( sel / idx lst obj obn ) 
(if sel 
(repeat (setq idx (sslength sel)) 
(setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))) 
obn (vla-get-objectname obj) 
) 
(if (and (= "AcDbBlockReference" obn) (= :vlax-true (vla-get-hasattributes obj))) 
(setq lst 
(cons 
(cons obj 
(mapcar '(lambda ( a ) (vl-list* 'textstring (incarray:splitstring (vla-get-textstring a)))) 
(vlax-invoke obj 'getattributes) 
) 
) 
lst 
) 
) 
(setq lst 
(cons 
(cons obj 
(mapcar '(lambda ( p ) (vl-list* p (incarray:splitstring (vlax-get-property obj p)))) 
(cond 
( (wcmatch obn "AcDb*Text,AcDbMLeader") '(textstring)) 
( (wcmatch obn "AcDb*Dimension") '(textoverride)) 
( (= "AcDbAttributeDefinition" obn) '(tagstring promptstring textstring)) 
) 
) 
) 
lst 
) 
) 
) 
) 
) 
) 
 
;;----------------------------------------------------------------------;; 
 
(defun incarray:splitstring ( str / lst ) 
(setq lst (vl-string->list str)) 
(read (vl-list->string (vl-list* 40 34 (incarray:split lst (< 47 (car lst) 58))))) 
) 
 
;;----------------------------------------------------------------------;; 
 
(defun incarray:split ( lst flg ) 
(cond 
( (null lst) '(34 41)) 
( (= 92 (car lst)) 
(if flg 
(vl-list* 34 32 34 92 92 (incarray:split (cdr lst) nil)) 
(vl-list* 92 92 (incarray:split (cdr lst) flg)) 
) 
) 
( (or (< 47 (car lst) 58) (and (= 46 (car lst)) flg (< 47 (cadr lst) 58))) 
(if flg 
(vl-list* (car lst) (incarray:split (cdr lst) flg)) 
(vl-list* 34 32 34 (car lst) (incarray:split (cdr lst) t)) 
) 
) 
( flg (vl-list* 34 32 34 (car lst) (incarray:split (cdr lst) nil))) 
( (vl-list* (car lst) (incarray:split (cdr lst) nil))) 
) 
) 
 
;;----------------------------------------------------------------------;; 
 
(defun incarray:increment ( str inc / dci dcs len num ) 
(if (numberp (read str)) 
(progn 
(setq num (+ (distof str) inc) 
inc (incarray:num->str inc) 
str (vl-string-left-trim "-" str) 
inc (vl-string-left-trim "-" inc) 
dci (incarray:decimalplaces inc) 
dcs (incarray:decimalplaces str) 
len (strlen str) 
str (vl-string-left-trim "-" (rtos num 2 (max dci dcs))) 
) 
(cond 
( (< 0 dcs) (setq len (+ (- len dcs) (max dci dcs)))) 
( (< 0 dci) (setq len (+ dci len 1))) 
) 
(repeat (- len (strlen str)) 
(setq str (strcat "0" str)) 
) 
(if (minusp num) 
(strcat "-" str) 
str 
) 
) 
str 
) 
) 
 
;;----------------------------------------------------------------------;; 
 
(defun incarray:decimalplaces ( str / pos ) 
(if (setq pos (vl-string-position 46 str)) 
(- (strlen str) pos 1) 
0 
) 
) 
 
;;----------------------------------------------------------------------;; 
 
(defun incarray:startundo ( doc ) 
(incarray:endundo doc) 
(vla-startundomark doc) 
) 
 
;;----------------------------------------------------------------------;; 
 
(defun incarray:endundo ( doc ) 
(while (= 8 (logand 8 (getvar 'undoctl))) 
(vla-endundomark doc) 
) 
) 
 
;;----------------------------------------------------------------------;; 
 
(defun incarray:acdoc nil 
(eval (list 'defun 'incarray:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object)))) 
(incarray:acdoc) 
) 
 
;;----------------------------------------------------------------------;; 
 
(vl-load-com) 
(princ 
(strcat 
(menucmd "m=$(edtime,0,yyyy)") 
) 
) 
(princ) 
 
;;----------------------------------------------------------------------;; 
;; End of File ;; 
;;----------------------------------------------------------------------;;

evayleung · 发表于 2020-1-13 11:03

satan421 发表于 2020-1-10 09:03
;;简单改了下，没怎么测试，建议测试下再用

谢谢分享。。。。。。。。。实用的源码

669423907 · 发表于 2020-1-14 21:36

改了一下程序，可以显示复制次数，可以设定复制次数，但是还有两个问题：
1：以0结尾的文字无效
2：A-019会变A-20（019变20），应该A-019变A-020（019变020）
麻烦路过的大师帮忙改一下，谢谢了

(defun c:13()
(setq ss (ssget)
;f复制次数 5
)
(F复制递增 ss)
)

(defun c:31()
(setq ss (ssget)
f复制次数 5
)
(F复制递增 ss)
)

(defun F复制递增(ssi / ss1 ent pt i z)
(setq pt nil i 1)
(if f复制次数 (setq z f复制次数) (setq f复制次数 0) )
(while (and ssi f复制次数)
(progn
(if (not pt) (setq pt (getpoint "指定基点：")) )
(if pt
(progn
(setq ss1 (ssadd) ent (entlast))
(command "_.copy" ssi "" "non" '(0 0) "non" '(0 0)) ;拷贝
(while (setq ent (entnext ent)) ss1 (ssadd ent ss1) )
(command"select"ss1"")
(if (setq ss# (ssget "p" '((0 . "*text") (1 . "*#") ) ) ) (D递增 ss#) )
(command "_move" ss1 "" "non" pt "\\") ;移动
(if (= 0 (distance (getvar "LastPoint") pt)) ;判断最后一点是不是pt点
(command "_.erase" ss1 "" (setq f复制次数 nil))
(setq ssi ss1 pt (getvar "LastPoint") )
)
)
)
(if (or (not pt) (= f复制次数 1) ) (setq f复制次数 nil) )
(if (> f复制次数 1)
(progn
(princ (strcat "\n "(rtos z)" - "(rtos i)" = "(rtos (- f复制次数 1)) ) )
(setq f复制次数 (- f复制次数 1) i (1+ i) )
)
(progn (princ (strcat "\n 第 "(rtos i)" 次") ) (setq i (1+ i)) )
)
)
)
(setq f复制次数 nil)
(princ))

;复制递增 carrot1983小萝卜头 2008-1-13 http://bbs.mjtd.com/forum.php?mo ... mp;page=1#pid347118
(defun D递增(ss / slen i na data txt v10 txt_len txt_len_cut txt_43 nub k txt_each num num_len n temp txt0 n0 expt_num faq1 faq2)
 (setq slen (- (sslength ss) 1) i 0)
(if (not txt_add) (setq txt_add 1) ) ;增量值为1
(if (not int) (setq int 0) ) ;后缀字符的位数为0
 (while (<= i slen)
(setq na (ssname ss i))
(setq data (entget na))
(setq txt (cdr (assoc '1 data)))
(setq v10 (cdr (assoc '10 data)))
(setq txt_len (strlen txt)) ;9
(setq txt_cut (substr txt 1 (- txt_len int))) ;abc02
(setq txt_len_cut (strlen txt_cut)) ;5
(setq txt_43 (substr txt (- txt_len (1- int)) int)) ;(03)
(setq nub "")
(setq k txt_len_cut)
(while (>= k 1)
 (setq txt_each (substr txt_cut k 1))
 (if (and (>= (ascii txt_each) 48) (<= (ascii txt_each) 57))
 ;;取字串中"0~9"中的ascii字符txt_each.
 (progn
 (setq nub (strcat txt_each nub))
 (setq k (1- k))
 ) ;end progn
 (setq k 0)
 ) ;end if
) ;end while
(if (= nub "")
 (progn
 (princ "\n末尾不是数字")
 (exit)
 )
)
(setq num (atoi nub)) ;nub="02" num=2
(setq num_len (strlen nub)) ;2
;;以下是考虑数字串中的零的问题
(setq n 1)
(setq temp 0)
(while (and (<= n num_len) (= temp 0))
 (setq txt0 (atof (substr nub n 1)))
 (if (/= txt0 0)
 (progn
 (setq n0 (1- n))
 (setq temp 1)
 )
 )
 (setq n (1+ n))
)
(setq
 expt_num (substr txt_cut 1 (+ n0 (- txt_len num_len int)))
)
(setq faq1 (itoa (+ num txt_add)))

;satan421 2020-1-10 http://bbs.mjtd.com/forum.php?mo ... mp;page=1#pid857396
(if (= (rem (atoi faq1) 10) 0) (setq expt_num (substr expt_num 1 (1- (strlen expt_num)))))

(setq faq2 (strcat expt_num faq1 txt_43))
(setq data (subst (cons 1 faq2) (assoc '1 data) data))
(entmod data)
(setq i (+ i 1))
 )
(setq txt_add nil int nil)
(princ))

mahuan1279 · 发表于 2020-1-14 22:34

669423907 发表于 2020-1-14 21:36
改了一下程序，可以显示复制次数，可以设定复制次数，但是还有两个问题：
1：以0结尾的文字无效
2：A-019 ...

仅对字符串处理，如“019”+“1”=“020”，算法如下：
1、确定字符串最长位数，比如三位数；
2、将字符串转化为表，如“019”=‘（0 1 9）；
3、将“1”对应为‘（0 0 1）；
4、两表相加得‘（0 1 10）；
5、将表逆转，得（10 1 0）；
6、每位保留个位数，逢时往后进1，即得（0 2 0）；
7、再次逆转表，得（0 2 0）；
8、将表转化为字符串，即得“020”。

669423907 · 发表于 2020-1-15 09:08

mahuan1279 发表于 2020-1-14 22:34
仅对字符串处理，如“019”+“1”=“020”，算法如下：
1、确定字符串最长位数，比如三位数；
2、将字 ...

谢谢你的回复，我不会弄，方便帮忙改一下吗，谢谢你啦

xj6019 · 发表于 2020-1-15 09:12

论坛里面有现成的，你仔细找找！！！

669423907 · 发表于 2020-1-15 09:18

xj6019 发表于 2020-1-15 09:12
论坛里面有现成的，你仔细找找！！！

这个最合适我，可以作为公用函数，可以各种调用，实现不同效果

账号		自动登录	找回密码
密码			注册

[提问] 求改进复制递增 A-009 变 A-0010 改为 A-009 变 A-010

最佳答案

本帖子中包含更多资源

点评

本帖子中包含更多资源

评分

浏览过的版块