|
|
该程序画的是蜗壳内壁型线,奇怪的是,第２条圆弧终点和第３条的起点始终不能重合,百思不得其解,所以来这向高人求助,望各位大大帮帮忙
谢谢了
(defun c:woke()
(progn
;输入数据
(setq p0 (getpoint "\n 请输入基准点:"))
(setq s (getreal "\n 绘图比例:"))
(if (null s) (setq s 0.1))
(setq r (getreal "\n 请输入进口半径R:"))
(if (null r) (setq r 750))
(setq r1 (getreal "\n 请蜗壳输入半径R1:"))
(if (null r1) (setq r1 818))
(setq r2 (getreal "\n 请输入蜗壳半径R2:"))
(if (null r2) (setq r2 954))
(setq r3 (getreal "\n 请输入蜗壳半径R3:"))
(if (null r3) (setq r3 1090))
(setq r4 (getreal "\n 请输入蜗壳半径R4:"))
(if (null r4) (setq r4 1226))
(setq c (getreal "\n 蜗壳出口长度C:"))
(if (null c) (setq c 760))
(setq l (getreal "\n 请输入蜗壳内壁间距L:"))
(if (null l) (setq l 544))
(setq a (/ l 4))
(setq px (car p0)
py (cadr p0)
pz (caddr p0))
;定义等边基点坐标
(setq xa1 (+ px (/ a 2))
ya1 (+ py (/ a 2))
xa2 xa1
ya2 (- py (/ a 2))
xa3 (- px (/ a 2))
)
(setq ya3 ya2)
(setq xa4 xa3)
(setq ya4 ya1)
;蜗壳个弧线端点坐标
(setq xb1 (+ px (+ r (- l c))))
(setq yb1 (+ py (+ (sqrt (- (* r1 r1) (* (+ (+ r (- l c)) (/ a 2)) (+ (+ r (- l c)) (/ a 2))))) (/ a 2))))
(setq xb2 px)
(setq yb2 (+ py (+ (sqrt (- (* r1 r1) (* (/ a 2) (/ a 2)))) (/ a 2))))
(setq xb3 (- px (sqrt (- (* r2 r2) (* (/ a 2) (/ a 2))))))
(setq yb3 py)
(setq xb4 px)
(setq yb4 (- py (sqrt (- (* r3 r3) (* (/ a 2) (/ a 2))))))
(setq xb5 (+ px (+ r l)))
(setq yb5 py )
(setq xc1 xb1);(+ (- (+ px (sqrt (- (* r4 r4) (* (/ a 2) (/ a 2))))) c) (/ a 2))
(setq yc1 (+ py r4))
(setq xc2 xb5);(+ (+ px (sqrt (- (* r4 r4) (* (/ a 2) (/ a 2))))) (/ a 2)))
(setq yc2 yc1)
(setq a1 (list xa1 ya1 pz)
a2 (list xa2 ya2 pz)
a3 (list xa3 ya3 pz)
a4 (list xa4 ya4 pz)
b1 (list xb1 yb1 pz)
b2 (list xb2 yb2 pz)
b3 (list xb3 yb3 pz)
b4 (list xb4 yb4 pz)
b5 (list xb5 yb5 pz)
c1 (list xc1 yc1 pz)
c2 (list xc2 yc2 pz))
(command "arc" b1 "c" a4 b2 "")
(command "arc" b2 "c" a3 b3 "")
(command "arc" b3 "c" a2 b4 "")
(command "arc" b4 "c" a1 b5 "")
(command "line" a1 a2 ""
"line" a2 a3 ""
"line" a3 a4 ""
"line" a4 a1 ""
"line" c1 b1 ""
"line" c1 c2 ""
"line" c2 b5 ""
"circle" p0 r
)
)) |
|
置顶卡
