yang686526

楼主们,.看看这个天圆地方为什么有的机能用
www.dimcax.com
楼主们,.看看这个天圆地方为什么有的机能用
楼主们,.看看这个天圆地方为什么有的机能用.有的机不能用.我们公司里只有两台电脑能用
(defun c:tydf (/ ppp a ab b r h x y z p01 p02 p03 p04 p1 p2 p3 p4 pt11 pt12 pt13
pt21 pt22 pt23 pt0 pt1 k e c ang ang1 ppp1 ppp2 ppp3 ppp4 ss)
(setvar "cmdecho" 0)
(alert "本程序已将ucs设为世界坐标系！")
(command "ucs" "w")
(setq ppp (getpoint "\n请输入地方的中心点"))
(setq a (getdist ppp "\n请输入地方的半长度:"))
(setq b (getdist ppp "\n请输入地方的半宽度:"))
(setq r (getdist ppp "\n请输入天圆的半径:"))
(setq h (getdist ppp "\n请输入天圆地方的高度:"))
(setq ss (ssadd));;;;;
(if (< a b)
(progn
(setq ab b)
(setq b a)
(setq a ab)
)
)
(if (< b r)
(progn
(alert"您要画的是天圆地方，圆的直径不能大于“地方”的宽度和长度!")
(exit))
)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq x (car ppp))
(setq y (cadr ppp))
(setq z (caddr ppp))
(setq p01 (list (+ x a) (- y b) z) ;第四象限点
p02 (list (+ x a) (+ y b) z) ;第一象限点
p03 (list (- x a) (+ y b) z) ;第二象限点
p04 (list (- x a) (- y b) z)) ;第三象限点
(command "rectang" p01 p03)
(setq aa (atan (/ (- b r) h))) ;angle = atn((b - d) / (2 * h))
(setq ang (r->d aa)) ;弧度转化为度
(setq p12 (list (+ x a) y z))
(setq p23 (list x (+ y b) z))
(setq p34 (list (- x a) y z))
(setq p41 (list x (- y b) z))
(command "extrude" (list (entlast) p23) "" h ang);;;;;;
(ssadd (entlast) ss);;;;;
(setq p1 (list (+ x r) y (+ z h)) ;+x点
p2 (list x (+ r y) (+ z h)) ;+y点
p3 (list (- x r) y (+ z h)) ;-x点
p4 (list x (- y r) (+ z h))) ;-y点
(command "slice" (list (entlast) p23) "" p01 p02 p1 p03) ;;;;;
(command "slice" (list (entlast) p23) "" p03 p04 p3 p01)
(command "slice" (list (entlast) p23) "" p01 p4 p1 p3)
(command "slice" (list (entlast) p23) "" p02 p1 p2 p4)
(command "slice" (list (entlast) p23) "" p03 p2 p3 p1)
(command "slice" (list (entlast) p23) "" p04 p3 p4 p2)
(setq pt11 (+ x (* r (cos (atan (/ b a)))))
pt12 (- y (* r (sin (atan (/ b a)))))
pt13 (+ z h))
(setq pt1 (list pt11 pt12 pt13)) ;射线交点1
(setq pt21 (- x (* r (cos (atan (/ b a)))))
pt22 (+ y (* r (sin (atan (/ b a)))))
pt23 (+ z h))
(setq pt2 (list pt21 pt22 pt23)) ;射线交点2
(setq d01 (distance p01 pt1)
d02 (distance p01 pt2)
d12 (distance pt1 pt2))
(setq c (/ d01 d02))
(setq pt01 (/ (+ pt11 (* c pt21))(+ 1 c)))
(setq pt02 (/ (+ pt12 (* c pt22))(+ 1 c)))
(setq pt03 (+ z h))
(setq pt0 (list pt01 pt02 pt03)) ;椭圆锥圆心
(setq k (angle pt0 pt1))
(setq aa (sqrt (* (distance pt0 pt1) (distance pt0 pt2))))
(setq e (/ (- (+ (* d01 d01) (* d02 d02)) (* d12 d12))
(* 2 d01 d02)))
(setq ang1 (+ (atan (/ (- 0 e) (sqrt (- 1 (* e e))))) (* 2 (atan 1))))
(setq bb (/ (* (sin (/ ang1 2)) (distance p01 pt0)) (cos (/ ang1 2))))
(command "ucs" "za" pt0 p01)
(setq pp1 (list aa 0 0))
(setq pp2 (list (- 0 aa) 0 0))
(setq pp3 (list 0 0 (distance pt0 p01)))
(command "cone" "e" "c" "" pp1 bb "a" pp3)
(command "ucs" "p")
(command "slice" "l" "" p1 p2 p3 p01)
(setq ppp1 (list (+ x (/ r (sqrt 2)))(- y (/ r (sqrt 2)))(+ z h)))
(setq ppp2 (list (+ x (/ r (sqrt 2)))(+ x (/ r (sqrt 2)))(+ z h)))
(setq ppp3 (list (- x (/ r (sqrt 2)))(+ x (/ r (sqrt 2)))(+ z h)))
(setq ppp4 (list (- x (/ r (sqrt 2)))(- y (/ r (sqrt 2)))(+ z h)))
(command "slice" "l" "" p1 p4 p01 (list (+ x a) (- y b) (+ z h)))
(ssadd (entlast) ss);;;;;;
(command "mirror" "l" "" p23 p41 "n")
(ssadd (entlast) ss);;;;;;
(command "mirror" "l" "" p12 p34 "n")
(ssadd (entlast) ss);;;;;;
(command "mirror" "l" "" p23 p41 "n")
(ssadd (entlast) ss);;;;;
(command "union" ss "")
(setvar "osmode" oldos)
(princ)
)
(defun r->d (number)
(* 180 (/ number pi))
)