[编程申请]：大侠请帮忙，谢谢

firemaner

本人工作遇到一个问题，就是要做一个重复性很强的编桩号工作。例如，0＋120，0＋140，0＋160。。。
规律性很强，有时是0＋120，0＋150，0＋180。。。
我并不是要类似阵列的递增，
而是操作起来和copy一样的递增，本人最近因此也看了些lsp的东西，但只因才疏学浅，恳切高手相助！！！
谢谢！！！

lsjjm

把你的已知条件, 最后要求说清楚, 不然怎么帮你呀?

841594

看这个是否合用：

2. 
   
3.   [FONT=courier new]
   
4.   
   
5. (defun c:tst ( / tobj otxt _pf otn ntn ntxt)
   
6.   (defun $ly_getnpf (str / _pat _str n)
   
7.     (setq _pat ""
   
8.           _str str
   
9.     )
   
10.     (repeat (setq n (strlen _str))
    
11.       (setq _pat (strcat _pat "#"))
    
12.     )
    
13.     (while (not (wcmatch _str _pat))
    
14.       (setq _str (substr _str 2)
    
15.             _pat (substr _pat 2)
    
16.       )
    
17.     )
    
18.     (substr str 1 (- n (strlen _str)))
    
19.   )
    
20. 
    
21.   ;;;main
    
22.   (vl-load-com)
    
23.   (setq numb (getreal "\n增加值: "))
    
24. 
    
25.   (while (setq en (car (setq ens (entsel))))
    
26.     (setq tobj (vlax-ename->vla-object en)
    
27.           otxt (vla-get-textstring tobj)
    
28.           _pf  ($ly_getnpf otxt)
    
29.     )
    
30.     (vlax-release-object tobj)
    
31.     (princ "\n请拖动文字到新位置: ")
    
32.     (command "copy" en "" (cadr ens) pause)
    
33.     (setq tobj (vlax-ename->vla-object (entlast))
    
34.           otxt (vla-get-textstring tobj)
    
35.           otn  (substr otxt (1+ (strlen _pf)))
    
36.           ntn  (rtos (+ (atof otn) numb))
    
37.           ntxt (strcat _pf ntn)
    
38.     )
    
39.     (vla-put-textstring tobj ntxt)
    
40.     (vlax-release-object tobj)
    
41. 
    
42.   )                                        ;w
    
43. )
    
44.   [/FONT]
    

<br />   [FONT=courier new]<br />   <br /> (defun c:tst ( / tobj otxt _pf otn ntn ntxt)<br />   (defun $ly_getnpf (str / _pat _str n)<br />     (setq _pat ""<br />           _str str<br />     )<br />     (repeat (setq n (strlen _str))<br />       (setq _pat (strcat _pat "#"))<br />     )<br />     (while (not (wcmatch _str _pat))<br />       (setq _str (substr _str 2)<br />             _pat (substr _pat 2)<br />       )<br />     )<br />     (substr str 1 (- n (strlen _str)))<br />   )<br /> <br />   ;;;main<br />   (vl-load-com)<br />   (setq numb (getreal "\n增加值: "))<br /> <br />   (while (setq en (car (setq ens (entsel))))<br />     (setq tobj (vlax-ename->vla-object en)<br />           otxt (vla-get-textstring tobj)<br />           _pf  ($ly_getnpf otxt)<br />     )<br />     (vlax-release-object tobj)<br />     (princ "\n请拖动文字到新位置: ")<br />     (command "copy" en "" (cadr ens) pause)<br />     (setq tobj (vlax-ename->vla-object (entlast))<br />           otxt (vla-get-textstring tobj)<br />           otn  (substr otxt (1+ (strlen _pf)))<br />           ntn  (rtos (+ (atof otn) numb))<br />           ntxt (strcat _pf ntn)<br />     )<br />     (vla-put-textstring tobj ntxt)<br />     (vlax-release-object tobj)<br /> <br />   )                                        ;w<br /> )<br />   [/FONT]<br />

841594

代码修改了一下，原来的多了一个回车，其他很正常呀。
2002上编的，不保证在r14下能够正常运行。。。
附动画一幅：

841594

最初由 firemaner 发布
[B]看见你的演示，我实在很兴奋，这是我最想要的，

我在2002试用时,结果确实是不错！！！

不好意思，我在提个过分的要求，就是

1.   例如，从0+999,加10时，你的结果是0+1009,而我

需要的是1＋009，就是有?.. [/B]

1. 数字过千的时候请自行手动改一下吧，毕竟这不是专门的软件程序。
2.在2002以上，用鼠标中键可以实现实时平移、缩放。
3.我的电脑里已经没有r14了，无法测试。或许那位好心人可以帮你。。。

总之，能帮你一点忙我也很高兴。。。

陌生人

你一次把要求全部说出来就好了嘛.....

841594

其实陌生人就蛮好心的。。。

陌生人

提个思路，不分解字符串，而是去掉“+”号，转为整数，加增量，千位与百位间加回“+”号。.....

lsjjm

2000i下运行有误" 0+40  > 0+80.0000 > 0+80.40.000 > ...

陌生人

(setq numb (getreal "\n增加值: "))
应该用getint，否则显示小数位按当前系统变量设置
要么rtos 用 先fix后itoa代替

841594

陌生人、lsjjm两位提的问题已经修改了，并额外增加了对小数的支持。新程序另发了乙贴见：
http://www.xdcad.net/forum/showt ... 1105495#post1105495

dzmzjw

演示确实是不错！

userzhluserzhl

有多重复制功能就完美了

bitterwood

哪个动画是如何做出来呢？

flowerson

11楼主 你连接的网址不行了，能把程序贴出来吗？