求助LISP程序

179

(defun c:5()
  (setvar "cmdecho" 0)
  (setq b1 (getpoint "\n插入顶点"))
  (setq b2 (getpoint "\n插入终点"))
  (setq r  (getreal "\n输入半径"))
  (setq a  (GETORIENT "\n输入角度"))
  (setq ww (distance b1 b2))
  (setq b3 (polar b2 (/ pi 2) (- ww (- ww r))))
  (setq a1 (polar b3 a r))
  (setq gg (* r (sin a)))
  (setq tt (+ gg (- ww r)))
  (setq qq (/ tt (sin (- 90 a))))
  (setq a2 (polar a1 (- (/ pi 2)a) qq))
  (setq a3 (polar b3 (+ pi a) r))
  (setq a4 (polar a3 (- (- (/ pi 2)a)) (- qq)))
  (command "line" a1 a2  "")
  (command "arc" a1 b2 a3  "")
(command  "line" a3 a4 "")
(princ))

 
      

Andyhon

(defun c:5 ()
  (setvar "cmdecho" 0)
  (setq b1 (getpoint "\n插入顶点: "))
  (setq b2 (getpoint "\n插入终点: "))
  (setq r (getreal "\n输入半径: "))
  (setq a (GETORIENT "\n输入角度: "))
  (setq po (mapcar '+ b2 (list 0 r))
        a1 (polar po (+ A pi) r)
        a3 (polar po (- A) r)
      cosa (cos a)
        ww (/ (- (cadr b1) (cadr b2) r) cosa)
       A90 (/ Pi 2)
        a2 (polar po (+ A90 a) ww)
        a4 (polar po (- A90 a) ww)
        ww (/ r cosa)
        a2 (polar a2 pi ww)
        a4 (polar a4 0 ww)
  )
  (command "line" a1 a2 "")
  (command "arc" a1 b2 a3)
  (command "line" a3 a4 "")
  (princ)
)

;; **** 捕捉未处置, 有待补发生 error 时的.....