solve3.lsp

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

(defun diff1 (/ y0 y1 dy y2 x2)
   (setq y0 (fun x0))
   (setq y1 (fun x1))
   (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>会结束输入):"))
   (setq x0 (getreal "\n请输入初始值: ")
	 n  (fix (abs (getreal "\n请输入精确度(不超过小数后15位否则以15精度计算):"))))
   (defun-q-list-set 'fun '((x) (setq x (cal p))))
   (if (> n 15)(setq n 15))
   (setq dx 1e-2)
   (setq x1 (+ x0 dx))
   (setq x x0)
   (setq y (diff1))
   (while (> (abs (- y x)) (expt (/ 1.0 10.0) (1+ n)))
	  (setq x y)
          (setq y (diff1))
     )
   (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))    
)