帮忙修改《数字递增复制》

贱人

(defun c:99 (/ E ENEW NV P S)
(if (and (setq e (car (entsel "\n选择数字文本: ")))
(setq e (vlax-ename->vla-object e))
(or (= "AcDbText" (vla-get-ObjectName e))
(= "AcDbMText" (vla-get-ObjectName e))
)
)
(progn
(setq s (vla-get-TextString e))
(if (null (setq nv (getreal (strcat "\n输入递增值:" "<1>"))))
(setq nv 1)
)
(princ "\n指定点: ")
(while (setq p (getpoint))
(setq enew (vla-copy e))
(vla-put-textstring enew (setq s (rtos (+ (atof s) nv) 2)))
(vla-put-InsertionPoint enew (vlax-3d-point p))
)
)
(princ "\n选中的不是文本或没有选择到实体.")
)
(princ)
)

无痕

改什么？怎么改？

贱人

执行出错，昨天还能用，今天罢工了


cad2006

jordan

楼主，很谢谢你的程序。。蛮好的。。。程序在2002中通过。。。没问题。如果不能加载运行了。建议重装CAD，一般问题都能得到很好的解决。。因为lisp的稳定性不是很好。。呵呵。

jordan

谢谢啊。程序写得很好。VLA是lisp的扩展函数吧。。好象很有用啊。

acad-cad

谢谢                 很好用的程序


哪位大侠再改一下复制是增加 指定基点:

dabingrain

1. (terpri)
   
2. (setq jd 2)
   
3. (prompt "\n当前精度0.00，设置精度,请退出后输入jdsz进行设置")
   
4. (DEFUN C:jdsz ()
   
5.   (initget 1 "0 1 2 3 4 5 6 7 8 9")
   
6.   (setq  jd (getint  "\n 请输入精度位数[整数(0)/1位(1)/2位(2)/3位(3)/4位(4)]:"))
   
7.   )
   
8. (defun c:nadd (/ E ENEW NV nv1 nv2 P2 p1 S)
   
9.   
   
10.   (if (and (setq e (car (entsel "\n选择数字文本: ")))
    
11.     (setq e (vlax-ename->vla-object e))
    
12.     (or (= "AcDbText" (vla-get-ObjectName e))
    
13.         (= "AcDbMText" (vla-get-ObjectName e))
    
14.         )
    
15.     )
    
16.     (progn
    
17.       (setq s (vla-get-TextString e))
    
18.       (setq nv 1)
    
19.       (setq p1 (getpoint "\n指定基点:"))
    
20.       (while (setq p2 (getpoint P1 "\n下一点 :") )
    
21. (setq nv1 (strcat "\n输入递增值<" (itoa nv) ">:"))
    
22. (setq nv (if(setq nv2 (getint nv1)) nv2 nv))
    
23. (setq enew (vla-copy e))
    
24. (vla-put-textstring enew (setq s (rtos (+ (atof s) nv) 2 jd)))
    
25. (vla-put-InsertionPoint enew (vlax-3d-point p2))
    
26. )
    
27.       )
    
28.     (princ "\n选中的不是文本或没有选择到实体.")
    
29.     )
    
30.   (princ)
    
31.   )
    

(terpri)<br /> (setq jd 2)<br /> (prompt "\n当前精度0.00，设置精度,请退出后输入jdsz进行设置")<br /> (DEFUN C:jdsz ()<br />   (initget 1 "0 1 2 3 4 5 6 7 8 9")<br />   (setq  jd (getint  "\n 请输入精度位数[整数(0)/1位(1)/2位(2)/3位(3)/4位(4)]:"))<br />   )<br /> (defun c:nadd (/ E ENEW NV nv1 nv2 P2 p1 S)<br />   <br />   (if (and (setq e (car (entsel "\n选择数字文本: ")))<br />     (setq e (vlax-ename->vla-object e))<br />     (or (= "AcDbText" (vla-get-ObjectName e))<br />         (= "AcDbMText" (vla-get-ObjectName e))<br />         )<br />     )<br />     (progn<br />       (setq s (vla-get-TextString e))<br />       (setq nv 1)<br />       (setq p1 (getpoint "\n指定基点:"))<br />       (while (setq p2 (getpoint P1 "\n下一点 :") )<br /> (setq nv1 (strcat "\n输入递增值<" (itoa nv) ">:"))<br /> (setq nv (if(setq nv2 (getint nv1)) nv2 nv))<br /> (setq enew (vla-copy e))<br /> (vla-put-textstring enew (setq s (rtos (+ (atof s) nv) 2 jd)))<br /> (vla-put-InsertionPoint enew (vlax-3d-point p2))<br /> )<br />       )<br />     (princ "\n选中的不是文本或没有选择到实体.")<br />     )<br />   (princ)<br />   )<br />

【KAIXIN】

http://bbs.mjtd.com/thread-92870-1-1.html

duotu007

楼上挖坟的。

辉/:)

我也需要这个程序。。。。