math.lsp

数学计算lisp程序

(defun C:For()
(defun *error* (msg)
(princ)
;(setq msg nil)
(alert "公式输入有错或已知数据不够！")
(princ)
)
(setvar "CMDECHO" 0)
(if (= mm nil)(setq mm 3))
(setq rowNumberInCal 6 NowPageNo 1)
(setq nowAzimathCal 0)
(setq RowsPerPage 56)
(setq TitleNMstr "")
(setq DegOrDMS 0)
(setq beforeTitleNmSpaces "")
(setq FreeMem (open "TempLisp.lsp" "w"))
(write-line "(DEFUN FREEMEMORY()" FreeMem)

(if (= sourceFilename nil)(setq sourceFilename "c:\\"))
(setq sourceFilename (getfiled "请选择包含计算公式内容的文件(OPEN)            覃东(C)2000" sourceFilename "src" 8))
(if (/= sourceFilename nil)(progn
(setq resultFilename (getfiled "请选择保存计算结果的文件名称(SAVE)            覃东(C)2000"  (substr sourceFilename 1 (- (strlen sourceFilename) 4))  "rsl" 1)) 
(if (= resultFilename nil)(setq resultFilename "cal.rsl"))

(if (/= (setq tpFor (open sourceFilename "r")) nil)(progn
(setq QDjudge (member "geomcal.arx" (setq q (arx))))
(if (= QDjudge nil)(arxload "geomcal.ARX"))
(setq lp 0)
(setq lpstring "")
(setq tmpfile (open "qdgkw.tmp" "w"))

(while (/= (setq temptstring (read-line tpFor)) nil)
 (if (= (strcase (substr temptstring 1 6)) "TITLE=")(setq TitleNMstr (substr temptstring 7))
   (progn
      (if (= (substr temptstring 1 4) "loop")
            (progn
                  (if (= (substr temptstring 5) "=")
                  (setq temptstring (strcat temptstring (rtos (getint "请输入循环次数:") 2 0)))                  
                  )
            
            (cal temptstring)
            (setq lp 1)
            (setq temptstring (read-line tpFor))
            )
      )
      (if (= (substr temptstring 1 7) "endloop")
            (progn
                (setq lpstring (substr lpstring 1 (- (strlen lpstring) 1)))
                (repeat loop
                (write-line lpstring tmpfile)                                 
                 )
               (setq lp 0)
               (setq temptstring (read-line tpFor))
            )
      )

     (if (and (= lp 0) (/= temptstring nil)) (write-line temptstring tmpfile))
     (if (= lp 1) (setq lpstring (strcat lpstring  temptstring "\n")))
  ))
)
(close tmpfile)
(if (= TitleNMstr "")(setq TitleNMstr "测量计算书"))
(setq formulas (open "qdgkw.tmp" "r"))
(setq calresult (open resultFilename "w"))
(setq halfTlNMlen (- 45 (fix (/ (strlen TitleNMstr) 2))))
(repeat halfTlNMlen
(setq beforeTitleNmSpaces (strcat beforeTitleNmSpaces " "))
)

(write-line (strcat beforeTitleNmSpaces TitleNMstr) calresult)
(write-line "≌≌≌≌≌≌≌≌≌≌≌≌≌≌≌≌≌≌≌≌≌≌≌≌≌≌≌≌≌≌≌≌≌≌≌≌≌≌≌≌≌≌≌≌" calresult)
(write-line " " calresult)
(write-line "┌───────────────────────────────┬──────────┐" calresult)
(write-line "│                     公式及已知数据                           │     计算结果       │" calresult)
(write-line "├───────────────────────────────┼──────────┤" calresult)

  (while (/= (setq QinDongFormula (read-line Formulas)) nil) 

    (if (/= (substr QinDongFormula 1 1) ";")
       (progn
              (setq DongFormulalen (strlen QinDongFormula))
           (if (= (substr QinDongFormula DongFormulalen 1) "=")
               (progn
               (setq inputvalue (getstring QinDongFormula))
               (setq QinDongFormula (strcat QinDongFormula inputvalue))

               )
            )


       (if (= (wcmatch QinDongFormula "*azimath(*") T)
              (progn
               (setq variblnm (equalposition QinDongFormula))
               (setq AzmthP (Azimathpara (substr QinDongFormula (+ (strlen variblnm) 1) )))                            
               (setq AzmthP1 (substr (depart AzmthP "," 1) 2))          
               (setq AzmthP2 (depart restStr "," 1))          
               (setq AzmthP3 (depart restStr "," 1))          
               (setq AzmthP4 (substr restStr 1 (- (strlen restStr) 1)) )
               (setq QinDongFormulaOri "180-90*(abs(yofb-yofa)/(yofb-yofa))-atan((xofb-xofa)/(yofb-yofa))")
               (setq QinDongFormulaOri (convert QinDongFormulaOri "xofb-xofa" (strcat AzmthP3 "-" AzmthP1)))
               (setq QinDongFormulaOri (convert QinDongFormulaOri "yofb-yofa" (strcat AzmthP4 "-" AzmthP2)))
               (setq QinDongFormula (strcat variblnm QinDongFormulaOri))
               (setq nowAzimathCal 1)
                )

        ) 

       (if (= (wcmatch QinDongFormula "*distance(*") T)
              (progn
              (setq distP (Azimathpara QinDongFormula))                            
               (setq distP1 (substr (depart distP "," 1) 2))          
               (setq distP2 (depart restStr "," 1))          
               (setq distP3 (depart restStr "," 1))          
               (setq distP4 (substr restStr 1 (- (strlen restStr) 1)) )
               (setq variblnm (equalposition QinDongFormula))
               (setq QinDongFormulaOri "((yofb-yofa)^2+(xofb-xofa)^2)^0.5")
               (setq QinDongFormulaOri (convert QinDongFormulaOri "xofb-xofa" (strcat distP3 "-" distP1)))
               (setq QinDongFormulaOri (convert QinDongFormulaOri "yofb-yofa" (strcat distP4 "-" distP2)))
               (setq QinDongFormula (strcat variblnm QinDongFormulaOri))
                )

        ) 
        (setq varibl (equalposition QinDongFormula))
        (if (=  (strcase (substr QinDongFormula 1 4)) "DMS(")(progn (setq QinDongFormula (strcat (substr QinDongFormula 5 (- (strlen varibl) 6)) "=" (substr QinDongFormula (+ (strlen varibl) 1))))(setq degordms 1)   ))
        (setq currentCalR (CAL QinDongFormula))
        (setq varibl (equalposition QinDongFormula))
        (write-line (strcat "(setq " (substr varibl 1 (- (strlen varibl) 1)) " nil)") FreeMem)
        (setq spacenum "")
        (setq Qspacenum2 "")
        (setq EdSpaceNumbers "")
       (if (/= (substr QinDongFormula 1 3) "mm=")
                (progn

                  (setq FormulaQinDong (convert (convert QinDongFormula "*" "×") "/" "÷"))
                  (setq QinDongFormula FormulaQinDong)
                  (setq QinDongFormulac (strlen QinDongFormula))
        (repeat (-  62 QinDongFormulac)
                (setq spacenum (strcat spacenum " ")) 

        )


        (setq qdTotalLen (strlen varibl))
        (repeat (- 6 qdTotalLen)
                (setq Qspacenum2 (strcat Qspacenum2 " ")) 

        )



 
 (if (= nowAzimathCal 1)(progn (if (= degordms 1)(setq degordms 0))(setq outputStrFor (QDangTstr currentCalR))(setq nowAzimathCal 0))(setq outputStrFor (rtos currentCalR 2 mm)) )
   (if (/= nowAzimathCal 1)
    (if (= degordms 1)(progn (setq outputStrFor (QDangTstr currentCalR)) (setq degordms 0) ))
   )

 (setq rstSpcs (strlen outputStrFor))
        (repeat (- 14 rstSpcs)
                (setq EdSpaceNumbers (strcat EdSpaceNumbers " ")) 

        )


    (if (<= rowNumberInCal RowsPerPage)
          (progn
               (write-line (strcat "│" QinDongFormula spacenum "│" Qspacenum2 varibl outputStrFor EdSpaceNumbers "│") calresult)
               (if (/= rowNumberInCal RowsPerPage)
                    (progn
                    (write-line "├───────────────────────────────┼──────────┤" calresult)
                    (setq rowNumberInCal (+ rowNumberInCal 2))
                    )(setq rowNumberInCal (+ rowNumberInCal 2))
                )


                   (if (= rowNumberInCal (+ RowsPerPage 2))
                     (progn
                       (write-line "└───────────────────────────────┴──────────┘" calresult)
                       (write-line (strcat "                                         Page:" (rtos NowPageNo 2 0)) calresult)
                       (write-line " " calresult)
                       (write-line "┌───────────────────────────────┬──────────┐" calresult)
                       (setq rowNumberInCal 0)
                       (setq NowPageNo (+ NowPageNo 1))
                     )
                   )





          )(progn
           (write-line "└───────────────────────────────┴──────────┘" calresult)
           (write-line (strcat "                                         Page:" (rtos NowPageNo 2 0)) calresult)
           (write-line " " calresult)
           (write-line "┌───────────────────────────────┬──────────┐" calresult)
               (setq rowNumberInCal 0)
               (setq NowPageNo (+ NowPageNo 1))

           )
     ) 


            )
       )
       )(progn 

(setq commahindspc "")
(setq HelpStrLen (strlen (substr QinDongFormula 2)))
                (repeat (- 60 HelpStrLen)
                (setq commahindspc (strcat commahindspc " ")) 

        )

    (if (<= rowNumberInCal RowsPerPage)
          (progn
             (write-line  (strcat "│※" (substr QinDongFormula 2) commahindspc "│                    │") calresult)
             (grtext -1 (substr QinDongFormula 2))