菜菜鸟求旧

ffast · 发表于 2004-8-26 16:37:00

刚开始学LISP，下面自编的程序怎么也运行不了，一个加减法，求救，多谢！
(defun c:jj()
   (prompt "select objects: ")
   (setq ss (ssget))
   (setq n 0)
   (repeat (sslength ss)
   (setq en (ssname ss n))
   (setq endata (entget en))
   (if (= (cdr (assoc 0 en)) "TEXT")
   (progn
   (setq oldt (cdr (assoc 1 endata)))
   (setq tt (getreal (strcat "\nAdd:")))
   (setq newt (+ old tt))
   (setq newlist (cons 1 newt))
   (setq endata (subst newlist (assoc 1 endata) endata))
   (entmod endata)
   )
   )
   (setq n (1+ n))
   )
   (prin1)
)

BDYCAD · 发表于 2004-8-26 17:05:00

(defun c:jj(/ ss n en endata oldt tt newt newlist )
   (prompt "select objects: ")
   (setq ss (ssget))
   (setq n 0)
   (repeat (sslength ss)
   (setq en (ssname ss n))
   (setq endata (entget en))
   (if (= (cdr (assoc 0 endata)) "TEXT")
   (progn
   (setq oldt (atof(cdr (assoc 1 endata))))
   (setq tt (getreal (strcat "\nAdd:")))
   (setq newt (+ oldt tt))
   (setq newlist (cons 1 (rtos newt)))
   (setq endata (subst newlist (assoc 1 endata) endata))
   (entmod endata)
   )
   )
   (setq n (1+ n))
   )
   (prin1)
)

citykunan · 发表于 2004-8-26 17:08:00

;粗略的改了一下，还要完善一点。 (defun c:jj( / SS N EN ENDATA OLDT    tt NEWT    NEWLIST)
   (prompt "select objects: ")
   (setq ss (ssget '((0 . "TEXT"))))
   (setq    tt    (getreal "\nAdd:"))
   (setq n 0)
   (repeat (sslength ss)
   (setq en (ssname ss n))
   (setq endata (entget en))
   ; (if (= (cdr (assoc 0 en)) "TEXT")
   (progn
   (setq oldt (atof (cdr (assoc 1 endata))))
   ; (setq    tt    (getreal "\nAdd:"))
   (setq newt (rtos (+ oldt tt) 2))
   (setq newlist (cons 1 newt))
   (setq endata (subst newlist (assoc 1 endata) endata))
   (entmod endata)
   )
   ; )
   (setq n (1+ n))
   )
   (prin1)
)
sorry回帖的时候没看到包版主已经回了。：）

ffast · 发表于 2004-8-26 18:07:00

谢谢各位！
还有个问题，能帮助解决吗？现在程序可以使用了，但为什么使用后得出的结果小数全是4位？有没有解决的方法？原来3位，我现在还想要3位！另外，比如说第一个数加了0.2，但第二次还要再输入0.2，要是我要同时修改1000个数字，那该怎么办啊？
多谢帮助！

gaba · 发表于 2004-8-26 18:17:00

(rtos str 2 number)

ffast · 发表于 2004-8-26 18:20:00

不好意思，citykunan这位仁兄，已经解决了第二个问题，刚才买看到！
谢谢！

梁旭武 · 发表于 2004-8-26 18:27:00

这些是我编来自己用的，如果你做的工也像我一样，可能有用吧
(defun c:gg()
(setvar "cmdecho" 0)
(princ"\*********相加程序**********")
(setq a(ssget '((0 . "TEXT"))))
(setq i 0 sum 0)
(repeat (sslength a)
(setq b (ssname a i))
(setq c(entget b))
(setq d(assoc 1 c))
(setq da (atof(cdr d)))
( if (/= da 0)
( setq sum (+ sum da))
)
(setq i (1+ i))
)
(command "layer" "on" "*" "" )
(setq f(getpoint '(10000000 1000000000)))
(setvar "cecolor" "90")
(command "text" f 3 0 (rtos sum))
(setvar "cecolor" "bylayer")
)

(defun c:gg1()
(princ"\*********相乘程序**********")
(setvar "cmdecho" 0)
(setq a(ssget '((0 . "TEXT"))))
(setq i 0 sum 1)
(repeat (sslength a)
(setq b (ssname a i))
(setq c(entget b))
(setq d(assoc 1 c))
(setq da (atof(cdr d)))
( if (/= da 0)
( setq sum (* sum da))
)
(if (= da 0)
(setq sum 0)
)
(setq i (1+ i))
)
(setq f(getpoint '(10000000 1000000000)))
(setvar "cecolor" "90")
(command "text" f 3 0 (rtos sum))
(setvar "cecolor" "bylayer")
)

(defun c:gg2()
(princ"\*********相除程序**********")
(setvar "cmdecho" 0)
(setq a(ssget '((0 . "TEXT"))))
(setq b1 (ssname a 0))
(setq c1(entget b1))
(setq d1(assoc 1 c1))
(setq sum(atof(cdr d1)))
(setq i 1    )
(setq n(sslength a))
(repeat (- n 1)
(setq b (ssname a i))
(setq c(entget b))
(setq d(assoc 1 c))
(setq da (atof(cdr d)))
( if (/= da 0)
( setq sum (/ sum da))
)
(setq i (1+ i))
)
(setq f(getpoint '(10000000 1000000000)))
(setvar "cecolor" "90")
(command "text" f 3 0 (rtos sum))
(setvar "cecolor" "bylayer")
)

(defun c:gg3()
(princ"\*********相减程序**********")
(setvar "cmdecho" 0)
(setq a(ssget '((0 . "TEXT"))))
(setq b1 (ssname a 0))
(setq c1(entget b1))
(setq d1(assoc 1 c1))
(setq sum(atof(cdr d1)))
(setq i 1    )
(setq n(sslength a))
(repeat (- n 1)
(setq b (ssname a i))
(setq c(entget b))
(setq d(assoc 1 c))
(setq da (atof(cdr d)))
( if (/= da 0)
( setq sum (- sum da))
)
(setq i (1+ i))
)
(setq f(getpoint '(10000000 1000000000)))
(setvar "cecolor" "90")
(command "text" f 3 0 (rtos sum))
(setvar "cecolor" "bylayer")
)
(defun c:jjj()
(princ"\键盘输入数字加法计算器")
(setq a(getreal"\n输入第一个数:"))
(setq sun 0)
(while a
   (setq sun(+ sun a))
(setq a(getreal"\n输入下一个数:"))
   )
(princ"\面积放在")
(setq f(getpoint '(10000000 1000000000)))
(command "text" f 2 0 (rtos sun))
)

ffast · 发表于 2004-8-27 09:44:00

谢谢大家

菜菜鸟求旧

发表回复

精选推荐