带小数递增或递减的程序！

hsb-hy

请各位帮忙编辑一个象CAD内“copy"加m功能的复制程序，并且要有小数递增或递减功能，小数要求两位。

ljpnb

试试看，行不行
[PHP]
(defun c:test ()
  (setq ent (car (entsel "\n选择要递增或递减的数字:")))
  (setq roop (getreal "\n递增或递减的值:"))
  (setq num (cdr (assoc 1 (entget ent)))) ;_取出字符型数值
  (setq num1 (atof num)) ;_转换成实数
  (setq i 1)
  (command "copy"
           ent
           ""
           (setq b-point (getpoint "选择一个基准点:"))
  )
  (while (setq point (getpoint "\n选择一个插入点:"))
    (command point)
    (setq ent1 (entget (entlast)))
    (setq num2 (rtos (+ num1 (* roop i)) 2 2))
    (setq ent1 (subst (cons 1 num2)
                      (assoc 1 ent1)
                      ent1
               )
    )
    (entmod ent1)
    (setq i (1+ i))
    (command "copy" ent "" b-point)
  )
  (command "")
)

[/PHP]

hsb-hy

楼上的朋友，递增或递减功能是实现了，可是不能带小数啊！如：每次增加或减少0.52（0.52是任意的，由使用者给定）！即递增或递减的步长！

ljpnb

不好意思，没有理解题意，2楼程序已修改过了

hsb-hy

命令: _appload 已成功加载 test.lsp。
命令: ; 错误: 输入的列表有缺陷

命令: test
未知命令“TEST”。按 F1 查看帮助。

你好，程序有问题！显示如上！

ljpnb

最初由 hsb-hy 发布
[B]命令: _appload 已成功加载 test.lsp。
命令: ; 错误: 输入的列表有缺陷

命令: test
未知命令“TEST”。按 F1 查看帮助。

你好，程序有问题！显示如上！ [/B]

程序没问题的，只是在修改2楼的贴子时多了一个“（”，在(defun前面多了一个，去掉了应该没问题

hsb-hy

多谢，已经可以使用了！

david96007

我也来凑热闹!

2. 
   
3. (defun nadd:setini ()
   
4.   (setvar "cmdecho" 0)
   
5.   (setq dimzin_old (getvar "Dimzin"))
   
6.   (setvar "dimzin" 0)
   
7.   (setq osmode_old (getvar "osmode"))
   
8.   (setvar "osmode" 0)
   
9.   (setq        error_old *error*
   
10.         *error*        err_new
    
11.   )
    
12.   (gc)
    
13. )
    
14. (defun nadd:err_new (msg)
    
15.   (princ "\n")
    
16.   (princ msg)
    
17.   (nadd:setclose)
    
18. )
    
19. (defun nadd:setclose ()
    
20.   (setvar "dimzin" dimzin_old)
    
21.   (setq *error* error_old)
    
22.   (setvar "osmode" osmode_old)
    
23.   (setvar "cmdecho" 1)
    
24.   (Princ)
    
25. )
    
26. (defun c:nadd ( / p dt l_dt d_dt zengliang dxfcode pt pt_from pt_to delt_x delt_y)
    
27.   (nadd:setini)
    
28.   (setvar "osmode" 97)
    
29.   (setq        p          2                        ;精度
    
30.         dt          (car (entsel "选择文本:"))
    
31.         l_dt          (entget dt)
    
32.         d_dt          (distof (cdr (assoc 1 l_dt)))
    
33.         zengliang (getreal "\n请输入增值:")
    
34.   )
    
35.   (if (or (/= 0 (cdr (assoc 71 l_dt)))
    
36.           (/= 0 (cdr (assoc 72 l_dt)))
    
37.       )
    
38.     (setq dxfcode 11
    
39.           pt          (cdr (assoc 11 l_dt))
    
40.     )
    
41.     (setq dxfcode 10
    
42.           pt          (cdr (assoc 10 l_dt))
    
43.     )
    
44.   )
    
45.   (setq        pt_from        (getpoint "\n基准点: ")
    
46.         delt_x        (- (car pt) (car pt_from))
    
47.         delt_y        (- (cadr pt) (cadr pt_from))
    
48.   )
    
49.   (setq pt_to (getpoint "\n拷贝至:" pt_from))
    
50.   (while pt_to
    
51.     (setq d_dt (+ d_dt zengliang)
    
52.           pt   (list (+ (car pt_to) delt_x)
    
53.                      (+ (cadr pt_to) delt_y)
    
54.                      '0
    
55.                )
    
56.           l_dt (subst (cons dxfcode pt)
    
57.                       (assoc dxfcode l_dt)
    
58.                       l_dt
    
59.                )
    
60.           l_dt (subst (cons 1 (rtos d_dt 2 p))
    
61.                       (assoc 1 l_dt)
    
62.                       l_dt
    
63.                )
    
64.     )
    
65.     (entmake l_dt)
    
66.     (setq pt_to (getpoint "\n拷贝至:" pt_from))
    
67.   )
    
68.   (nadd:setclose)
    
69.   (princ)
    
70. )
    
71. 
    
72. 
    

<br /> (defun nadd:setini ()<br />   (setvar "cmdecho" 0)<br />   (setq dimzin_old (getvar "Dimzin"))<br />   (setvar "dimzin" 0)<br />   (setq osmode_old (getvar "osmode"))<br />   (setvar "osmode" 0)<br />   (setq        error_old *error*<br />         *error*        err_new<br />   )<br />   (gc)<br /> )<br /> (defun nadd:err_new (msg)<br />   (princ "\n")<br />   (princ msg)<br />   (nadd:setclose)<br /> )<br /> (defun nadd:setclose ()<br />   (setvar "dimzin" dimzin_old)<br />   (setq *error* error_old)<br />   (setvar "osmode" osmode_old)<br />   (setvar "cmdecho" 1)<br />   (Princ)<br /> )<br /> (defun c:nadd ( / p dt l_dt d_dt zengliang dxfcode pt pt_from pt_to delt_x delt_y)<br />   (nadd:setini)<br />   (setvar "osmode" 97)<br />   (setq        p          2                        ;精度<br />         dt          (car (entsel "选择文本:"))<br />         l_dt          (entget dt)<br />         d_dt          (distof (cdr (assoc 1 l_dt)))<br />         zengliang (getreal "\n请输入增值:")<br />   )<br />   (if (or (/= 0 (cdr (assoc 71 l_dt)))<br />           (/= 0 (cdr (assoc 72 l_dt)))<br />       )<br />     (setq dxfcode 11<br />           pt          (cdr (assoc 11 l_dt))<br />     )<br />     (setq dxfcode 10<br />           pt          (cdr (assoc 10 l_dt))<br />     )<br />   )<br />   (setq        pt_from        (getpoint "\n基准点: ")<br />         delt_x        (- (car pt) (car pt_from))<br />         delt_y        (- (cadr pt) (cadr pt_from))<br />   )<br />   (setq pt_to (getpoint "\n拷贝至:" pt_from))<br />   (while pt_to<br />     (setq d_dt (+ d_dt zengliang)<br />           pt   (list (+ (car pt_to) delt_x)<br />                      (+ (cadr pt_to) delt_y)<br />                      '0<br />                )<br />           l_dt (subst (cons dxfcode pt)<br />                       (assoc dxfcode l_dt)<br />                       l_dt<br />                )<br />           l_dt (subst (cons 1 (rtos d_dt 2 p))<br />                       (assoc 1 l_dt)<br />                       l_dt<br />                )<br />     )<br />     (entmake l_dt)<br />     (setq pt_to (getpoint "\n拷贝至:" pt_from))<br />   )<br />   (nadd:setclose)<br />   (princ)<br /> )<br /> <br /> <br />

hsb-hy

朋友，多谢你！完全满足要求！

在工程施工中，经常要填写一些有规律的小数，如方格网内的设计高程，道路中线的设计高程等！有了此工具，会给你带来很大的方便。为了方便大家，我将楼上我朋友的东西打包，执行命令是：
nadd

希望大家喜欢，特别是搞工程测量的！