【高手进】破解VLX不如先帮我破解LSP源码吧－我10年前写的命令行计算器程序

fawn_lgc

我10年前现学现用写的命令行计算器程序，为计算型钢的重量而开发。
比如８#槽钢长度5*4+6*8m
输入C8(5*4+6*8)即可得出重量。
当然它也可以进行常规的科学计算。

后来发现有漏洞，输入2..7得到1.4的结果，它把2..7当成2.0*0.7计算了。
当我回过头想修改程序时，发现我已无法读懂该程序。

各位破解高手来帮我破解LSP原码。读读这个程序，帮我改掉这个漏洞。

1. ;;;  Copyright (C) 2001 by FAWN, Inc.
   
2. ;;;  小鹿软件版权所有.
   
3. ;;;  钢料统计科学计算器.calculator'_calculator
   
4. 
   
5. (defun c:cc ()
   
6.   (c:calculator)
   
7.   )
   
8. (defun c:calculator (/ fawn datalist error frontlist y result oldresult
   
9.           backlist CPleng myerror myerrorNum funclist run #myerror
   
10.        arithmetic functions plank channel AngSteel column functions2 DBMS;;函数
    
11.         listword block compute statmyerror inspect consDB letter DBS);;函数
    
12. ;;;  (defun *myerror*(msg)
    
13. ;;;    (if (and (/= msg "Function cancelled")(/= msg "函数被取消"))
    
14. ;;;     (princ(strcat "Fawn警告:" msg "\n"))
    
15. ;;;      )
    
16. ;;;    (princ)
    
17. ;;;    )
    
18. 
    
19. (defun arithmetic(signname item1 item2)      ;;;四则运算
    
20.   (cond ((= signname "+")(+ item1 item2))
    
21.         ((= signname "-")(- item1 item2))
    
22.   ((= signname "*")(* item1 item2))
    
23.   ((= signname "/")(if (/= item2 0)(/ item1 item2)
    
24.          (progn(statmyerror "除数为零")0)))
    
25.   (T(statmyerror "四则运算程序逻辑错误")nil)     ;;过程监控
    
26.   )
    
27. )
    
28. (defun functions (functionname item / deno)               ;;函数计算
    
29.     (if (or(= functionname "SIN")(= functionname "COS")
    
30.      (= functionname "TG")(= functionname "CTG"))
    
31.       (setq item (* (/ item 180.0)pi)))
    
32.   ;;;(setq aaa (sqrt(- 1.0 (expt (sin item) 2))))
    
33.   
    
34.     (cond ((= functionname "SIN")(sin item))
    
35.     ((= functionname "COS")(cos item))
    
36.     ((= functionname "TG")(setq deno (sqrt(- 1.0 (expt (sin item) 2))))
    
37.       (if(=  deno 0)(statmyerror "tg90°不存在")
    
38.         (/(sin item)(cos item))))
    
39.     ((= functionname "CTG")(setq deno (sqrt(- 1.0 (expt (cos item) 2))))
    
40.       (if(=  deno 0)(statmyerror "ctg0°不存在")
    
41.         (/(cos item)(sin item))))
    
42.     ((= functionname "ARCTG")(atan item))
    
43.     ((= functionname "LN")(log item))
    
44.     ((= functionname "LOG")(/(log item)(log 10.0)))
    
45.     ((= functionname "SQRT")(sqrt item))
    
46.     ((= functionname "D")(column item))
    
47.     ((= functionname "C")(channel item))
    
48.     ((= functionname "L")(AngSteel item))
    
49.     ((= functionname "PL")(plank item))
    
50.     )
    
51. )
    
52. (defun plank (item)   ;;钢板
    
53.   (* item 7.85)
    
54.   )
    
55. (defun channel (item / channellist fawn)    ;;;槽钢函数
    
56.   (setq fawn nil)
    
57.   (setq channellist '(("5" 5.44)("6.3"6.63)("8"8.045)("10"10)("12.6"12.37)
    
58.           ("14A"14.53)("14B"16.733)("16A"17.23)("16B"19.74)
    
59.           ("18A"20.17)("18B"22.99)("20A"22.63)("20B"25.77)
    
60.           ("22A"24.99)("22B"28.45)
    
61.           ("25A"27.47)("25B"31.39)("25C"35.32)
    
62.           ("28A"31.42)("28B"35.81)("28C"40.21)
    
63.           ("32A"38.22)("32B"43.25)("32C"48.28)
    
64.           ("36A"47.8)("36B"53.45)("36C"50.1)
    
65.           ("40A"58.91)("40B"65.19)("40C"71.47)
    
66.           )
    
67.   )
    
68.   (setq fawn (assoc item channellist))
    
69.   (if (/= fawn nil)(setq fawn (cadr fawn))
    
70.     (progn
    
71.       (statmyerror "无此槽钢型号!可输入的槽钢型号有:
    
72.                  \n5 6.3 8 10 12.6 14a 14b 16a 16b 18a 18b 20a 20b 22a 22b
    
73.            \n25a 25b 25c 28a 28b 28c 32a 32b 32c 36a 36b 36c 40a 40b 40c")
    
74.       (setq fawn 0)))
    
75.   fawn
    
76. )
    
77. (defun AngSteel (item / Anglist fawn)     ;;角铁函数
    
78.   (setq fawn nil)
    
79.   (setq Anglist '(("2*3" 0.889)("2*4" 1.145)
    
80.              ("2.5*3" 1.124)("2.5*4" 1.459)
    
81.        ("3*3" 1.373) ("3*4"1.786)
    
82.        ("3.6*3"1.656)("3.6*4"2.163)("3.6*5"2.654)
    
83.        ("4*3"1.852)("4*4"2.422)("4*5"2.976)
    
84.        ("4.5*3"2.088)("4.5*4"2.736)("4.5*5"3.369)("4.5*6"3.985)
    
85.        ("5"3.770)("5*3"2.332)("5*4"3.059)("5*5"3.770)("5*6"4.465)
    
86.        ("5.6*3"2.624)("5.6*4"3.446)("5.6*5"4.251)("5.6*8"6.568)
    
87.        ("6.3"5.721)("6.3*4"3.907)("6.3*5"4.822)("6.3*6"5.721)("6.3*8"7.469)("6.3*10"9.151)
    
88.        ("7*4"4.372)("7*5"5.397)("7*6"6.406)("7*7"7.398)("7*8"8.373)
    
89.        ("7.5"6.905)("7.5*5"5.818)("7.5*6"6.905)("7.5*7"7.976)("7.5*8"9.030)("7.5*10"11.089)
    
90.        ("8*5"6.211)("8*6"7.376)("8*7"8.525)("8*8"9.658)("8*10"11.874)
    
91.        ("9*6"8.350)("9*7"9.656)("9*8"10.946)("9*10"13.476)("9*12"15.940)
    
92.        ("10*6"9.366)("10*7"10.830)("10*8"12.276)("10*10"15.120)("10*12"17.898)("10*14"20.611)("10*16"23.257)
    
93.        ("11*7"11.928)("11*8"13.532)("11*10"16.690)("11*12"19.782)("11*14"22.809)
    
94.        ("12.5*8"15.504)("12.5*10"19.133)("12.5*12"22.696)("12.5*14"26.193)
    
95.        ("14*10"21.488)("14*12"25.522)("14*14"29.490)("14*16"33.393)
    
96.        ("16*10"24.729)("16*12"29.391)("16*14"38.987)("16*16"38.518)
    
97.        ("18*12"33.159)("18*14"38.383)("18*16"43.542)("18*18"48.634)
    
98.        ("20*14"42.894)("20*16"48.680)("20*18"54.401)("20*20"60.056)("20*24"71.168)
    
99.        )
    
100.   )
     
101.   (setq fawn (assoc item Anglist))
     
102.   (if (/= fawn nil)(setq fawn (cadr fawn))
     
103.     (if #myerror
     
104.       (progn(statmyerror "缺少#号")(setq fawn 0))
     
105.       (progn(statmyerror "无此角铁型号!可输入的角铁型号有:
     
106.       \n2*(3 4) 2.5*(3 4) 3*(3 4) 3.6*(3 4 5) 4*(3 4 5) 4.5*(3 4 5 6) 5*(3 4 5 6)
     
107.       \n5.6*(4 5 6 8) 6.3*(4 5 6 8) 7*(4 5 6 7 8) 7.5*(5 6 7 8 10) 8*(5 6 7 8 10)
     
108.       \n9*(6 7 8 10 12) 10*(6 7 8 10 12 14) 11*(7 8 10 12 14) 12.5*(8 10 12 14)
     
109.       \n14*(10 12 14 16) 16*(10 12 14 16) 18*(12 14 16 18) 20*(14 16 18 20 24)")
     
110.       (setq fawn 0))))
     
111.   fawn
     
112. )
     
113.   
     
114. (defun column(item / fawn residue abc)             ;;圆钢函数
     
115.   (setq fawn(*(expt (/ item 2) 2) pi 7.85 0.001))
     
116.   (if (< item 13)(setq abc 1000.0)
     
117.                 (setq abc 100.0))
     
118.   (setq fawn(* fawn abc))
     
119.   (setq residue(rem fawn 1))
     
120.   (setq fawn(fix fawn))
     
121.   (if(>= residue 0.5)
     
122.     (/ (1+ fawn) abc)
     
123.     (/ fawn abc))
     
124.   )
     
125. (defun functions2 (Num func / residue)         ;;后置函数!
     
126.   (setq fawn 1.0 lgc 1)
     
127.   (setq residue(rem Num 1))
     
128.   (if (and(> residue 0)(> Num 0.0))
     
129.     (statmyerror "阶层的参数必须为正整数")
     
130.     (if (= func "!")
     
131.       (progn                   ;;未考虑实数错误问题
     
132.         (repeat (1- (fix Num))
     
133.           (setq lgc (1+ lgc))
     
134.           (setq fawn(* fawn lgc))
     
135.         )
     
136.         fawn
     
137.       )
     
138.       (statmyerror "函数名不存在!!")  ;;过程监控
     
139.     )
     
140.   )
     
141. )
     
142. (defun DBMS (datalist / leng N search celllist Lindex Rindex)    ;;提取区间
     
143.   (setq leng(length datalist))
     
144.   (setq N 0 Lindex nil Rindex nil)
     
145.   (setq search T)
     
146.   (while (and search (<= N leng))
     
147.     (setq celllist (nth N datalist))        ;;单元子列表
     
148.     (setq datatype (car celllist))
     
149.     (cond ((= datatype "Lbracket")(setq Lindex (1+ N)))
     
150.     ((= datatype "Rbracket")(setq Rindex (1+ N) search nil)))
     
151.     (setq N (1+ N))
     
152.   )
     
153.   (setq frontlist nil backlist nil)
     
154.   (if (/= Rindex nil)
     
155.     (progn
     
156.       (repeat (1- Lindex)
     
157.         (if(= frontlist nil)
     
158.           (setq frontlist (list(car datalist))datalist (cdr datalist))
     
159.           (setq frontlist(append frontlist (list(car datalist)))
     
160.           datalist (cdr datalist))
     
161.         )
     
162.       )
     
163.       (setq backlist (cdr datalist)CPleng (- Rindex Lindex 1))
     
164.     )
     
165.     (setq backlist datalist CPleng leng)
     
166.   )
     
167. )
     
168. 
     
169. (defun listword(datalist M N)   ;;提取list M项的N项
     
170.   (if (= N 1)
     
171.     (car(nth (1- M) datalist))
     
172.     (cadr(nth (1- M) datalist))
     
173.   )
     
174. )
     
175. (defun block ( / signname signname2 a b depot addminus)     ;;区间计算
     
176.   (setq addminus nil depot nil)
     
177.   (setq a(compute))
     
178.   (while (and(/= CPleng 0)(= myerror ""))
     
179.     (setq signname (listword backlist 1 2))
     
180.     (setq backlist (cdr backlist) CPleng (1- CPleng))
     
181.     (if (or(= signname "+")(= signname "-"))(setq addminus T)(setq addminus nil))
     
182.     (setq b(compute))
     
183.     (if (and (/= depot nil)addminus)
     
184.       (progn(setq a (arithmetic depotsign depot a))(setq depot nil)))
     
185.     (if (or(/= addminus T)(= CPleng 0))
     
186.       (setq a (arithmetic signname a b))  ;;如果是乘除
     
187.       (progn
     
188.   (setq signname2 (listword backlist 1 2))   ;;下一个符号
     
189.   (if (or(= signname2 "+")(= signname2 "-"))
     
190.     (setq a (arithmetic signname a b))
     
191.     (setq depot a a b depotsign signname)  ;;置换数据
     
192.   )
     
193.       )
     
194.     )
     
195.   )
     
196.   (if (/= depot nil)
     
197.       (setq a (arithmetic depotsign depot a))(setq depot nil))
     
198.   (if (/= backlist nil)(setq backlist (cdr backlist)))  ;;去闭括号
     
199.   a
     
200. )
     
201. (defun compute (/ sign datatype1 datatype2 datatype3 datatype4
     
202.     data1 data2 data3 data4 fawn)     ;;单元计算
     
203.   (setq N 0)
     
204.   (setq data1 nil data2 nil data3 nil data4 nil)
     
205.   (setq sign nil)
     
206.   (while (and(< N CPleng)(< N 4)(/= sign "sign"))
     
207.     (setq N (1+ n))
     
208.     (cond ((= N 1)(setq sign(listword backlist 1 1)      ;;提取单元
     
209.       datatype1 sign data1(listword backlist 1 2)))
     
210.     ((= N 2)(setq sign(listword backlist 2 1)
     
211.       datatype2 sign data2(listword backlist 2 2)))
     
212.     ((= N 3)(setq sign(listword backlist 3 1)
     
213.       datatype3 sign data3(listword backlist 3 2)))
     
214.     ((= N 4)(setq sign(listword backlist 4 1)
     
215.       datatype4 sign data4(listword backlist 4 2)))
     
216.     )
     
217.   )
     
218.   (if (/= N CPleng)(setq N (1- N)))          ;;;计算单元
     
219.   (setq CPleng (- CPleng N))                 ;;未计算长度
     
220.   (repeat N
     
221.     (setq backlist (cdr backlist))
     
222.   )                    ;;;未计算数据
     
223.   ;;(if (/= N 0)(setq result nil))     ;;不进行累计清空上次结果
     
224.   (cond ((= N 0)(if (= result nil) 0.0 (progn(setq fawn result result T)fawn)))     ;;累计计算
     
225.         ((= N 1)(if (= datatype1 "Num") data1(statmyerror "函数无参数")))
     
226.   ((= N 2)(cond((= datatype2 "Num")(functions data1 data2))
     
227.          ((= datatype1 "Num")(functions2 data1 data2))
     
228.          (T(statmyerror "函数无参数吗"))))  ;;此情况不可能发生
     
229.   ((= N 3)(cond((= datatype2 "Num")(functions data1(functions2 data2 data3)))
     
230.          ((= data2 "^" )(expt data1 data3))))
     
231.   (T (functions data1 (expt data2 data4)))
     
232.   )
     
233. )
     
234. (defun statmyerror (item)      ;;错误统计
     
235.   (setq myerrorNum (1+ myerrorNum))
     
236.   (setq myerror(strcat myerror " "(itoa myerrorNum) "." item))
     
237. )   
     
238.   
     
239. (defun inspect (datalist / leng N celllist datatype
     
240.     signNum bracketNum bracket )   ;;数据库错误检验
     
241. 
     
242.   (setq funclist'(("SIN")("COS")("TG")("CTG")("ARCTG")("LN")("LOG")
     
243.       ("SQRT")("!")("^")("D")("C")("L")("PL")))
     
244.   (setq bracketNum 0 signNum -1)
     
245.   (setq bracket nil)
     
246.   (setq leng(length datalist))
     
247.   (setq N 0)
     
248.   (repeat leng
     
249.     (setq celllist (nth N datalist))        ;;单元子列表
     
250.     (setq N (1+ N))
     
251.     (setq datatype (car celllist))
     
252.     (setq data (cadr celllist))
     
253.     (cond ((= datatype "Lbracket")(setq bracketNum (1+ bracketNum) bracket T))
     
254.     ((= datatype "Rbracket")(setq bracketNum (1- bracketNum))
     
255.      (if bracket (progn
     
256.        (statmyerror"重叠的无用括号")
     
257.        (setq bracket nil))))
     
258.     (T (setq bracket nil)))
     
259.     (if(and(< bracketNum 0)(/= N leng))(statmyerror "错位的右括号"))
     
260.     (cond ((= datatype "sign")(setq signNum (1+ signNum)))
     
261.     ((= datatype "Lbracket")(setq signNum 0))
     
262.     (T (if (> signNum 0)
     
263.          (statmyerror (strcat(itoa signNum) "个多余运算符"))
     
264.        )
     
265.      (setq signNum -1)))
     
266.     (cond ((= datatype "function")
     
267.      (setq abc (assoc data funclist))
     
268.      (if(= (assoc data funclist)nil)
     
269.             (statmyerror (strcat"未知函数"data))))
     
270.           ((= data ".")(statmyerror "多余的小数点"))
     
271.     ((and (= datatype "Num")(or(= data "-")(= data "-.")))(statmyerror "多余的减号"))
     
272.     ((and(= N leng)(= datatype "sign"))(statmyerror (strcat(itoa (1+ signNum)) "个多余运算符")))
     
273.   )
     
274.   )
     
275.   (cond ((< bracketNum 0)(statmyerror "多余右括号"))
     
276.   ((> bracketNum 0)(statmyerror "多余左括号")))
     
277. )
     
278. 
     
279. (defun consDB (datalist datatype data / lgc) ;;向数据库添加元素的函数
     
280.   (if(= datalist "")
     
281.     (list(list  datatype data))
     
282.     (progn
     
283.       (setq lgc (list(list datatype data)))
     
284.       (append datalist lgc)
     
285.     )
     
286.   )
     
287. )
     
288. (defun letter  (item / fawn)              ;;检测一字符的函数
     
289.   (setq fawn (ascii item))
     
290.   (cond ((and(>= fawn 48)(<= fawn 57))"Num")   ;;数
     
291.   ((= fawn 46)"point")                   ;;小数点
     
292.   ((or(= fawn 42)(= fawn 43)(= fawn 47))"sign")         ;;+*/号
     
293.   ((= fawn 45)"minus")                                  ;;负号
     
294.         ((= fawn 40) "Lbracket")       ;;左括号
     
295.   ((= fawn 41) "Rbracket")       ;;右括号
     
296.   (T"function")
     
297.   )
     
298. )
     
299. (defun DBS (fawn / N item datatype data mydata lettertype
     
300.       oldtype olddata addbracket Noatof unite Angunite #sign
     
301.       savefawn savedatalist savelong point)        ;;建立数据库
     
302.   (defun correction ()
     
303.     (if (= data "PI")(setq datatype "Num" data pi Noatof nil))
     
304.     (cond ((and(= unite nil)(or (= data "A")(= data "B")(= data "C")))  ;;提取槽钢型号
     
305.       (setq unite T datatype "Num" data(strcat olddata data)
     
306.       datalist(reverse datalist)datalist (cdr datalist)
     
307.       datalist(reverse datalist)))
     
308.     ((and(= Angunite nil)(/= data "#"))
     
309.       (setq Noatof nil datatype "Num" data(strcat olddata data)
     
310.       datalist(reverse datalist)datalist (cdr datalist)
     
311.       datalist(reverse datalist)#sign T))
     
312.     ((= data "#")(if Noatof(statmyerror "缺少型钢符号"))
     
313.       (setq Angunite T datatype "Num" #sign nil Noatof nil))
     
314.     ((and  (= oldtype "Lbracket")(= data "-"))
     
315.       (setq datatype "sign"))             ;;处理负号
     
316.           ((and  (or (= oldtype "Num") (= olddata "!"))     ;;左括号、函数前,智能纠错
     
317.     (or(= datatype "function")(= datatype "Lbracket")(= datatype "Num"))
     
318.     (/= data "!") (/= data "^"))
     
319.       (setq datalist (consDB datalist "sign" "*")))
     
320.     ((and (= oldtype "Rbracket")(/= datatype "Rbracket")(/= datatype "sign")
     
321.     (/= data "!") (/= data "^"))  ;;右括号智能纠错
     
322.       (setq datalist (consDB datalist "sign" "*")))
     
323.     ((and(= oldtype "function")(/= olddata "!")(= datatype "function");;加左括号
     
324.          (/= data "!")(/= data "^"))
     
325.       (setq datalist (consDB datalist "Lbracket" "(")
     
326.       addbracket (1+ addbracket)))
     
327.     ((and (/= addbracket 0)
     
328.     (or (= datatype "Rbracket")(= datatype "sign"))) ;;加闭括号
     
329.      (repeat addbracket
     
330.        (setq datalist (consDB datalist "Rbracket" ")" ))
     
331.      )
     
332.      (setq addbracket 0))
     
333.     )                                                     ;;纠错完毕
     
334.     (if (= unite nil)(setq unite T))
     
335.     (cond ((and(= oldtype "function")(/= olddata "!")         ;;;sin等函数
     
336.          (or(= datatype "sign")(= data "!") (= data "^")))
     
337.       (statmyerror "函数无参数"))
     
338.     ((and(= oldtype "Lbracket")(or(= data "!") (= data "^"))) ;;;! \等函数
     
339.       (statmyerror "函数无参数"))
     
340.     ((and(= oldtype "sign")(= datatype "Rbracket"))(statmyerror "多余运算符"))
     
341.     ((and(= oldtype "Lbracket")(or(= data "*")(= data "/")))(statmyerror "多余运算符"))
     
342.     )
     
343.     (if(and (= olddata "C")(= datatype "Num"))   ;;槽钢
     
344.       (setq Noatof nil unite nil))
     
345.     (if(and (= olddata "L")(= datatype "Num"))   ;;角铁
     
346.       (setq Noatof nil Angunite nil
     
347.       savefawn fawn savedatalist datalist savelong long))  ;;没有#号下将使用
     
348.     (setq oldtype datatype olddata data)
     
349.   )      ;;结束
     
350.   (setq funclist'(("SIN")("COS")("TG")("CTG")("ARCTG")("LN")("LOG")
     
351.       ("SQRT")("!")("^")("D")("PL")("Pi")))
     
352.   (setq addbracket 0)
     
353.   (setq Noatof T unite T Angunite T)
     
354.   (setq #sign nil #myerror nil)
     
355.   (setq fawn (strcase fawn))
     
356.   (setq long (strlen fawn))         ;;数据长度.必须的
     
357.   (setq datatype "Num")               ;;单元类型
     
358.   (while (/= fawn "")
     
359.     (setq N 0 mydata nil)                       ;;当前字符
     
360.     (setq point T)
     
361.     (setq lettertype datatype)        ;;当前字符类型
     
362.     (while (and (= lettertype datatype) (<= N long)(= mydata nil))   ;;类型不同退出
     
363.       (setq long (strlen fawn))      ;;计算当前长度
     
364.       (setq N (1+ N))
     
365.       (setq item (substr fawn N 1))       ;;提取第N个字符
     
366.       (setq lettertype(letter item))                     ;;检测第N个字符
     
367.       (if (and point(= datatype "Num")(= lettertype "point")) ;;小数点是数数字
     
368.   (setq lettertype "Num" point nil)
     
369.       )
     
370.       (if (= lettertype "minus")   ;;处理负号
     
371.   (if (or(= datatype "sign")(= datatype "function")
     
372.          (= datatype "Lbracket")) ;;前一单元类型是算术符号等
     
373.     (setq lettertype "Num")       ;;当前字符类型是数字
     
374.     (setq lettertype "sign")      ;;否则字符类型是算术符号
     
375.   )
     
376.       )
     
377.       (if (= N 1)(setq datatype lettertype))  ;;提取第1个字符类型作为单元类型
     
378.       (setq data (substr fawn 1 (1- n)))      ;;不可缺少!
     
379.       (setq mydata (assoc data funclist))
     
380.     )
     
381.     (if (or(= datatype "sign")(= datatype "Rbracket")
     
382.      (= datatype "Lbracket"))
     
383.       (setq N 2))   ;;将运算符限定为一个
     
384.     (setq data (substr fawn 1 (1- n)))
     
385.     (if (or(= data "!")(= data "^"))(setq N 2 data (substr fawn 1 1)))
     
386.     (correction)             ;;;智能纠错
     
387.     (if (and (= datatype "Num")(/= data "-")(/= data "-.")Noatof)
     
388.       (setq data (atof data)));;字符转数字
     
389.     (if (and unite Angunite)(= (setq Noatof T)))
     
390.     (if (/= data "#")(setq datalist (consDB datalist datatype data)))
     
391.                    ;;函数  数据库   数据类型  数据
     
392.     (if (<= N long)                     ;;提取剩余的数据
     
393.       (setq fawn (substr fawn   N))
     
394.       (setq fawn "")                  ;;字符已提完
     
395.     )
     
396.     (if (and #sign (= fawn ""))       ;;没有#号下将使用
     
397.       (setq #sign nil #myerror T Angunite T fawn savefawn oldtype ""  
     
398.       datalist savedatalist long savelong datatype "function" data "C"))
     
399.   )
     
400.   datalist
     
401. )
     
402. ;;;主程序
     
403.   ;;(ai_undo_push);;(ai_undo_pop)
     
404.   (setq result nil)   ;;初始化结果
     
405.   (setq run T)    ;;继续执行
     
406.   (while run
     
407.     (setq oldresult result)  ;;保存旧结果
     
408.     (setq myerror "")
     
409.     (setq datalist "")
     
410.     (setq fawn "")
     
411.     (setq myerrorNum 0 signNum -1)
     
412.     (setq fawn (getstring T "\n输入式子:"))
     
413.     (if (/= fawn "")
     
414.       (progn
     
415.         (setq datalist (DBS fawn))  ;;(princ datalist)
     
416.         (inspect datalist)          ;;检验数据库
     
417.         (if (= myerror "")
     
418.     (while(/= datalist nil)
     
419.       (DBMS datalist)        ;;;提取区间
     
420.       (setq y (block))         ;;;计算区间
     
421.       (if(or(/= frontlist nil)(/= backlist nil))   ;;合并
     
422.         (setq datalist(append frontlist (list(list "Num" y)) backlist))
     
423.         (setq datalist nil))   
     
424.     )
     
425.         )
     
426.         (if (/= result T)
     
427.     (princ "结果：")
     
428.     (progn
     
429.       (princ "计算:(")
     
430.       (princ oldresult)
     
431.       (princ(strcat ")" fawn "\n累计结果："))))
     
432.   (setq result y)
     
433.         (if (/= myerror "")
     
434.     (progn
     
435.       (princ (strcat"错误" myerror "。"))
     
436.       (setq result nil)   ;;结果清空
     
437. 
     
438.     )
     
439.     (princ result)
     
440.   )
     
441.       )
     
442.       (setq run nil)
     
443.     )
     
444.   )
     
445.   ;;(ai_undo_pop)
     
446.   (if(not fawnload)(setq fawnload(princ"\"计算器\"命令 小鹿软件*版权所有")))
     
447.   (princ)
     
448. )

;;;  Copyright (C) 2001 by FAWN, Inc.<br /> ;;;  小鹿软件版权所有.<br /> ;;;  钢料统计科学计算器.calculator'_calculator<br /> <br /> (defun c:cc ()<br />   (c:calculator)<br />   )<br /> (defun c:calculator (/ fawn datalist error frontlist y result oldresult<br />           backlist CPleng myerror myerrorNum funclist run #myerror<br />        arithmetic functions plank channel AngSteel column functions2 DBMS;;函数<br />         listword block compute statmyerror inspect consDB letter DBS);;函数<br /> ;;;  (defun *myerror*(msg)<br /> ;;;    (if (and (/= msg "Function cancelled")(/= msg "函数被取消"))<br /> ;;;     (princ(strcat "Fawn警告:" msg "\n"))<br /> ;;;      )<br /> ;;;    (princ)<br /> ;;;    )<br /> <br /> (defun arithmetic(signname item1 item2)      ;;;四则运算<br />   (cond ((= signname "+")(+ item1 item2))<br />         ((= signname "-")(- item1 item2))<br />   ((= signname "*")(* item1 item2))<br />   ((= signname "/")(if (/= item2 0)(/ item1 item2)<br />          (progn(statmyerror "除数为零")0)))<br />   (T(statmyerror "四则运算程序逻辑错误")nil)     ;;过程监控<br />   )<br /> ) <br /> (defun functions (functionname item / deno)               ;;函数计算<br />     (if (or(= functionname "SIN")(= functionname "COS")<br />      (= functionname "TG")(= functionname "CTG"))<br />       (setq item (* (/ item 180.0)pi)))<br />   ;;;(setq aaa (sqrt(- 1.0 (expt (sin item) 2))))<br />   <br />     (cond ((= functionname "SIN")(sin item))<br />     ((= functionname "COS")(cos item))<br />     ((= functionname "TG")(setq deno (sqrt(- 1.0 (expt (sin item) 2))))<br />       (if(=  deno 0)(statmyerror "tg90°不存在")<br />         (/(sin item)(cos item))))<br />     ((= functionname "CTG")(setq deno (sqrt(- 1.0 (expt (cos item) 2))))<br />       (if(=  deno 0)(statmyerror "ctg0°不存在")<br />         (/(cos item)(sin item))))<br />     ((= functionname "ARCTG")(atan item))<br />     ((= functionname "LN")(log item))<br />     ((= functionname "LOG")(/(log item)(log 10.0)))<br />     ((= functionname "SQRT")(sqrt item))<br />     ((= functionname "D")(column item))<br />     ((= functionname "C")(channel item))<br />     ((= functionname "L")(AngSteel item))<br />     ((= functionname "PL")(plank item))<br />     )<br /> )<br /> (defun plank (item)   ;;钢板<br />   (* item 7.85)<br />   )<br /> (defun channel (item / channellist fawn)    ;;;槽钢函数<br />   (setq fawn nil)<br />   (setq channellist '(("5" 5.44)("6.3"6.63)("8"8.045)("10"10)("12.6"12.37)<br />           ("14A"14.53)("14B"16.733)("16A"17.23)("16B"19.74)<br />           ("18A"20.17)("18B"22.99)("20A"22.63)("20B"25.77)<br />           ("22A"24.99)("22B"28.45)<br />           ("25A"27.47)("25B"31.39)("25C"35.32)<br />           ("28A"31.42)("28B"35.81)("28C"40.21)<br />           ("32A"38.22)("32B"43.25)("32C"48.28)<br />           ("36A"47.8)("36B"53.45)("36C"50.1)<br />           ("40A"58.91)("40B"65.19)("40C"71.47)<br />           )<br />   )<br />   (setq fawn (assoc item channellist))<br />   (if (/= fawn nil)(setq fawn (cadr fawn))<br />     (progn<br />       (statmyerror "无此槽钢型号!可输入的槽钢型号有:<br />                  \n5 6.3 8 10 12.6 14a 14b 16a 16b 18a 18b 20a 20b 22a 22b<br />            \n25a 25b 25c 28a 28b 28c 32a 32b 32c 36a 36b 36c 40a 40b 40c")<br />       (setq fawn 0)))<br />   fawn<br /> )<br /> (defun AngSteel (item / Anglist fawn)     ;;角铁函数<br />   (setq fawn nil)<br />   (setq Anglist '(("2*3" 0.889)("2*4" 1.145)<br />              ("2.5*3" 1.124)("2.5*4" 1.459)<br />        ("3*3" 1.373) ("3*4"1.786)<br />        ("3.6*3"1.656)("3.6*4"2.163)("3.6*5"2.654)<br />        ("4*3"1.852)("4*4"2.422)("4*5"2.976)<br />        ("4.5*3"2.088)("4.5*4"2.736)("4.5*5"3.369)("4.5*6"3.985)<br />        ("5"3.770)("5*3"2.332)("5*4"3.059)("5*5"3.770)("5*6"4.465)<br />        ("5.6*3"2.624)("5.6*4"3.446)("5.6*5"4.251)("5.6*8"6.568)<br />        ("6.3"5.721)("6.3*4"3.907)("6.3*5"4.822)("6.3*6"5.721)("6.3*8"7.469)("6.3*10"9.151)<br />        ("7*4"4.372)("7*5"5.397)("7*6"6.406)("7*7"7.398)("7*8"8.373)<br />        ("7.5"6.905)("7.5*5"5.818)("7.5*6"6.905)("7.5*7"7.976)("7.5*8"9.030)("7.5*10"11.089)<br />        ("8*5"6.211)("8*6"7.376)("8*7"8.525)("8*8"9.658)("8*10"11.874)<br />        ("9*6"8.350)("9*7"9.656)("9*8"10.946)("9*10"13.476)("9*12"15.940)<br />        ("10*6"9.366)("10*7"10.830)("10*8"12.276)("10*10"15.120)("10*12"17.898)("10*14"20.611)("10*16"23.257)<br />        ("11*7"11.928)("11*8"13.532)("11*10"16.690)("11*12"19.782)("11*14"22.809)<br />        ("12.5*8"15.504)("12.5*10"19.133)("12.5*12"22.696)("12.5*14"26.193)<br />        ("14*10"21.488)("14*12"25.522)("14*14"29.490)("14*16"33.393)<br />        ("16*10"24.729)("16*12"29.391)("16*14"38.987)("16*16"38.518)<br />        ("18*12"33.159)("18*14"38.383)("18*16"43.542)("18*18"48.634)<br />        ("20*14"42.894)("20*16"48.680)("20*18"54.401)("20*20"60.056)("20*24"71.168)<br />        )<br />   )<br />   (setq fawn (assoc item Anglist))<br />   (if (/= fawn nil)(setq fawn (cadr fawn))<br />     (if #myerror<br />       (progn(statmyerror "缺少#号")(setq fawn 0))<br />       (progn(statmyerror "无此角铁型号!可输入的角铁型号有:<br />       \n2*(3 4) 2.5*(3 4) 3*(3 4) 3.6*(3 4 5) 4*(3 4 5) 4.5*(3 4 5 6) 5*(3 4 5 6)<br />       \n5.6*(4 5 6 8) 6.3*(4 5 6 8) 7*(4 5 6 7 8) 7.5*(5 6 7 8 10) 8*(5 6 7 8 10) <br />       \n9*(6 7 8 10 12) 10*(6 7 8 10 12 14) 11*(7 8 10 12 14) 12.5*(8 10 12 14) <br />       \n14*(10 12 14 16) 16*(10 12 14 16) 18*(12 14 16 18) 20*(14 16 18 20 24)")<br />       (setq fawn 0))))<br />   fawn<br /> )<br />   <br /> (defun column(item / fawn residue abc)             ;;圆钢函数<br />   (setq fawn(*(expt (/ item 2) 2) pi 7.85 0.001))<br />   (if (< item 13)(setq abc 1000.0)<br />                 (setq abc 100.0))<br />   (setq fawn(* fawn abc))<br />   (setq residue(rem fawn 1))<br />   (setq fawn(fix fawn))<br />   (if(>= residue 0.5)<br />     (/ (1+ fawn) abc)<br />     (/ fawn abc))<br />   )<br /> (defun functions2 (Num func / residue)         ;;后置函数!<br />   (setq fawn 1.0 lgc 1)<br />   (setq residue(rem Num 1))<br />   (if (and(> residue 0)(> Num 0.0))<br />     (statmyerror "阶层的参数必须为正整数")<br />     (if (= func "!")<br />       (progn                   ;;未考虑实数错误问题<br />         (repeat (1- (fix Num))<br />           (setq lgc (1+ lgc))<br />           (setq fawn(* fawn lgc))<br />         )<br />         fawn<br />       )<br />       (statmyerror "函数名不存在!!")  ;;过程监控<br />     )<br />   )<br /> )<br /> (defun DBMS (datalist / leng N search celllist Lindex Rindex)    ;;提取区间<br />   (setq leng(length datalist))<br />   (setq N 0 Lindex nil Rindex nil)<br />   (setq search T)<br />   (while (and search (<= N leng))<br />     (setq celllist (nth N datalist))        ;;单元子列表<br />     (setq datatype (car celllist))<br />     (cond ((= datatype "Lbracket")(setq Lindex (1+ N)))<br />     ((= datatype "Rbracket")(setq Rindex (1+ N) search nil)))<br />     (setq N (1+ N))<br />   )<br />   (setq frontlist nil backlist nil)<br />   (if (/= Rindex nil)<br />     (progn<br />       (repeat (1- Lindex)<br />         (if(= frontlist nil)<br />           (setq frontlist (list(car datalist))datalist (cdr datalist))<br />           (setq frontlist(append frontlist (list(car datalist)))<br />           datalist (cdr datalist))<br />         )<br />       )<br />       (setq backlist (cdr datalist)CPleng (- Rindex Lindex 1))<br />     )<br />     (setq backlist datalist CPleng leng)<br />   )<br /> )<br /> <br /> (defun listword(datalist M N)   ;;提取list M项的N项<br />   (if (= N 1)<br />     (car(nth (1- M) datalist))<br />     (cadr(nth (1- M) datalist))<br />   )<br /> )<br /> (defun block ( / signname signname2 a b depot addminus)     ;;区间计算<br />   (setq addminus nil depot nil)<br />   (setq a(compute))<br />   (while (and(/= CPleng 0)(= myerror ""))<br />     (setq signname (listword backlist 1 2))<br />     (setq backlist (cdr backlist) CPleng (1- CPleng))<br />     (if (or(= signname "+")(= signname "-"))(setq addminus T)(setq addminus nil))<br />     (setq b(compute))<br />     (if (and (/= depot nil)addminus)<br />       (progn(setq a (arithmetic depotsign depot a))(setq depot nil)))<br />     (if (or(/= addminus T)(= CPleng 0))<br />       (setq a (arithmetic signname a b))  ;;如果是乘除<br />       (progn<br />   (setq signname2 (listword backlist 1 2))   ;;下一个符号<br />   (if (or(= signname2 "+")(= signname2 "-"))<br />     (setq a (arithmetic signname a b))<br />     (setq depot a a b depotsign signname)  ;;置换数据<br />   )<br />       )<br />     )<br />   )<br />   (if (/= depot nil)<br />       (setq a (arithmetic depotsign depot a))(setq depot nil))<br />   (if (/= backlist nil)(setq backlist (cdr backlist)))  ;;去闭括号<br />   a<br /> )<br /> (defun compute (/ sign datatype1 datatype2 datatype3 datatype4<br />     data1 data2 data3 data4 fawn)     ;;单元计算<br />   (setq N 0)<br />   (setq data1 nil data2 nil data3 nil data4 nil)<br />   (setq sign nil)<br />   (while (and(< N CPleng)(< N 4)(/= sign "sign"))<br />     (setq N (1+ n))<br />     (cond ((= N 1)(setq sign(listword backlist 1 1)      ;;提取单元<br />       datatype1 sign data1(listword backlist 1 2)))<br />     ((= N 2)(setq sign(listword backlist 2 1)<br />       datatype2 sign data2(listword backlist 2 2)))<br />     ((= N 3)(setq sign(listword backlist 3 1)<br />       datatype3 sign data3(listword backlist 3 2)))<br />     ((= N 4)(setq sign(listword backlist 4 1)<br />       datatype4 sign data4(listword backlist 4 2)))<br />     )<br />   )<br />   (if (/= N CPleng)(setq N (1- N)))          ;;;计算单元<br />   (setq CPleng (- CPleng N))                 ;;未计算长度<br />   (repeat N<br />     (setq backlist (cdr backlist))<br />   )                    ;;;未计算数据<br />   ;;(if (/= N 0)(setq result nil))     ;;不进行累计清空上次结果<br />   (cond ((= N 0)(if (= result nil) 0.0 (progn(setq fawn result result T)fawn)))     ;;累计计算<br />         ((= N 1)(if (= datatype1 "Num") data1(statmyerror "函数无参数")))<br />   ((= N 2)(cond((= datatype2 "Num")(functions data1 data2))<br />          ((= datatype1 "Num")(functions2 data1 data2))<br />          (T(statmyerror "函数无参数吗"))))  ;;此情况不可能发生<br />   ((= N 3)(cond((= datatype2 "Num")(functions data1(functions2 data2 data3)))<br />          ((= data2 "^" )(expt data1 data3))))<br />   (T (functions data1 (expt data2 data4)))<br />   )<br /> )<br /> (defun statmyerror (item)      ;;错误统计<br />   (setq myerrorNum (1+ myerrorNum))<br />   (setq myerror(strcat myerror " "(itoa myerrorNum) "." item))<br /> )   <br />   <br /> (defun inspect (datalist / leng N celllist datatype<br />     signNum bracketNum bracket )   ;;数据库错误检验<br /> <br />   (setq funclist'(("SIN")("COS")("TG")("CTG")("ARCTG")("LN")("LOG")<br />       ("SQRT")("!")("^")("D")("C")("L")("PL")))<br />   (setq bracketNum 0 signNum -1)<br />   (setq bracket nil)<br />   (setq leng(length datalist))<br />   (setq N 0)<br />   (repeat leng<br />     (setq celllist (nth N datalist))        ;;单元子列表<br />     (setq N (1+ N))<br />     (setq datatype (car celllist))<br />     (setq data (cadr celllist))<br />     (cond ((= datatype "Lbracket")(setq bracketNum (1+ bracketNum) bracket T))<br />     ((= datatype "Rbracket")(setq bracketNum (1- bracketNum))<br />      (if bracket (progn<br />        (statmyerror"重叠的无用括号")<br />        (setq bracket nil))))<br />     (T (setq bracket nil)))<br />     (if(and(< bracketNum 0)(/= N leng))(statmyerror "错位的右括号"))<br />     (cond ((= datatype "sign")(setq signNum (1+ signNum)))<br />     ((= datatype "Lbracket")(setq signNum 0))<br />     (T (if (> signNum 0)<br />          (statmyerror (strcat(itoa signNum) "个多余运算符"))<br />        )<br />      (setq signNum -1)))<br />     (cond ((= datatype "function")<br />      (setq abc (assoc data funclist))<br />      (if(= (assoc data funclist)nil)<br />             (statmyerror (strcat"未知函数"data))))<br />           ((= data ".")(statmyerror "多余的小数点"))<br />     ((and (= datatype "Num")(or(= data "-")(= data "-.")))(statmyerror "多余的减号"))<br />     ((and(= N leng)(= datatype "sign"))(statmyerror (strcat(itoa (1+ signNum)) "个多余运算符")))<br />   ) <br />   )<br />   (cond ((< bracketNum 0)(statmyerror "多余右括号"))<br />   ((> bracketNum 0)(statmyerror "多余左括号")))<br /> )<br /> <br /> (defun consDB (datalist datatype data / lgc) ;;向数据库添加元素的函数<br />   (if(= datalist "")<br />     (list(list  datatype data))<br />     (progn<br />       (setq lgc (list(list datatype data)))<br />       (append datalist lgc)<br />     )<br />   )<br /> )<br /> (defun letter  (item / fawn)              ;;检测一字符的函数<br />   (setq fawn (ascii item))<br />   (cond ((and(>= fawn 48)(<= fawn 57))"Num")   ;;数<br />   ((= fawn 46)"point")                   ;;小数点<br />   ((or(= fawn 42)(= fawn 43)(= fawn 47))"sign")         ;;+*/号<br />   ((= fawn 45)"minus")                                  ;;负号<br />         ((= fawn 40) "Lbracket")       ;;左括号<br />   ((= fawn 41) "Rbracket")       ;;右括号<br />   (T"function")<br />   )<br /> )<br /> (defun DBS (fawn / N item datatype data mydata lettertype<br />       oldtype olddata addbracket Noatof unite Angunite #sign<br />       savefawn savedatalist savelong point)        ;;建立数据库<br />   (defun correction ()<br />     (if (= data "PI")(setq datatype "Num" data pi Noatof nil)) <br />     (cond ((and(= unite nil)(or (= data "A")(= data "B")(= data "C")))  ;;提取槽钢型号<br />       (setq unite T datatype "Num" data(strcat olddata data)<br />       datalist(reverse datalist)datalist (cdr datalist)<br />       datalist(reverse datalist)))<br />     ((and(= Angunite nil)(/= data "#"))<br />       (setq Noatof nil datatype "Num" data(strcat olddata data)<br />       datalist(reverse datalist)datalist (cdr datalist)<br />       datalist(reverse datalist)#sign T))<br />     ((= data "#")(if Noatof(statmyerror "缺少型钢符号"))<br />       (setq Angunite T datatype "Num" #sign nil Noatof nil))<br />     ((and  (= oldtype "Lbracket")(= data "-"))<br />       (setq datatype "sign"))             ;;处理负号<br />           ((and  (or (= oldtype "Num") (= olddata "!"))     ;;左括号、函数前,智能纠错<br />     (or(= datatype "function")(= datatype "Lbracket")(= datatype "Num"))<br />     (/= data "!") (/= data "^"))<br />       (setq datalist (consDB datalist "sign" "*")))<br />     ((and (= oldtype "Rbracket")(/= datatype "Rbracket")(/= datatype "sign")<br />     (/= data "!") (/= data "^"))  ;;右括号智能纠错<br />       (setq datalist (consDB datalist "sign" "*")))<br />     ((and(= oldtype "function")(/= olddata "!")(= datatype "function");;加左括号<br />          (/= data "!")(/= data "^"))<br />       (setq datalist (consDB datalist "Lbracket" "(")<br />       addbracket (1+ addbracket)))<br />     ((and (/= addbracket 0)<br />     (or (= datatype "Rbracket")(= datatype "sign"))) ;;加闭括号<br />      (repeat addbracket<br />        (setq datalist (consDB datalist "Rbracket" ")" ))<br />      )<br />      (setq addbracket 0))<br />     )                                                     ;;纠错完毕<br />     (if (= unite nil)(setq unite T))<br />     (cond ((and(= oldtype "function")(/= olddata "!")         ;;;sin等函数<br />          (or(= datatype "sign")(= data "!") (= data "^")))<br />       (statmyerror "函数无参数"))<br />     ((and(= oldtype "Lbracket")(or(= data "!") (= data "^"))) ;;;! \等函数<br />       (statmyerror "函数无参数"))<br />     ((and(= oldtype "sign")(= datatype "Rbracket"))(statmyerror "多余运算符"))<br />     ((and(= oldtype "Lbracket")(or(= data "*")(= data "/")))(statmyerror "多余运算符"))<br />     )<br />     (if(and (= olddata "C")(= datatype "Num"))   ;;槽钢<br />       (setq Noatof nil unite nil))<br />     (if(and (= olddata "L")(= datatype "Num"))   ;;角铁<br />       (setq Noatof nil Angunite nil<br />       savefawn fawn savedatalist datalist savelong long))  ;;没有#号下将使用<br />     (setq oldtype datatype olddata data)<br />   )      ;;结束<br />   (setq funclist'(("SIN")("COS")("TG")("CTG")("ARCTG")("LN")("LOG")<br />       ("SQRT")("!")("^")("D")("PL")("Pi")))<br />   (setq addbracket 0)<br />   (setq Noatof T unite T Angunite T)<br />   (setq #sign nil #myerror nil)<br />   (setq fawn (strcase fawn))<br />   (setq long (strlen fawn))         ;;数据长度.必须的<br />   (setq datatype "Num")               ;;单元类型<br />   (while (/= fawn "")<br />     (setq N 0 mydata nil)                       ;;当前字符<br />     (setq point T)<br />     (setq lettertype datatype)        ;;当前字符类型<br />     (while (and (= lettertype datatype) (<= N long)(= mydata nil))   ;;类型不同退出<br />       (setq long (strlen fawn))      ;;计算当前长度<br />       (setq N (1+ N))<br />       (setq item (substr fawn N 1))       ;;提取第N个字符<br />       (setq lettertype(letter item))                     ;;检测第N个字符<br />       (if (and point(= datatype "Num")(= lettertype "point")) ;;小数点是数数字<br />   (setq lettertype "Num" point nil)<br />       )<br />       (if (= lettertype "minus")   ;;处理负号<br />   (if (or(= datatype "sign")(= datatype "function")<br />          (= datatype "Lbracket")) ;;前一单元类型是算术符号等 <br />     (setq lettertype "Num")       ;;当前字符类型是数字<br />     (setq lettertype "sign")      ;;否则字符类型是算术符号<br />   )<br />       )<br />       (if (= N 1)(setq datatype lettertype))  ;;提取第1个字符类型作为单元类型<br />       (setq data (substr fawn 1 (1- n)))      ;;不可缺少!<br />       (setq mydata (assoc data funclist))<br />     )<br />     (if (or(= datatype "sign")(= datatype "Rbracket")<br />      (= datatype "Lbracket"))<br />       (setq N 2))   ;;将运算符限定为一个<br />     (setq data (substr fawn 1 (1- n)))<br />     (if (or(= data "!")(= data "^"))(setq N 2 data (substr fawn 1 1)))<br />     (correction)             ;;;智能纠错<br />     (if (and (= datatype "Num")(/= data "-")(/= data "-.")Noatof)<br />       (setq data (atof data)));;字符转数字<br />     (if (and unite Angunite)(= (setq Noatof T)))<br />     (if (/= data "#")(setq datalist (consDB datalist datatype data)))<br />                    ;;函数  数据库   数据类型  数据 <br />     (if (<= N long)                     ;;提取剩余的数据<br />       (setq fawn (substr fawn   N))<br />       (setq fawn "")                  ;;字符已提完<br />     )<br />     (if (and #sign (= fawn ""))       ;;没有#号下将使用<br />       (setq #sign nil #myerror T Angunite T fawn savefawn oldtype ""  <br />       datalist savedatalist long savelong datatype "function" data "C"))<br />   )<br />   datalist<br /> )<br /> ;;;主程序<br />   ;;(ai_undo_push);;(ai_undo_pop)<br />   (setq result nil)   ;;初始化结果<br />   (setq run T)    ;;继续执行<br />   (while run<br />     (setq oldresult result)  ;;保存旧结果<br />     (setq myerror "")<br />     (setq datalist "")<br />     (setq fawn "")<br />     (setq myerrorNum 0 signNum -1)<br />     (setq fawn (getstring T "\n输入式子:"))<br />     (if (/= fawn "")<br />       (progn<br />         (setq datalist (DBS fawn))  ;;(princ datalist)<br />         (inspect datalist)          ;;检验数据库<br />         (if (= myerror "")<br />     (while(/= datalist nil)<br />       (DBMS datalist)        ;;;提取区间<br />       (setq y (block))         ;;;计算区间<br />       (if(or(/= frontlist nil)(/= backlist nil))   ;;合并<br />         (setq datalist(append frontlist (list(list "Num" y)) backlist))<br />         (setq datalist nil))    <br />     )<br />         )<br />         (if (/= result T)<br />     (princ "结果：")<br />     (progn<br />       (princ "计算:(")<br />       (princ oldresult)<br />       (princ(strcat ")" fawn "\n累计结果："))))<br />   (setq result y)<br />         (if (/= myerror "")<br />     (progn<br />       (princ (strcat"错误" myerror "。"))<br />       (setq result nil)   ;;结果清空<br /> <br />     )<br />     (princ result)<br />   )<br />       )<br />       (setq run nil)<br />     )<br />   )<br />   ;;(ai_undo_pop)<br />   (if(not fawnload)(setq fawnload(princ"\"计算器\"命令 小鹿软件*版权所有")))<br />   (princ)<br /> )

AMTONNY

呵呵，有同感哦，不过解铃还须系铃人，也许只能靠自已了哦

xshrimp

不知道楼主的作用是什么,想要的结果是什么,
如果仅仅修复输入2..7得到2.7?这个?很容易.

fawn_lgc

xshrimp 发表于 2011-12-5 22:03
不知道楼主的作用是什么,想要的结果是什么,
如果仅仅修复输入2..7得到2.7?这个?很容易.

非常感谢你的热心.
我希望输入:  2. .4而应提示输入了多余小数点,不应该有结果.
输入2..4*3也应该没有结果

输入2sin45应该有结果
输入2.sin45应该有结果
输入(.5+2)*3应该有结果
输入3.*(.5+2)应该有结果

也就是说2.识别为2.0 ; 而.5识别为0.5 ; 2(5+3)识别为2*(5+3) ; 2sin45识别为2*sin(45°)
而2..5应提示输入了多余小数点,不应该有结果.

这些问题没能解决.