[LISP程序]：他人编写的cad里面的计算器程序，大家一起完善一下

urljit

[PHP]
(defun c:calc (/         total           val             action    rs_error
               memory         setsqrt   set%             MAXWIDTH  doaction
               setprn         setce           setc             setval    recall
               what_next calc_id
              )

  (defun do_help (cmd)
    (if        (= (type acad_helpdlg) 'LIST)
      (acad_helpdlg "calc.ahp" cmd)
      (alert "找不到求助对话程序-xload acadapp.")
    )
  )

  (defun rs_error ()
    (set_tile "error" "")
  )

  (defun setsqrt (/ wx)
    (rs_error)
    (if        valopen
      (progn
        (if (>= (setq wx (atof val)) 0)
          (set_tile "total" (fixnum (setq val (rtos (sqrt wx) 2 4))))
          (set_tile "error" "非法值!")
        )
      )
      (progn
        (if (>= total 0)
          (set_tile "total"
                    (fixnum (rtos (setq total (sqrt total)) 2 4))
          )
          (set_tile "error" "非法值!")
        )
      )
    )
  )

  (defun setlog        (/ wx)
    (rs_error)
    (if        valopen
      (progn
        (if (> (setq wx (atof val)) 0)
          (set_tile "total"
                    (fixnum (setq val (rtos (/ (log wx) (log 10)) 2 4)))
          )
          (set_tile "error" "非法值!")
        )
      )
      (progn
        (if (> total 0)
          (set_tile
            "total"
            (fixnum (rtos (setq total (/ (log total) (log 10))) 2 4))
          )
          (set_tile "error" "非法值!")
        )
      )
    )
  )

  (defun setsqr        (/ wx)
    (rs_error)
    (setq wx (atof val))
    (if        valopen
      (set_tile "total" (fixnum (setq val (rtos (* wx wx) 2 4))))
      (set_tile        "total"
                (fixnum (rtos (setq total (* total total)) 2 4))
      )
    )
  )

  (defun reciprocal (/ wx)
    (rs_error)
    (if        valopen
      (progn
        (if (= (setq wx (atof val)) 0)
          (set_tile "error" "非法值!")
          (set_tile "total" (fixnum (setq val (rtos (/ 1 wx) 2 4))))
        )
      )
      (progn
        (if (= total 0)
          (set_tile "error" "非法值!")
          (set_tile "total"
                    (fixnum (rtos (setq total (/ 1 total)) 2 4))
          )
        )
      )
    )
  )

  (defun settan        (/ wx)
    (rs_error)
    (setq wx (atof val))
    (if        valopen
      (progn
        (if (= wx 90)
          (set_tile "error" "非法值!")
          (set_tile "total"
                    (fixnum (setq val (rtos (/ (sin (* (/ wx 180) pi))
                                               (cos (* (/ wx 180) pi))
                                            )
                                            2
                                            4
                                      )
                            )
                    )
          )
        )
      )
      (progn
        (if (= total 90)
          (set_tile "error" "非法值!")
          (set_tile "total"
                    (fixnum (rtos (setq        total (/ (sin (* (/ total 180) pi))
                                                 (cos (* (/ total 180) pi))
                                              )
                                  )
                                  2
                                  4
                            )
                    )
          )
        )
      )
    )
  )


  (defun setsin        (/ wx)
    (rs_error)
    (setq wx (atof val))
    (if        valopen
      (set_tile        "total"
                (fixnum (setq val (rtos (sin (* (/ wx 180) pi)) 2 4)))
      )
      (set_tile
        "total"
        (fixnum (rtos (setq total (sin (* (/ total 180) pi))) 2 4))
      )
    )
  )

  (defun setcos        (/ wx)
    (rs_error)
    (setq wx (atof val))
    (if        valopen
      (set_tile        "total"
                (fixnum (setq val (rtos (cos (* (/ wx 180) pi)) 2 4)))
      )
      (set_tile
        "total"
        (fixnum (rtos (setq total (cos (* (/ total 180) pi))) 2 4))
      )
    )
  )


  (defun set% ()
    (rs_error)
    (if        valopen
      (set_tile        "total"
                (fixnum (setq val (rtos (/ (atof val) 100) 2 4)))
      )
      (set_tile        "total"
                (fixnum (rtos (setq total (/ total 100)) 2 4))
      )
    )
  )

  (defun doaction (op)
    (rs_error)
    (if        valopen
      (if (boundp 'action)
        (setq total (apply action (list total (atof val))))
        (setq total (atof val))
      )
    )
    (setq valopen nil)
    (if        (= "=" op)
      (setq action nil)
      (setq action (read op))
    )
    (setq val "")
    (set_tile "total" (fixnum (rtos total 2 4)))
  )

  (defun setce ()
    (rs_error)
    (setq val ""
          valopen nil
    )
    (set_tile "total" (fixnum (rtos total 2 4)))
  )

  (defun setpm ()
    (rs_error)
    (if        valopen
      (progn
        (setq valnum (atof val))
        (if (minusp valnum)
          (setq valnum (abs valnum))
          (setq valnum (- valnum (* valnum 2)))
        )
        (setq val (rtos valnum 2 4))
        (setq val (fixnum val))
        (set_tile "total" val)
      )
      (progn
        (if (minusp total)
          (setq total (abs total))
          (setq total (- total (* total 2)))
        )
        (set_tile "total" (fixnum (rtos total 2 4)))
      )
    )
  )

  (defun setc ()
    (rs_error)
    (setq val ""
          valopen nil
          total        0
    )
    (set_tile "total" (fixnum (rtos total 2 4)))
  )

  (defun setval        (keyval / hasperiod cnt)
    (rs_error)
    (if        (not action)
      (setq total 0)
    )
    (setq valopen T)
    (while (= "c" (substr val 1 1))
      (setq val (substr val 2))
    )
    (setq hasperiod nil
          cnt 1
    )
    (repeat (strlen val)
      (if (= "." (substr val cnt 1))
        (setq hasperiod T)
      )
      (setq cnt (1+ cnt))
    )
    (if        (not (and (= keyval "c.") hasperiod))
      (setq val (strcat val (substr keyval 2 1)))
    )
    (set_tile "total" (fixnump val))
  )

  (defun fpi ()
    (rs_error)
    (if        (not action)
      (setq total 0)
    )
    (setq valopen T)
    (setq val "3.1416")
    (set_tile "total" (fixnum val))
  )

  (defun recall        ()
    (rs_error)
    (setq total memory)
    (setq val ""
          valopen nil
    )
    (set_tile "total" (fixnum (rtos total 2 4)))
  )

  (defun memdec        ()
    (rs_error)
    (setq val ""
          valopen nil
    )
    (setq memory (- memory (read (get_tile "total"))))
    (set_tile "total" (fixnum (rtos total 2 4)))
  )

  (defun meminc        ()
    (rs_error)
    (setq val ""
          valopen nil
    )
    (setq memory (+ memory (read (get_tile "total"))))
    (set_tile "total" (fixnum (rtos total 2 4)))
  )

  (defun fixnum        (txt)
;;;    (while (= "0" (substr txt (strlen txt) 1))
    (while (= "0" (substr txt 1 1))
      (setq txt (substr txt 1 (1- (strlen txt))))
    )
    (if        (and (/= txt "") (= "." (substr txt (strlen txt) 1)))
      (setq txt (substr txt 1 (1- (strlen txt))))
    )
    (while (< (strlen txt) MAXWIDTH)
      (setq txt (strcat " " txt))
    )
    txt
  )

  (defun fixnump (txt)
    (while (< (strlen txt) MAXWIDTH)
      (setq txt (strcat " " txt))
    )
    txt
  )
;;; Main programe begain
  (setvar "cmdecho" 0)
  (setq        total 0
        memory 0
        val ""
        action nil
        MAXWIDTH 42
  )
  (if
    (and (not calc_id)
         (< (setq
              calc_id (load_dialog "calc.dcl"
                      )
            )
            0
         )
    )
     (exit)
  )
  (setq what_next 5)
  (while (< 2 what_next)
    (if        (not (new_dialog "calc" calc_id))
      (exit)
    )
    (set_tile "error" "改编：小河弯弯")
    (action_tile "sin" "(setsin)")
    (action_tile "cos" "(setcos)")
    (action_tile "tan" "(settan)")
    (action_tile "log" "(setlog)")
    (action_tile "c" "(setc)")
    (action_tile "%" "(set%)")
    (action_tile "sqr" "(setsqr)")
    (action_tile "sqrt" "(setsqrt)")
    (action_tile "plusminus" "(setpm)")
    (action_tile "reciprocal" "(reciprocal)")
    (foreach
              tile
                  '("+" "-" "*" "/" "=")
      (action_tile tile "(doaction $key)")
    )
    (action_tile "kpi" "(fpi)")
    (action_tile "ce" "(setce)")
    (foreach
              tile
              '("c1" "c2" "c3" "c4" "c5" "c6" "c7" "c8" "c9" "c0" "c.")
      (action_tile tile "(setval $key)")
    )
    (action_tile "accept" "(done_dialog 1)")
    (action_tile "help" "(do_help \"calc\")")
    (if        (/= what_next 4)
      (setq what_next (start_dialog)
            )
    )
  )
  total
  (princ)
)
(princ "\n计算器程序安装完毕,键入calc便可使用\n")
(princ)
[/PHP]
[PHP]
calc:dialog{
   label="十进制计算器";
   :column{
      fixed_width=true;
      width=30;
      :edit_box{
         key="total";
         is_enabled=false;
      }
      :row{
         :retirement_button{
            key="sin";
            label="SIN";
         }
         :retirement_button{
            key="cos";
            label="COS";
         }
         :retirement_button{
            key="tan";
            label="TAN";
         }
         :retirement_button{
            key="log";
            label="LOG";
         }
         :retirement_button{
            key="c";
            label="C";
            mnemonic = "C";
         }
      }
      :row{
         :retirement_button{
            key="plusminus";
            label="+/-";
         }
         :retirement_button{
            key="reciprocal";
            label="1/X";
         }
         :retirement_button{
            key="sqr";
            label="SQR";
         }
         :retirement_button{
            key="kpi";
            label="PI";
         }
         :retirement_button{
            key="ce";
            label="CE";
            mnemonic = "E";
         }
      }
      :row{
              :retirement_button{
            label="M+";
            key="m+";
              }
              :retirement_button{
            label="M-";
            key="m-";
              }
              :retirement_button{
            label="MS";
            key="ms";
              }
              :retirement_button{
            label="MR";
            key="mr";
              }
              :retirement_button{
            label="MC";
            key="mc";
              }
      }
      spacer;
      :row{
         :retirement_button{
            key="c7";
            label="7";
            mnemonic = "7";
         }
         :retirement_button{
            key="c8";
            label="8";
            mnemonic = "8";
         }
         :retirement_button{
            key="c9";
            label="9";
            mnemonic = "9";
         }
         :retirement_button{
            key="/";
            label="/";
            mnemonic = "/";
         }
         :retirement_button{
            key="sqrt";
            label="SQT";
         }
      }
      :row{
         :retirement_button{
            key="c4";
            label="4";
            mnemonic = "4";
         }
         :retirement_button{
            key="c5";
            label="5";
            mnemonic = "5";
         }
         :retirement_button{
            key="c6";
            label="6";
            mnemonic = "6";
         }
         :retirement_button{
            key="*";
            label="*";
            mnemonic = "*";
         }
         :retirement_button{
            key="%";
            label="%";
            mnemonic = "%";
         }
      }
      :row{
         :retirement_button{
            key="c1";
            label="1";
            mnemonic = "1";
         }
         :retirement_button{
            key="c2";
            label="2";
            mnemonic = "2";
         }
         :retirement_button{
            key="c3";
            label="3";
            mnemonic = "3";
         }
         :retirement_button{
            key="-";
            label="-";
            mnemonic = "-";
         }
         :help_button{
            label="HLP";
         }
      }
      :row{
         :retirement_button{
            key="c.";
            label=".";
            mnemonic = ".";
         }
         :retirement_button{
            key="c0";
            label="0";
            mnemonic = "0";
         }
         :retirement_button{
            key="=";
            label="=";
            mnemonic = "=";
            is_default = true;
            allow_accept= true;
         }
         :retirement_button{
            key="+";
            label="+";
            mnemonic = "+";
         }
         :cancel_button{
            label="OFF";
            mnemonic = "O";
         }
      }
      errtile;
   }
}
[/PHP]

梦断江南

精神可嘉，但是写一个这样的程序值得么？放着那么多的计算器软件不用？

JOSDENNIS

我下了, 玩玩, 好有意思, 不過寫這個要應用才寫, 請教一下樓主應用在哪方面哦.

urljit

大家来练练手吧。反正我在这个程序里学习到了从前不会的东东。

hyx_lyn

有一个问题，在响应键盘的时候，5和%、8和*、+和=交替出现

在上部出现的文字是灰色的不显眼

urljit

回复楼上：
第一个问题我不知道怎样解决，可能是程序识别键盘按键有问题。
第二个问题是我设置的，否则会对键盘的操作不敏感。

pgy003

我想学AutoLisp，不知那有一些教程

urljit

楼上的朋友学autolisp可以用R14的帮助呀。

silen618

其实还可以直接在命令行输入CALC即可调用系统资源。
或者在菜单中加入
[计算器]^C^C^P(STARTAPP "Calc.exe")(PRINC)
即可。

xcajcj

还是觉得调用系统自带的计算器好一些，计算完后将结果复制粘贴在CAD里就行了。

shongdragon3

呵呵，精神可嘉！~

zhouz200

计算我一般都是用EXCEL，可以批量计算啊

wang5748

我下好了！试过有问题，
]能解决一下在发上来么！！
见图===========》

自由的鱼

MY GOD，太复杂了！！

urljit

最初由 wang5748 发布
[B]我下好了！试过有问题，
]能解决一下在发上来么！！
见图===========》 [/B]

学学怎样调试吧，在vl的编辑器里面，可以看帮助的。