solve2.lsp

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

(defun func (/ dx dy y1 y2 y3 y4)
  (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 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 ()
  (VL-LOAD-COM)
  (arxload "geomcal.arx")
  (setq Utility (vla-get-utility (vla-get-ActiveDocument (vlax-get-acad-object))))
  (vla-initializeuserinput utility 1) 
  (setq p (vla-getstring Utility :vlax-true "\n请输入函数表达式:"))
  (initget 1)
  (setq	x0 (getreal "\n请输入初始值: "))
  (initget 7)
  (setq	n (getint "\n请输入精确度:"))
  (defun fun (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))
  )
  (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))
)
(defun C:test (/ ent obj pt1 index pt pts)
  (while
    (and
      (setq ent (entsel))
      (setq obj (vlax-ename->vla-object (car ent)))
      (setq pt1 (vlax-curve-getClosestPointTo obj (cadr ent)))
      (setq index (fix (vlax-curve-getParamAtPoint obj pt1)))
      (setq pt (getpoint "\n请输入添加的点:"))
      (setq pt (reverse (cdr (reverse pt))))
      (setq pts (vlax-make-safearray vlax-vbdouble '(0 . 1)))
      (vlax-safearray-fill pts pt)
      (vlax-method-applicable-p obj 'AddVertex)
    )
    (vla-AddVertex obj (1+ index) pts)
  )
  (princ)
)
(defun C:tt (/ ent obj pt1 index pt pts)
  (and
    (setq ent (entsel))
    (setq obj (vlax-ename->vla-object (car ent)))
    (setq pt (getpoint "\n请输入添加的点:"))
    (setq pts (vlax-make-safearray vlax-vbdouble '(0 . 2)))
    (vlax-safearray-fill pts pt)
    (vlax-method-applicable-p obj 'AppendVertex)
    (vla-AppendVertex obj pts)
  )
  (princ)
)
(defun C:ttt ()
  (setq f (getstring "\n自胡服:"))
  (defun func (x)
    (cal f)
  )  
)