solve1.lsp

autolisp编写的解决一元线性方程的程序

;;(defun func (/ dx dy y1 y2 y3 y4)
(defun func ()
   (setq y1 (cal p))
   (setq dx 1e-15)
   (setq x (+ x dx))
   (setq y2 (cal p))
   (setq dy (- y2 y1))
   (setq y3 (/ dy dx))
   (setq x (- x dx))
   (if (/= y3 0)
       (setq y4 (- x (/ y1 y3)))
       (princ "导数为零")
   )
)
(defun func1 ()
   (setq x x0)
   (setq y0 (cal p))
   (setq x x1)
   (setq y1 (cal p))
   (setq dy (- y1 y0))
   (setq y2 (/ (- x1 x0)(- y1 y0)))
   (setq x2 (- x1 (* y1 y2)))
   (setq x0 x1)
   (setq x1 x2)
  )
;;(defun C:solve (/ p x y)
(defun C:solve ()
   (arxload "geomcal.arx")
   (setq oce (getvar "cmdecho"))
   (setvar "cmdecho" 0)
   (VL-LOAD-COM)
   (setq AcadObject   (vlax-get-acad-object)
	 AcadDocument (vla-get-ActiveDocument AcadObject)
	 mSpace	     (vla-get-ModelSpace AcadDocument))
   (setq Utility (vla-get-utility AcadDocument))
   (setq nonull 1)
   (vla-initializeuserinput utility nonull) 
   (setq p (vla-getstring Utility :vlax-true "\n请输入函数表达式(按空格或<Enter>会结束输入):")
         x0 (getreal "\n请输入初始值: ")
	 n  (fix (abs (getreal "\n请输入精确度(不超过小数后15位否则以15精度计算):"))) )
   (if (> n 15)(setq n 15))
   (setq dx 1e-2)
   (setq x1 (+ x0 dx))
   (setq y (func1))
   (while (> (abs (- y x)) (expt (/ 1.0 10.0) (1+ n)))
   ;;(repeat 100
	  (setq x y)
          (setq y (func1))
     )
   (setvar "cmdecho" oce)
   (setq fy (rtos (- (abs y) (fix (abs y))) 2 n))
   (setq fy (vl-string-left-trim "0" fy))
   (setq inty (rtos y 2 0))
   (alert (strcat "方程的解为:\nX=" inty fy))
   (princ)
   (atof (strcat inty fy))    
)