[求助]：帮改一个lisp程序

degucn · 发表于 2008-5-5 16:46:25

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

(defun C:TTA(/ oldos sel len dataarea count e1 dat sumarea allarea pt)
(setq olderr *error*)
(setq *error* myerr)
(setvar "cmdecho" 0)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq sel (ssget))
(setq floor (GETINT "\n输入层数（整数）:"))
(setq len (sslength sel))
(setq dataarea nil)
(setq count 0)
(while (< count len)
  (setq e1 (entget (ssname sel count)))
  (if (=  "TEXT" (cdr (assoc 0 e1)))
(progn
(setq dat (cdr (assoc 1 e1)))
(setq dataarea (append (list (atof dat)) dataarea))
)
  )
  (setq count (+ 1 count))
)
;;;;
(setq sumarea 0)
(setq len (length dataarea))
(setq count 0)
(while (< count len)
  (setq dat (car dataarea))
  (setq dataarea (cdr  dataarea))
  (setq sumarea (+ sumarea dat))
  (setq count (+ 1 count))
)
(setq allarea (* floor sumarea))
(setq allarea (rtos allarea 2 2))
(setq sumarea (rtos sumarea 2 2))
;;;;
(setq pt (getpoint "\nPick point:"))
(command "text" pt "" "" (strcat "基底面积(" (rtos floor 2 0) "层):"))
(setq mm (entget (entlast)))
(setq old (assoc 8 mm))
(setq mm (subst (cons 8 "00") old mm))
(entmod mm)
(command "text" (list (+ (* 9 (getvar "textsize"))(car pt)) (cadr pt)) "" "" sumarea)
(setq pt1 (list (car pt) (- (cadr pt) (* 1.2 (getvar "textsize")))))
(setq mm (entget (entlast)))
(setq old (assoc 8 mm))
(setq mm (subst (cons 8 "00") old mm))
(entmod mm)
(command "text" pt1 "" "" (strcat "建筑面积(" (rtos floor 2 0) "层):"))
(setq mm (entget (entlast)))
(setq old (assoc 8 mm))
(setq mm (subst (cons 8 "00") old mm))
(entmod mm)
(command "text" (list (+ (* 9(getvar "textsize"))(car pt1)) (cadr pt1)) "" "" allarea)
(setq mm (entget (entlast)))
(setq old (assoc 8 mm))
(setq mm (subst (cons 8 "00") old mm))
(entmod mm)
(setvar "osmode" oldos)
(setvar "cmdecho" 1)
(setq *error* olderr)
(princ)
)

里面要求输入的层数为"整数"能不能改成不一定是整数

Underway · 发表于 2008-5-5 17:51:49

(setq floor (GETINT "\n输入层数（整数）:"))
....
(setq allarea (* floor sumarea)) ; 此处相乘 floor 必需是数值
....
(command "text" pt "" "" (strcat "基底面积(" (rtos floor 2 0) "层):"))
....
(command "text" pt1 "" "" (strcat "建筑面积(" (rtos floor 2 0) "层):"))

改成不一定是整数
比如说呢?

firstintimate · 发表于 2008-5-5 18:12:47

getint->getreal

sfjlx · 发表于 2008-5-5 21:05:51

这个程序是做什么的啊？

degucn · 发表于 2008-5-11 11:58:16

这是个算面积的程序,它每次都要输入一个整数才能相乘,能不能不输入整数
如:基底1000m2,7层,输入7,它就会把1000X7
但如果是7.5层,就没办法输入7.5,只能输入75,算出后,自己再去掉一位数

zml84 · 发表于 2008-5-12 23:27:27

3 楼已经给出答案。 getint->getreal

账号		自动登录	找回密码
密码			立即注册

[求助] [求助]：帮改一个lisp程序

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子