[LISP程序]：R14-连续增值拷贝带数字文本字符串

lsjjm

R14-连续增值拷贝带数字文本字符串
[php]
(defun c:test ( / e el nv s p eg)
  (setq  e (car (entsel"\nSelect Text: ")))
  (setq el (entget e))
  (setq nv (getreal (strcat "\nNew value:" "<40>")))
  (if (null nv)(setq nv 40))
  (setq s (cdr (assoc 1 el)))
  (while (setq p (getpoint "\nCopy to: "))
    (setq s (replstr "+" "." s))
    (setq s (replstr "." "+" (rtos (+ (atof s)(/ nv 100.0)) 2 2)))
    (command "copy" (entlast) "" (cdr (assoc 10 (entget (entlast)))) p "")
    (entmod (subst (cons 1 s)(assoc 1 (entget (entlast))) (entget (entlast))))
  )
)
(defun replstr (old new str)
  (setq nstr "")
  (repeat (strlen str)
    (if (= (substr str 1 1) old)
      (setq nstr (strcat nstr new))
      (setq nstr (strcat nstr (substr str 1 1)))
    )
    (setq str (substr str 2))
  )
  nstr
)
[/php]

ll_j

R14使用时需要将“vl-cmdf”函数改为“command”。

lsjjm

没注意, 我是在R14.01里调试, VL-CMDF是可以的.

陌生人

你在r14调试，当然加载了vlisp,其他人未必有哦：）
一般我们说的支持r14是指支持不需要加载vlisp的

lhj743

增值到几十时无法显示0！

lsjjm

5楼: 请详细说明你运行的情况?

lhj743

比如运行到：2+57后，下一个应该是2+60，却显示2+6，所有遇到0的都没显示！

netbee

最初由 lhj743 发布
[B]增值到几十时无法显示0！ [/B]

用这个试试
(setvar "DIMZIN"  0)

附：
DIMZIN 系统变量 概念 操作步骤 参考
类型：整数
保存位置：图形
初始值：0
控制是否对主单位值作消零处理。可在命令行中输入或在“标注注释”对话框的“主单位”区域中进行设置，此时，DIMZIN 将存储此值。DIMZIN 值为 0-3 时只影响英尺-英寸标注。
0  消除零英尺和零英寸
1  包含零英尺和零英寸
2  包含零英尺，消除零英寸
3  包含零英寸，消除零英尺
4  消除十进制标注中的前导零（例如，0.5000 变为 .5000）
8  消除十进制标注中的后续零（例如，12.5000 变为 12.5）
12  消除前导零和后续零（例如，0.5000 变为 .5）
DIMZIN 还对 AutoLISP rtos 和 angtos 函数执行实数向字符串转换操作有影响。

netbee

应网友［lxyljl］所求修改：能定义步长位数，及简单过虑是不是文字

2. 
   
3. (defun c:test (/ e nv nd s p eg replstr dxf)
   
4.   ;;------------------------
   
5.   (DEFUN dxf (st ss) (CDR (ASSOC st (ENTGET ss))))
   
6.   ;;---------------------
   
7.   (defun replstr (old new str / nstr)
   
8.     (setq nstr "")
   
9.     (repeat (strlen str)
   
10.       (if (= (substr str 1 1) old)
    
11.         (setq nstr (strcat nstr new))
    
12.         (setq nstr (strcat nstr (substr str 1 1)))
    
13.       )
    
14.       (setq str (substr str 2))
    
15.     )
    
16.     nstr
    
17.   )
    
18.   ;;----------------------------
    
19.   (setq e (car (entsel "\n选择文字: ")))
    
20.   (if (wcmatch (dxf 0 e) "*TEXT")
    
21.     (progn
    
22.       (if (null (setq nd (getint (strcat "\n步长位数:" "<2>"))))
    
23.         (setq nd 2)
    
24.       )
    
25.       (if (null (setq nv (getreal (strcat "\n步长变量:" "<40>"))))
    
26.         (setq nv 40)
    
27.       )
    
28.       (setq s (dxf 1 e))
    
29.       (while (setq p (getpoint "\n确定复制新点: "))
    
30.         (setq s (replstr "+" "." s))
    
31.         (setq s (replstr "." "+" (rtos (+ (atof s) (/ nv (atof(strcat"1E+"(itoa nd))))) 2 nd)))
    
32.         (command "copy"
    
33.                  e
    
34.                  ""
    
35.                  (dxf 10 e)
    
36.                  p
    
37.                  ""
    
38.         )
    
39.         (entmod        (subst (cons 1 s)
    
40.                        (assoc 1 (entget (entlast)))
    
41.                        (entget (entlast))
    
42.                 )
    
43.         )
    
44.       )
    
45.     )
    
46.     (princ "\n错误：没有选到文字！")
    
47.   )
    
48.   (princ)
    
49. )
    
50. 
    

<br /> (defun c:test (/ e nv nd s p eg replstr dxf)<br />   ;;------------------------<br />   (DEFUN dxf (st ss) (CDR (ASSOC st (ENTGET ss))))<br />   ;;---------------------<br />   (defun replstr (old new str / nstr)<br />     (setq nstr "")<br />     (repeat (strlen str)<br />       (if (= (substr str 1 1) old)<br />         (setq nstr (strcat nstr new))<br />         (setq nstr (strcat nstr (substr str 1 1)))<br />       )<br />       (setq str (substr str 2))<br />     )<br />     nstr<br />   )<br />   ;;----------------------------<br />   (setq e (car (entsel "\n选择文字: ")))<br />   (if (wcmatch (dxf 0 e) "*TEXT")<br />     (progn<br />       (if (null (setq nd (getint (strcat "\n步长位数:" "<2>"))))<br />         (setq nd 2)<br />       )<br />       (if (null (setq nv (getreal (strcat "\n步长变量:" "<40>"))))<br />         (setq nv 40)<br />       )<br />       (setq s (dxf 1 e))<br />       (while (setq p (getpoint "\n确定复制新点: "))<br />         (setq s (replstr "+" "." s))<br />         (setq s (replstr "." "+" (rtos (+ (atof s) (/ nv (atof(strcat"1E+"(itoa nd))))) 2 nd)))<br />         (command "copy"<br />                  e<br />                  ""<br />                  (dxf 10 e)<br />                  p<br />                  ""<br />         )<br />         (entmod        (subst (cons 1 s)<br />                        (assoc 1 (entget (entlast)))<br />                        (entget (entlast))<br />                 )<br />         )<br />       )<br />     )<br />     (princ "\n错误：没有选到文字！")<br />   )<br />   (princ)<br /> )<br /> <br />