[求助]：这是我在一本书上找到的LISP程序

dgh

这是我在一本书上找到的LISP程序，可以在画矩形的同时显示出边长和面积，不过这个程序和我预想的有一些差别，我想边长的单位应是毫米，面积的单位应是平方米。这样符合建筑绘图习惯，另外如果能同时绘出墙厚，显示出轴线面积和使用面积，就是一个非常好的草图绘制工具了。 哪位高手帮忙改一下谢谢！

2. 
   
3. 
   
4. (defun DRAWBOX (PT1 PT2 / PT3 PT4)
   
5.   (grdraw PT1
   
6.   (setq PT3 (list (car PT2) (cadr PT1)))
   
7.   -1
   
8.   )
   
9.   (grdraw PT1
   
10.   (setq PT4 (list (car PT1) (cadr PT2)))
    
11.   -1
    
12.   )
    
13.   (grdraw PT3 PT2 -1)
    
14.   (grdraw PT4 PT2 -1)
    
15. )
    
16. (defun C:ROOM (/ LLP P LOOP URP SOURCE PT LRP ULP)
    
17.   (initget 1)
    
18.   (setq LLP  (getpoint "\nFirst point :")
    
19. URP  LLP
    
20. LOOP t
    
21.   )
    
22.   (DRAWBOX LLP URP)
    
23.   (prompt "\nScond point :")
    
24.   (while LOOP
    
25.     (setq URP1 (grread t 1 0))
    
26.     (setq SOURCE (car URP1)
    
27.   PT (cadr URP1)
    
28.     )
    
29.     (cond
    
30.       ((and (= SOURCE 5)
    
31.     (or (/= (car URP) (car PT))
    
32. (/= (cadr URP) (cadr PT))
    
33.     )
    
34.        )
    
35.        (progn
    
36. (DRAWBOX LLP URP)
    
37. (setq W (- (car URP) (car LLP)))
    
38. (setq L (- (cadr URP) (cadr LLP)))
    
39. (setq SM (* (/ W 10.0) (/ L 10.0)))
    
40. (setq X (strcat (rtos (abs (/ W 10)) 2 1)
    
41. "cm*"
    
42. (rtos (abs (/ L 10)) 2 1)
    
43. "cm 面积= "
    
44. (rtos (abs SM) 2 2)
    
45. "cm^2"
    
46. )
    
47. )
    
48.            ;;(grtext 1 X)
    
49. (setvar "MODEMACRO" X)
    
50.        )
    
51.        (DRAWBOX LLP PT)
    
52.        (setq URP PT)
    
53.       )
    
54.       ((or (= SOURCE 3)
    
55.    (and (= SOURCE 2) (or (= PT 13) (= PT 32)))
    
56.        )
    
57.        (DRAWBOX LLP URP)
    
58.        (setq LOOP NIL)
    
59.       )
    
60.     )
    
61.   )
    
62.   (setq LRP (list (car URP) (cadr LLP)))
    
63.   (setq ULP (list (car LLP) (cadr URP)))
    
64.   (command "pline" LLP LRP URP ULP "c")
    
65. )

<br /> <br /> (defun DRAWBOX (PT1 PT2 / PT3 PT4) <br />   (grdraw PT1 <br />   (setq PT3 (list (car PT2) (cadr PT1))) <br />   -1 <br />   ) <br />   (grdraw PT1 <br />   (setq PT4 (list (car PT1) (cadr PT2))) <br />   -1 <br />   ) <br />   (grdraw PT3 PT2 -1) <br />   (grdraw PT4 PT2 -1) <br /> ) <br /> (defun C:ROOM (/ LLP P LOOP URP SOURCE PT LRP ULP) <br />   (initget 1) <br />   (setq LLP  (getpoint "\nFirst point :") <br /> URP  LLP <br /> LOOP t <br />   ) <br />   (DRAWBOX LLP URP) <br />   (prompt "\nScond point :") <br />   (while LOOP <br />     (setq URP1 (grread t 1 0)) <br />     (setq SOURCE (car URP1) <br />   PT (cadr URP1) <br />     ) <br />     (cond <br />       ((and (= SOURCE 5) <br />     (or (/= (car URP) (car PT)) <br /> (/= (cadr URP) (cadr PT)) <br />     ) <br />        ) <br />        (progn <br /> (DRAWBOX LLP URP) <br /> (setq W (- (car URP) (car LLP))) <br /> (setq L (- (cadr URP) (cadr LLP))) <br /> (setq SM (* (/ W 10.0) (/ L 10.0))) <br /> (setq X (strcat (rtos (abs (/ W 10)) 2 1) <br /> "cm*" <br /> (rtos (abs (/ L 10)) 2 1) <br /> "cm 面积= " <br /> (rtos (abs SM) 2 2) <br /> "cm^2" <br /> ) <br /> ) <br />            ;;(grtext 1 X) <br /> (setvar "MODEMACRO" X) <br />        ) <br />        (DRAWBOX LLP PT) <br />        (setq URP PT) <br />       ) <br />       ((or (= SOURCE 3) <br />    (and (= SOURCE 2) (or (= PT 13) (= PT 32))) <br />        ) <br />        (DRAWBOX LLP URP) <br />        (setq LOOP NIL) <br />       ) <br />     ) <br />   ) <br />   (setq LRP (list (car URP) (cadr LLP))) <br />   (setq ULP (list (car LLP) (cadr URP))) <br />   (command "pline" LLP LRP URP ULP "c") <br /> )

zero

你讲的第二个要求好像比较麻烦，第一个要求的话改一下就很简单了。
找到这一段改成下面的就行了
(progn
(DRAWBOX LLP URP)
(setq W (- (car URP) (car LLP)))
(setq L (- (cadr URP) (cadr LLP)))
(setq SM (* (/ W 1000.0) (/ L 1000.0)))
(setq X (strcat (rtos (abs  W) 2 1)
"mm*"
(rtos (abs L) 2 1)
"mm 面积= "
(rtos (abs SM) 2 2)
"m^2"
)

偷了下懒，没有验证，你试一下吧：）

dgh

谢谢！挺好用的。