[LISP函数]：繪制錐孔的小程序

clyuyu

LISP小程序共飨，可精确绘制锥孔，锥形轴
(defun C:taper( / x1 x2 x3 x4 x5 x6 y1 y2 y3 y4 y5 y6 line1 line2 line3 line4)
    (setq olderr *error* *error* at_err)
    (command "ortho" "on")
    (setq p1 (getpoint "\nstart point: "))
    (setq len (getdist p1 "\nlength of taper: "))
    (setq tap1 (getreal "\nenter taper: "))
    (setq tap2 (/ 1 tap1))
    (setq rtap (/ tap2 2))
    (setq rsr (* len rtap))
    (setq x1 (car p1) y1 (cadr p1))
    (setq x2 (+ x1 len) y2 y1)
    (initget "lArge Little")
    (setq answer (getkword "\nlArge end\\Little end<L>: "))
    (if (or (not answer) (= answer "Little"))
        (setq d (getreal "\nlittle diameter: "))
        (setq di (getreal "\nlarge diameter: "))
    )
    (if (or (not answer) (= answer "Little"))
        (setq r (/ d 2))
        (setq ri (/ di 2))
    )
    (if (or (not answer) (= answer "Little"))
        (setq x3 x1 y3 (+ y1 r) x4 x2 y4 (+ y3 rsr)
              x5 x1 y5 (- y1 r) x6 x2 y6 (- y5 rsr))
        (setq x3 x1 y3 (+ y1 ri) x4 x2 y4 (- y3 rsr)
              x5 x1 y5 (- y1 ri) x6 x2 y6 (+ y5 rsr))
    )
    (setq p2 (list x2 y2) p3 (list x3 y3) p4 (list x4 y4)
          p5 (list x5 y5) p6 (list x6 y6))
    (command "line" p3 p4 "")
    (setq line1 (entlast))
    (command "line" p5 p6 "")
    (setq line2 (entlast))
    (initget "Shape Hole")
    (setq answe (getkword "\nShape\\Hole<S>: "))
    (if (or (not answe) (= answe "Shape"))
        (progn (command "line" P3 p5 "")
               (setq line3 (entlast))
               (command "line" p4 p6 "")
               (setq line4 (entlast))
               (prompt "\nRotation angle: ")
               (command "rotate" line1 line2 line3 line4 "" p1 pause)
        )
        (progn (command "line" p4 p6 "")
               (setq line4 (entlast))
               (prompt "\nRotation angle: ")
               (command "rotate" line1 line2 line4 "" p1 pause)
        )
    )   
   
    (setq *error* olderr)
    (princ)
)