哪位朋友能帮我写一个LISP小程序，就是在CAD中抓取一个矩形的对角点，计算出其面积

寒风

就是在CAD中选择两个点计算出来的啊。

meflying

2. (setq filename (strcat (getenv "TMP") "paramseting_by_meflying.ini"))
3. (defun Getxxx(fun msg def / val def2)
4.    (if def
5.        (progn
6.            (if (/= (type def) 'STR) (setq def2 (rtos def)))
7.            (setq val (fun (strcat msg "<" def2 ">:")))
8.            (if (or (not val) (= val "")) def val)
9.        )
10.        (fun (strcat msg ":"))
11.    )
12. )
13. (defun c:set( / f hei xs gap)
14.    (if (findfile filename)
15.        (progn
16.            (setq f (open (findfile filename) "r"))
17.            (setq hei (atof (read-line f)))
18.            (setq xs (atoi (read-line f)))
19.            (setq gap (atof (read-line f)))
20.            (close f)
21.        )
22.    )
23.    (setq hei (getxxx getreal "\n字体大小" hei))
24.    (setq xs (getxxx getint "\n保留小数位数" xs))
25.    (setq gap (getxxx getreal "\n文本间隔" gap))
26.    (setq f (open filename "w"))
27.    (mapcar '(lambda(e) (write-line (rtos e) f)) (list hei xs gap))
28.    (close f)
29.    (princ "\n设置完成!键入 TT 运行程序。")
30.    (princ)
31. )
32. (defun c:TT( / val f hei xs gap pts pts pt2 pt2 len wid os)
33.    (if (not (findfile filename))
34.        (progn
35.            (initget "S X")
36.            (setq val (getkword "\n未设置参数![设置(S)/退出(X)]<退出>:"))
37.            (if (not val) (setq val "X"))
38.            (if (= val "S") (c:set))
39.        )
40.    )
41.    (if (/= val "X")
42.        (progn
43.            (setq f (open (findfile filename) "r"))
44.            (setq hei (atof (read-line f)))
45.            (setq xs (atoi (read-line f)))
46.            (setq gap (atof (read-line f)))
47.            (close f)           
48.            (prompt (apply 'strcat (list "\n字高=" (rtos hei) ", 保留小数位=" (rtos xs) ", 文本间隔=" (rtos gap))))
49.            (setq pts (getpoint "\n选择文本其始点:"))
50.            (if pts
51.   (progn
52.      (while (and (setq pt1 (getpoint "\n选择第一点:")) (setq pt2 (getcorner pt1 "\n选择第二点:")))
53.          (setq len (/ (abs (- (car pt1) (car pt2))) 1000))
54.          (setq wid (/ (abs (- (cadr pt1) (cadr pt2))) 1000))
55.          (setq os (getvar "osmode"))
56.          (setvar "osmode" 0)
57.          (command "_.text" pts 1000  "" (strcat (rtos len 2 xs) "   x   " (rtos wid 2 xs) "   =   " (rtos (* len wid) 2 xs)))
58.          (setvar "osmode" os)
59.          (setq pts (polar pts (* 1.5 pi) gap))
60.      );while
61.   );progn
62.            );if
63.             
64.        )
65.    )
66.    (princ)
67. )

(setq filename (strcat (getenv "TMP") "paramseting_by_meflying.ini")) (defun Getxxx(fun msg def / val def2)    (if def        (progn            (if (/= (type def) 'STR) (setq def2 (rtos def)))            (setq val (fun (strcat msg "<" def2 ">:")))            (if (or (not val) (= val "")) def val)        )        (fun (strcat msg ":"))    ) ) (defun c:set( / f hei xs gap)    (if (findfile filename)        (progn            (setq f (open (findfile filename) "r"))            (setq hei (atof (read-line f)))            (setq xs (atoi (read-line f)))            (setq gap (atof (read-line f)))            (close f)        )    )    (setq hei (getxxx getreal "\n字体大小" hei))    (setq xs (getxxx getint "\n保留小数位数" xs))    (setq gap (getxxx getreal "\n文本间隔" gap))    (setq f (open filename "w"))    (mapcar '(lambda(e) (write-line (rtos e) f)) (list hei xs gap))    (close f)    (princ "\n设置完成!键入 TT 运行程序。")    (princ) ) (defun c:TT( / val f hei xs gap pts pts pt2 pt2 len wid os)    (if (not (findfile filename))        (progn            (initget "S X")            (setq val (getkword "\n未设置参数![设置(S)/退出(X)]<退出>:"))            (if (not val) (setq val "X"))            (if (= val "S") (c:set))        )    )    (if (/= val "X")        (progn            (setq f (open (findfile filename) "r"))            (setq hei (atof (read-line f)))            (setq xs (atoi (read-line f)))            (setq gap (atof (read-line f)))            (close f)                       (prompt (apply 'strcat (list "\n字高=" (rtos hei) ", 保留小数位=" (rtos xs) ", 文本间隔=" (rtos gap))))            (setq pts (getpoint "\n选择文本其始点:"))            (if pts   (progn      (while (and (setq pt1 (getpoint "\n选择第一点:")) (setq pt2 (getcorner pt1 "\n选择第二点:")))          (setq len (/ (abs (- (car pt1) (car pt2))) 1000))          (setq wid (/ (abs (- (cadr pt1) (cadr pt2))) 1000))          (setq os (getvar "osmode"))          (setvar "osmode" 0)          (command "_.text" pts 1000  "" (strcat (rtos len 2 xs) "   x   " (rtos wid 2 xs) "   =   " (rtos (* len wid) 2 xs)))          (setvar "osmode" os)          (setq pts (polar pts (* 1.5 pi) gap))      );while   );progn            );if                     )    )    (princ) )

寒风

太好了，太谢谢你了。但是你好象没有转换成米为单位来表示。能帮我转一下吗？

meflying

已在12楼改好，输出以米为单位，设置中的字高，字间距仍然以毫米为单位

寒风

meflying发表于2004-11-29 12:40:00已在12楼改好，输出以米为单位，设置中的字高，字间距仍然以毫米为单位

谢谢，完全符合要求。

bai2000

这个程序好，就是多次选择图形的“长*宽=值 ”  不能自动的换行，哪位朋友给改改

bai2000

顶起来