[LISP程序]：一个可以生成数列的程序（源码）

ashan

这个程序用在图纸目录中的图号生成最好了，只要几秒钟就搞定了：），支持小数和小数增量。

2. 
   
3. (defun c:na(/ Numtxt Arang StNum NumAdd Nums Dis Bpoint oTxtH TxtH TxtR x
   
4.             y dx dy osnm NumAdd0 StNum0 xs1 xs2 Numlen NAlen Maxxs)
   
5.   (princ "\n--数列生成程序--\n")
   
6.   (setvar "cmdecho" 0)
   
7.   (setq osnm (getvar "osmode"))
   
8.   (setvar "osmode" 0)
   
9.   (initget 1)
   
10.   (setq Bpoint (getpoint "\n请点取起始点:"))  
    
11.   (while (= nil StNum)
    
12.     (setq StNum0 (getstring "\n起始数字:"))   
    
13.     (setq StNum (distof StNum0))
    
14.   )
    
15.   (while (= nil NumAdd)
    
16.     (setq NumAdd0 (getstring "\n增量:"))
    
17.     (setq NumAdd (distof NumAdd0))
    
18.   )
    
19.   (setq Numlen (strlen StNum0))
    
20.   (setq xs1 (xsws StNum0 Numlen))
    
21.   (setq NAlen (strlen NumAdd0))
    
22.   (setq xs2 (xsws NumAdd0 NAlen))
    
23.   (setq Maxxs (max xs1 xs2))
    
24.   (initget 7)
    
25.   (setq Nums (getint "\n个数:"))
    
26.   (initget 3)
    
27.   (setq Dis (getint "\n数字间距:"))
    
28.   (initget "nil x y")
    
29.   (setq Arang (getkword "\n数列方向(X-水平，Y-垂直)<Y>:"))
    
30.   (if (/= "x" Arang)
    
31.     (setq Arang 1)
    
32.     (setq Arang nil)
    
33.   )
    
34. ;
    
35. ;--------加入下列程序段可控制小数位数----------  
    
36. ;
    
37.   ;(setq oluprec (getvar "luprec"))
    
38.   ;(princ (strcat "\n保留小数位数<" (rtos oluprec) ">:"))  
    
39.   ;(initget 4)
    
40.   ;(setq Maxxs (getint))
    
41.   ;(cond ((null Maxxs) (setq Maxxs oluprec)))
    
42. ;
    
43. ;----------------------------------------------
    
44. ;
    
45.   (setq oTxtH (getvar "textsize"))
    
46.   (princ (strcat "\n字高<" (rtos oTxtH) ">:"))
    
47.   (initget 6)
    
48.   (setq TxtH (getint))
    
49.   (cond ((null TxtH) (setq TxtH oTxtH)))
    
50.   (setq TxtR (getreal "\n转角<0>:"))
    
51.   (cond ((null TxtR) (setq TxtR 0)))
    
52.   (setq dx Dis)
    
53.   (setq dy Dis)
    
54.   (repeat Nums
    
55.     (setq x (car Bpoint))
    
56.     (setq y (cadr Bpoint))
    
57.     (if Arang
    
58.       (setq dx 0)
    
59.       (setq dy 0)
    
60.     )
    
61.     (setq Numtxt (rtos StNum 2 Maxxs))
    
62.     (command "text" Bpoint TxtH TxtR Numtxt)  
    
63.     (setq StNum (+ StNum NumAdd))
    
64.     (setq Bpoint (list (+ x dx) (+ y dy)))
    
65.   )
    
66.   (command)
    
67.   (setvar "cmdecho" 1)
    
68.   (setvar "osmode" osnm)
    
69.   (princ)
    
70. )
    
71. (defun xsws(st l / i j st1 ws)
    
72.   (setq st1 (substr st 1 1))
    
73.   (setq i 1)
    
74.   (setq j 1)
    
75.   (while (and (/= st1 ".") (/= i l))
    
76.     (setq i (1+ i))
    
77.     (setq st1 (substr st i 1))   
    
78.     (setq j (1+ j))   
    
79.   )
    
80.   (setq ws (- l j))
    
81. )
    
82. (princ "\n数列生成程序已成功加载，键入命令“NA”即可启动本程序。\n")   
    
83.   

<br /> (defun c:na(/ Numtxt Arang StNum NumAdd Nums Dis Bpoint oTxtH TxtH TxtR x <br />             y dx dy osnm NumAdd0 StNum0 xs1 xs2 Numlen NAlen Maxxs)<br />   (princ "\n--数列生成程序--\n")<br />   (setvar "cmdecho" 0)<br />   (setq osnm (getvar "osmode"))<br />   (setvar "osmode" 0)<br />   (initget 1)<br />   (setq Bpoint (getpoint "\n请点取起始点:"))  <br />   (while (= nil StNum) <br />     (setq StNum0 (getstring "\n起始数字:"))    <br />     (setq StNum (distof StNum0))<br />   )<br />   (while (= nil NumAdd)<br />     (setq NumAdd0 (getstring "\n增量:"))<br />     (setq NumAdd (distof NumAdd0))<br />   )<br />   (setq Numlen (strlen StNum0))<br />   (setq xs1 (xsws StNum0 Numlen))<br />   (setq NAlen (strlen NumAdd0))<br />   (setq xs2 (xsws NumAdd0 NAlen))<br />   (setq Maxxs (max xs1 xs2))<br />   (initget 7)<br />   (setq Nums (getint "\n个数:"))<br />   (initget 3)<br />   (setq Dis (getint "\n数字间距:"))<br />   (initget "nil x y")<br />   (setq Arang (getkword "\n数列方向(X-水平，Y-垂直)<Y>:"))<br />   (if (/= "x" Arang) <br />     (setq Arang 1)<br />     (setq Arang nil)<br />   )<br /> ;<br /> ;--------加入下列程序段可控制小数位数----------  <br /> ;<br />   ;(setq oluprec (getvar "luprec"))<br />   ;(princ (strcat "\n保留小数位数<" (rtos oluprec) ">:"))  <br />   ;(initget 4)<br />   ;(setq Maxxs (getint))<br />   ;(cond ((null Maxxs) (setq Maxxs oluprec)))<br /> ;<br /> ;----------------------------------------------<br /> ;<br />   (setq oTxtH (getvar "textsize"))<br />   (princ (strcat "\n字高<" (rtos oTxtH) ">:"))<br />   (initget 6)<br />   (setq TxtH (getint))<br />   (cond ((null TxtH) (setq TxtH oTxtH)))<br />   (setq TxtR (getreal "\n转角<0>:"))<br />   (cond ((null TxtR) (setq TxtR 0)))<br />   (setq dx Dis)<br />   (setq dy Dis) <br />   (repeat Nums<br />     (setq x (car Bpoint)) <br />     (setq y (cadr Bpoint))<br />     (if Arang<br />       (setq dx 0)<br />       (setq dy 0)<br />     )<br />     (setq Numtxt (rtos StNum 2 Maxxs))<br />     (command "text" Bpoint TxtH TxtR Numtxt)  <br />     (setq StNum (+ StNum NumAdd))<br />     (setq Bpoint (list (+ x dx) (+ y dy)))<br />   )<br />   (command)<br />   (setvar "cmdecho" 1)<br />   (setvar "osmode" osnm)<br />   (princ)<br /> )<br /> (defun xsws(st l / i j st1 ws)<br />   (setq st1 (substr st 1 1))<br />   (setq i 1)<br />   (setq j 1)<br />   (while (and (/= st1 ".") (/= i l))<br />     (setq i (1+ i))<br />     (setq st1 (substr st i 1))    <br />     (setq j (1+ j))    <br />   )<br />   (setq ws (- l j))<br /> )<br /> (princ "\n数列生成程序已成功加载，键入命令“NA”即可启动本程序。\n")    <br />   

乘风寻龙

真心不错！学习学习！谢谢了！