本人前几天找到一个计算单行文字的用LISP语言编的可实现+、-、*、/的程序,求和的功能试过了,其余的没试。加载后从命令行输入JS就行了,代码如下:
(defun *error* (ERROR) (princ "error:") (princ "CAO ZUO ERROE") (PRINC "\n please try a time") ) (defun getss(/ SS N I NAME0 NAME X0 X1) (INITGET (+ 1 2 4)) (setq ss (ssget '((0 . "TEXT")))) (if (= ss nil) (setq ss (ssadd))) (setq ssa (ssadd)) (while (/= (setq n (sslength ss)) 0) (progn (setq i 1) (setq name0 (ssname ss 0)) (setq x0 (caddr (assoc 10 (entget name0)))) (while (< i n) (progn (setq name (ssname ss i)) (setq X1 (caddr (assoc 10 (entget name)))) (if (< X0 X1) (progn (setq name0 name) (setq X0 X1) )) (setq i (+ 1 i)) )) (setq ssa (ssadd name0 ssa)) (setq ss (ssdel name0 ss)) )) )
(DEFUN C:JS(/ NN II ENT NAME TXT PP P0 PP0 NAME1 P ST ZH ZW ANG I N W TEMP) (SETVAR "BLIPMODE" 0) (SETVAR "CMDECHO" 0) (PROMPT "\n FIRST-SSGET:") (INITGET (+ 1 2 4)) (getss) (SETQ SS1 ssa) (PROMPT "\n SECOND-SSGET:") (getss) (SETQ SS2 ssa) (INITGET (+ 1 2 4)) (IF (= (SSLENGTH SS2) 0) (SETQ JSF (GETSTRING "\n JI SUAN FU:?<+> ")) (SETQ JSF (GETSTRING "\n JI SUAN FU:?<*> "))) (WHILE (AND (/= JSF "+") (/= JSF "-") (/= JSF "*") (/= JSF "/") (/= JSF "")) (GETSTRING "\n JI SUAN FU:?<*> ")) (IF (AND (= (SSLENGTH SS2) 0) (= JSF "")) (SETQ JSF "+")) (IF (AND (/= (SSLENGTH SS2) 0) (= JSF "")) (SETQ JSF "*")) (SETQ P0 (CDR (ASSOC 10 (ENTGET (SSNAME SS1 0))))) (INITGET (+ 1 2 4)) (SETQ PP0 (GETPOINT "\n TEXT-POINT:?")) (SETVAR "BLIPMODE" 0) (IF (= (SSLENGTH SS2) 0) (PROGN (SETQ XI (GETREAL "\n XU CHU DE XI SHU [/] :?<1>")) (IF (= XI NIL) (SETQ XI 1))) (PROGN (SETQ XI (GETREAL "\n XU CHU DE XI SHU [/]:? <100>")) (IF (= XI NIL) (SETQ XI 100)) ))
(SETQ WS (GETINT "\n XIAO SHU WEI:?<2> ")) (IF (= WS NIL) (SETQ WS 2)) (SETQ NN1 (SSLENGTH SS1)) (SETQ II 0) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (IF (= (SSLENGTH SS2) 0)(PROGN (WHILE (< II NN1) (SETQ ENT1 (ENTGET (SETQ NAME1 (SSNAME SS1 II)))) (IF (= II 0) (SETQ NAME0 NAME1)) (SETQ TXT1 (CDR (ASSOC 1 ENT1))) (SETQ TXT1 (ATOF TXT1)) (IF (= II 0) (SETQ TXT TXT1)) (IF (/= II 0) (PROGN (COND ((= JSF "+") (SETQ TXT (+ TXT TXT1))) ((= JSF "-") (SETQ TXT (- TXT TXT1))) ((= JSF "*") (SETQ TXT (* TXT TXT1))) ((= JSF "/") (SETQ TXT (/ TXT TXT1))) ) )) (SETQ II (+ II 1)) ) (COMMAND "COPY" NAME0 "" P0 PP0) (SETQ TXT (/ TXT XI)) (SETQ TXT (RTOS TXT 2 WS)) (setq txt-style (cdr (assoc 7 (entget name0)))) (setq style-higth (cdr (assoc 40 (tblsearch "style" txt-style)))) (if (= style-higth 0.0) (COMMAND "CHANGE" "L" "" "" "" "" "" "" TXT ) (command "change" "l" "" "" "" "" "" txt)) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (IF (AND (/= SS2 NIL) (/= SS1 NIL)) (PROGN (SETQ NN2 (SSLENGTH SS2)) (IF (>= NN1 NN2) (SETQ NN NN2) (SETQ NN NN1)) (WHILE (< II NN) (SETQ ENT1 (ENTGET (SETQ NAME1 (SSNAME SS1 II)))) (SETQ ENT2 (ENTGET (SETQ NAME2 (SSNAME SS2 II)))) (SETQ TXT1 (CDR (ASSOC 1 ENT1))) (SETQ TXT2 (CDR (ASSOC 1 ENT2))) (SETQ TXT1 (ATOF TXT1)) (SETQ TXT2 (ATOF TXT2)) (COND ((= JSF "+") (SETQ TXT (+ TXT1 TXT2))) ((= JSF "-") (SETQ TXT (- TXT1 TXT2))) ((= JSF "*") (SETQ TXT (* TXT1 TXT2))) ((= JSF "/") (SETQ TXT (/ TXT1 TXT2))) ) (COMMAND "COPY" NAME1 "" P0 PP0) (SETQ TXT (/ TXT XI)) (SETQ TXT (RTOS TXT 2 WS)) (setq txt-style (cdr (assoc 7 (entget name1)))) (setq style-higth (cdr (assoc 40 (tblsearch "style" txt-style)))) (if (= style-higth 0.0) (COMMAND "CHANGE" "L" "" "" "" "" "" "" TXT ) (command "change" "l" "" "" "" "" "" txt)) (SETQ II (+ II 1)) ) )) (SETVAR "BLIPMODE" 0) (SETVAR "CMDECHO" 0) (PRINC) ) (DEFUN C:TCH(/ SS NN II ENT NAME TXT PP0 P0 P XI JSF WS) (SETVAR "BLIPMODE" 0) (SETVAR "CMDECHO" 0) (INITGET (+ 1 2 4)) (GETSS) (SETQ SS SSA) (INITGET (+ 1 2 4)) (SETQ JSF (GETSTRING "\n JI SUAN FU:?<*> ")) (WHILE (AND (/= JSF "+") (/= JSF "-") (/= JSF "*") (/= JSF "/") (/= JSF "")) (GETSTRING "JI SUAN FU:?<*> ")) (IF (= JSF "") (SETQ JSF "*")) (SETQ XI (GETREAL "\n XI SHU:?")) (SETQ P0 (CDR (ASSOC 10 (ENTGET (SSNAME SS 0))))) (SETVAR "BLIPMODE" 0) (INITGET (+ 1 2 4)) (SETQ PP0 (GETPOINT "\n TEXT-POINT:?")) (SETVAR "BLIPMODE" 0) (SETQ WS (GETINT "\n XIAO SHU WEI:?<1> ")) (IF (= WS NIL) (SETQ WS 1)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (SETQ NN (SSLENGTH SS)) (SETQ II 0) (WHILE (< II NN) (SETQ ENT (ENTGET (SETQ NAME (SSNAME SS II)))) (SETQ TXT (CDR (ASSOC 1 ENT))) (SETQ TXT (ATOF TXT)) (COND ((= JSF "+") (SETQ TXT (+ TXT XI))) ((= JSF "-") (SETQ TXT (- TXT XI))) ((= JSF "*") (SETQ TXT (* TXT XI))) ((= JSF "/") (SETQ TXT (/ TXT XI))) ) (COMMAND "COPY" NAME "" P0 PP0) (SETQ TXT (RTOS TXT 2 WS)) (setq txt-style (cdr (assoc 7 (entget name)))) (setq style-higth (cdr (assoc 40 (tblsearch "style" txt-style)))) (if (= style-higth 0.0) (COMMAND "CHANGE" "L" "" "" "" "" "" "" TXT ) (command "change" "l" "" "" "" "" "" txt)) (SETQ II (+ II 1)) ) (SETVAR "BLIPMODE" 0) (SETVAR "CMDECHO" 0) (PRINC) ) (DEFUN C:HZZ(/ NN II ENT NAME TXT PP P0 PP0 NAME1 P ST ZH ZW ANG I N W TEMP) (SETVAR "BLIPMODE" 0) (SETVAR "CMDECHO" 0) (PROMPT "\n FIRST-SSGET:") (INITGET (+ 1 2 4)) (getss) (SETQ SS1 ssa) (PROMPT "\n SECOND-SSGET:") (getss) (SETQ SS2 ssa) (SETQ P0 (CDR (ASSOC 10 (ENTGET (SETQ NAME0 (SSNAME SS1 0)))))) (INITGET (+ 1 2 4)) (SETQ PP0 (GETPOINT "\n TEXT-POINT:?")) (INITGET(+ 1 2 4)) (SETQ XI (GETREAL "\n HUI ZONG GAN JIN-- DAN WEI ZHONG:? <0.888>")) (IF (= XI NIL) (SETQ XI 0.888))
(SETVAR "BLIPMODE" 0) (SETQ WS (GETINT "\n XIAO SHU WEI:?<2> ")) (IF (= WS NIL) (SETQ WS 2)) (SETQ NN1 (SSLENGTH SS1)) (SETQ II 0) (SETQ TXT 0) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (IF (AND (/= SS2 NIL) (/= SS1 NIL)) (PROGN (SETQ NN2 (SSLENGTH SS2)) (IF (>= NN1 NN2) (SETQ NN NN2) (SETQ NN NN1)) (WHILE (< II NN) (SETQ ENT1 (ENTGET (SETQ NAME1 (SSNAME SS1 II)))) (SETQ ENT2 (ENTGET (SETQ NAME2 (SSNAME SS2 II)))) (SETQ TXT1 (CDR (ASSOC 1 ENT1))) (SETQ TXT2 (CDR (ASSOC 1 ENT2))) (SETQ TXT1 (ATOF TXT1)) (SETQ TXT2 (ATOF TXT2)) (IF (= TXT1 XI) (SETQ TXT (+ TXT TXT2))) (SETQ II (+ II 1)) ) )) (COMMAND "COPY" NAME0 "" P0 PP0) (SETQ TXT (RTOS TXT 2 WS)) (setq txt-style (cdr (assoc 7 (entget name0)))) (setq style-higth (cdr (assoc 40 (tblsearch "style" txt-style)))) (if (= style-higth 0.0) (COMMAND "CHANGE" "L" "" "" "" "" "" "" TXT ) (command "change" "l" "" "" "" "" "" txt))
(SETVAR "BLIPMODE" 0) (SETVAR "CMDECHO" 0) (PRINC) )
|