[求助]：递增复制文字

黄河之水

求一个递增复制文字和程序，比如说：选择A01，进行多个复制移动，后面变成A02、A03。。。。
PP1，之后变成PP2、PP3等，
我用的贱人工具箱有一个，但A01之后变成了A1、A2，就是把后面的零除掉了，不合要求，请问大家能不能把这样的程序贴出来，谢谢！

phoenixdjq

(defun c:gf()
(setq bc (getint "\n 请输入步长:"))
)


(defun c:saa()
(setq banben (ver))
(ddd banben)
(setq banben (atoi banben))
(prompt "\n 设置步长命令为:gf,初始步长为1")
(prompt "\n 请选择不需要更改的实体:")
(if (= bc nil)
(setq bc 1)
)
(setq ddjjqq (ssget))
(setq entt  (entsel "\n 请选择一个文字:"))
(setq ent (car entt))
;(setq pt1 (cadr entt))
(redraw ent 3)
(setq dxf (entget ent))          ;联合列表
(setq wenzizu (assoc 1 dxf))     ;点对列表
(setq wenzi (cdr wenzizu))       ;文字

(setq wenzilen (strlen wenzi))
(setq fanyihou (vl-string-translate "1234567890" "##########" wenzi))  ;翻译字符

(setq weizhi (vl-string-search "#" fanyihou))  ;找出#的位置

(setq qianzhui (substr wenzi 1 weizhi))   ;取出前缀
(setq shuzi (substr wenzi (+ weizhi 1)))   ;取出字符串形式的数字
(setq shishu (atoi shuzi))   ;把数字改为实数


(setq pt1 (getpoint "\n 请选择一个点:"))
(setq pt2 (getpoint pt1 "\n 请选择第二点:"))
(setq n 0)

(while pt2

(setq lll (substr wenzi 1 1))  ;判断第一个字符是什么
;(setq llll (substr wenzi 4 1))  ;判断第四个字符是什么

(cond



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
( (= lll "<")                                           ;
(progn                                                  ;
(setq b (+ shishu bc n))                                ;
(setq c (itoa b))                                       ;

(if (< b 10)                                                        ;
(setq d (strcat qianzhui  "0" c ">"))
(setq d (strcat qianzhui  c ">"))  
)                      ;
                                                        ;
(setq e (cons 1 d))

(if (> banben 2004)
(progn                                     ;
(command "copy" ddjjqq "" pt1 pt2 "")            
(command "copy" ent "" pt1 pt2 "")
)
(progn                                     ;
(command "copy" ddjjqq "" pt1 pt2 )            
(command "copy" ent "" pt1 pt2 )
)  ;end progn
)  ;end if

(setq ent1 (entget (entlast)))                          ;    ;此处为一个判断
(setq txtzh1 (assoc 1 ent1))                            ;
(setq ent1 (subst e txtzh1 ent1))                       ;
(entmod ent1)                                           ;
(princ)                                                 ;
)  ;end progn                                           ;
)  ;end first                                           ;
                                                        ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


                                                             ;如果要加判断的话,请选择这里



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(t                                                      ;
(progn                                                  ;
(setq b (+ shishu bc n))
                              ;
(setq c (itoa b))     
(if (< b 10)                                  ;
(setq d (strcat qianzhui c))
   (setq d (strcat qianzhui "0" c))
)                        ;
(setq e (cons 1 d))

(if (> banben 2004)
(progn                                     ;
(command "copy" ddjjqq "" pt1 pt2 "")  
(command "copy" ent "" pt1 pt2 "")        
)  ;end progn

(progn                                     ;
(command "copy" ddjjqq "" pt1 pt2 )  
(command "copy" ent "" pt1 pt2 )        
)  ;end progn
       ); end if                                                 ;    ;此处为第二个判断
(setq ent1 (entget (entlast)))                          ;
(setq txtzh1 (assoc 1 ent1))                            ;
(setq ent1 (subst e txtzh1 ent1))                       ;
(entmod ent1)                                           ;
(princ)                                                 ;
)                                                       ;
)                                                       ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;




)  ;end cond




(setq n (+ bc n))
(setq pt2 (getpoint pt1 "\n 请选择第二点:"))     ;pt1决定有没有显示线

)    ;end while
)    ;end defun

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;                   以下为输入单个字的命令                    ;;;;;;;;;;;;;;;;


(defun c:sa()
(setq banben (ver))
(ddd banben)
(setq banben (atoi banben))
(prompt "\n 设置步长命令为:gf,初始步长为1")
(if (= bc nil)
(setq bc 1)
)

(setq enty (entsel "\n 请选择一个文字:"))
(setq ent (car enty))
;(setq pt1 (cadr enty))

(redraw ent 3)
(setq dxf (entget ent))          ;联合列表
(setq wenzizu (assoc 1 dxf))     ;点对列表
(setq wenzi (cdr wenzizu))       ;文字

(setq wenzilen (strlen wenzi))
(setq fanyihou (vl-string-translate "1234567890" "##########" wenzi))  ;翻译字符

(setq weizhi (vl-string-search "#" fanyihou))  ;找出#的位置

(setq qianzhui (substr wenzi 1 weizhi))   ;取出前缀
(setq shuzi (substr wenzi (+ weizhi 1)))   ;取出字符串形式的数字
(setq shishu (atoi shuzi))   ;把数字改为实数


(setq pt1 (getpoint "\n 请选择一个点:"))
(setq pt2 (getpoint pt1 "\n 请选择第二点:"))
(setq n 0)

(while pt2

(setq lll (substr wenzi 1 1))  ;判断第一个字符是什么

;(setq llll (substr wenzi 4 1))  ;判断第四个字符是什么
(cond



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
( (= lll "<")                                           ;
(progn                                                  ;
(setq b (+ shishu bc n))                                ;
(setq c (itoa b))                                       ;
(if (< b 10)                                                        ;
(setq d (strcat qianzhui  "0" c ">"))
(setq d (strcat qianzhui c ">"))                        ;
)                                                        ;
(setq e (cons 1 d))


(if (> banben 2004)                                    ;
(command "copy"  ent "" pt1 pt2 "")  
(command "copy"  ent "" pt1 pt2 )
)                                                      ;


(setq ent1 (entget (entlast)))                          ;    ;此处为一个判断
(setq txtzh1 (assoc 1 ent1))                            ;
(setq ent1 (subst e txtzh1 ent1))                       ;
(entmod ent1)                                           ;
(princ)                                                 ;
)  ;end progn                                           ;
)  ;end first                                           ;
                                                        ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


                                                             ;如果要加判断的话,请选择这里



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(t                                                      ;
(progn                                                  ;
(setq b (+ shishu bc n))                                ;
(setq c (itoa b))      
(if (< b 10)                                 ;
(setq d (strcat qianzhui "0" c))
(setq d (strcat qianzhui c))
)                           ;
(setq e (cons 1 d))


(if (> banben 2004)                                    ;
(command "copy"  ent "" pt1 pt2 "")  
(command "copy"  ent "" pt1 pt2 )
)                                                       ;
                                                        ;此处为第二个判断
(setq ent1 (entget (entlast)))                          ;
(setq txtzh1 (assoc 1 ent1))                            ;
(setq ent1 (subst e txtzh1 ent1))                       ;
(entmod ent1)                                           ;
(princ)                                                 ;
)                                                       ;
)                                                       ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;




)  ;end cond




(setq n (+ bc n))
(setq pt2 (getpoint pt1 "\n 请选择第二点:"))     ;pt1决定有没有显示线

)    ;end while
(princ)
)    ;end defun




;;;;;;(wcmatch "SHZ1G" "*[1234567890]*")  可以找到是否只有一个数字




(defun ddd (#a)

(setq #b (vl-string->list #a))
(setq #c (vl-remove-if '(lambda (x) (> x 57)) #b))
(setq #d (vl-remove-if '(lambda (x) (< x 46)) #c))
(setq #e (vl-remove 47 #d))   ;此句是去掉/的语句
(setq banben (vl-list->string #e))

)

foride

谢谢phoenixdjq，我复制过去试试，最近因为工作的需要，特别想学习LISP，拿过去研究研究。

phoenixdjq

这个程序是我工作中必须用到的，很早就有了
其实我在论坛中已经发过这个帖子了
但是以前发的，也是没有加前缀0的
现在我补上了

feiyvt

不懂啊

黄河之水

二楼的代码这么长呀，不过我在2004下好像有一些问题。
用这几个编号做例子：A01，T45，5，9TT10-A01，我要的结果只是文本后面的数字加1，结果是这样子的：
A02、A03、A04。。。；
T46、T47。。。；
6、7、8；
9TT10-A02、9TT10-A03。。。。。
有以下问题：
1，用SA命令，5成06、07了，9TT10-A01变成10、11了，可能只识别第一个数字，而把其它文字删了。
2，用SAA命令，5成了6、7、8、9、010、011，后面两个就不对了。对于9TT10-A01不行，我这是一个文本，即使分开两个，如9TT10和A01也不行，结果是这样的：9TT10和A2，
我的意思是，傻瓜式的递增，（就是在文本的值增加1，如有零的话，过十位零当然不必了，因为进位了嘛），不知我表达得对不对？
不过还是谢谢二楼！！！！！！

huyong

谢谢了，看看好用吗。

原来是我不会使用，要用命令sa才行，若增加值不是1，要用gf命令来改变。能否修改一下，可以改前面的值，如1F，经过copy后，变成2F、3F、4F......，有劳2楼的啦。

ampamp

真的好,谢谢

xotoo

希望二楼的能修改一下程序
现在只能正常0复制X-01、X-02这种样式，而不能复制X-001或者X-0001这种格式，如果数字部分有两个以上“0”（包含两个），复制的时候就会强制修改为一个“0”
希望能修改成任意“0”位都可以正常复制。

axin0305

太棒的工具啊 怎么加分啊

pl441943398

复制下来看看

gysjy

请参见：
[iframe h=600 w=100%]http://p4.xdcad.net/forum/showthread.php?s=&postid=3375021#post3375021[/iframe]

黄河之水

12楼的代码不错，只是比如05、005就不行（提示错误：正0），不过再说这样的编号也不多，还有就是放置的基点总在字的右下角。开始有点不习惯。

gysjy

最初由 黄河之水 发布
[B]12楼的代码不错，只是比如05、005就不行（提示错误：正0），不过再说这样的编号也不多，还有就是放置的基点总在字的右下角。开始有点不习惯。 [/B]

放置的基点跟文字的对齐方式有关。你说的05，005在我的cad里没有问题啊。

theradish

功能：文字编号[递增复制]

命令：cd