|
|
发表于 2003-12-30 11:52:00
|
显示全部楼层
lisp。lsp
;;;;;;;;;;;;;
(defun c:aa1()
;(setq p0 (getpoint "\n please select a base point:"))
;;; (setq r1 (getreal "\n input r1:"))
;;; (setq r2 (getreal "\n input r2:"))
;;; (setq r3 (getreal "\n input r3:"))
;;; (setq r4 (getreal "\n input M:"))
;;; (setq r5 (getreal "\n input r5:"))
;;; (setq r6 (getreal "\n input r6:"))
;;; (setq d1 (getreal "\n input d1:"))
;;; (setq h1 (getreal "\n input h1:"))
;;; (setq h2 (getreal "\n input h2:"))
;;; (setq h3 (getreal "\n input h3:"))
;;; (setq h4 (getreal "\n input h4:"))
;;; (setq h5 (getreal "\n input h5:"))
;;; (setq h6 (getreal "\n input h6:"))
;;; (setq b1 (getreal "\n input b1:"))
;;; (setq b2 (getreal "\n input b2:"))
;;; (setq b3 (getreal "\n input b3:"))
;;; (setq b4 (getreal "\n input b4:"))
(defun getdata ()
;;; (setq r1 (atof (get_tile "r1"))
;;; r2 (atof (get_tile "r2"))
;;; r3 (atof (get_tile "r3"))
;;; r4 (atof (get_tile "r4"))
;;; r5 (atof (get_tile "r5"))
;;; r6 (atof (get_tile "r6"))
;;; d1 (atof (get_tile "d1"))
;;; h1 (atof (get_tile "h1"))
;;; h2 (atof (get_tile "h2"))
;;; h3 (atof (get_tile "h3"))
;;; h4 (atof (get_tile "h4"))
;;; h5 (atof (get_tile "h5"))
;;; h6 (atof (get_tile "h6"))
;;; b1 (atof (get_tile "b1"))
;;; b2 (atof (get_tile "b2"))
;;; b3 (atof (get_tile "b3"))
;;; b4 (atof (get_tile "b4"))
;;; )
(setq r1 (atof $r1)
r2 (atof r2$)
r3 (atof (get_tile "r3"))
r4 (atof (get_tile "r4"))
r5 (atof (get_tile "r5"))
r6 (atof (get_tile "r6"))
d1 (atof (get_tile "d1"))
h1 (atof (get_tile "h1"))
h2 (atof (get_tile "h2"))
h3 (atof (get_tile "h3"))
h4 (atof (get_tile "h4"))
h5 (atof (get_tile "h5"))
h6 (atof (get_tile "h6"))
b1 (atof (get_tile "b1"))
b2 (atof (get_tile "b2"))
b3 (atof (get_tile "b3"))
b4 (atof (get_tile "b4"))
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun draw()
(setq p0 (getpoint "\n please select a base point:"))
(setq r1 14
r2 19
r3 23
r4 3
r5 28
r6 5
d1 6
h1 10
h2 30
h3 65
h4 3
h5 2
h6 6
b1 32
b2 40
b3 52
b4 62
)
(command "-layer" "n" "cen,1,2,3" "c" "1" "cen" "c" "3" "1" "L" "center" "cen" "s" "0" "")
(setq p1 (polar p0 (/ pi 2.0) r2))
(setq p2 (polar p1 (* pi (/ -80.0 180.0)) r4))
(command "circle" p0 r1)
(command "-layer" "s" "cen" "")
(command "circle" p0 r2)
(command "layer" "s" "0" "")
(command "circle" p0 r3)
(setq ent0 (entlast))
(command "zoom" "e")
(setq tempr (* 0.8 r4))
(command "circle" p1 tempr)
(setq ent1 (entlast))
(command "arc" "c" p1 p2 "Angle" "270")
(setq ent2 (entlast))
;(command "array" ent1 ent2 "" "p" p0 "3" "360" "y")
(command "zoom" "p")
(setq p6 (polar p0 (/ pi -2.0) r5))
(command "arc" "c" p0 p6 "a" "90")
(setq entarc (entlast))
(setq p4 (polar p0 0 (/ b2 2.0)))
(setq p5 (polar p4 (/ pi -2.0) (- h3 h1)))
(command "line" p4 p5 "")
(setq ent3 (entlast))
(command "trim" ent0 "" p4 "")
(setq ent3 (entlast))
(setq pb (polar p0 (/ pi -2.0) h3))
(command "_mirror" ent3 "" p0 pb "n")
(setq p7 (polar p0 0 (/ b1 2.0)))
(setq p8 (polar pb 0 (/ b1 2.0)))
(command "line" p7 p8 "")
(setq ent4 (entlast))
(setq p9 (polar pb 0 (/ b4 2.0)))
(setq p10 (polar p9 (/ pi 2.0) h1))
(setq p11 (polar p10 pi (/ (- b4 b1) 2.0)))
(setq x (car pb))
(setq x (+ x (/ b3 2.0)))
(setq y (cadr pb))
(setq y (- y 5.0))
(setq p13 (list x y 0))
(setq p12 (polar p13 (/ pi 2.0) (+ h1 10)))
(setq p14 (polar p8 (/ pi 2.0) h2))
(setq p15 (polar p14 0 (/ (- b2 b1) 2.0)))
(command "line" p8 p9 p10 p11 "")
(command "line" p12 p13 "")
(setq entcen (entlast))
(command "line" p14 p15 "")
;;; (setq ptemp1 (polar p0 0 r5))
;;; (command "circle" "T" "tan" p6 "tan" p14 r6)
;;; (setq ent5 (entlast))
;;; (setq ent_data (entget ent5))
;;; (setq ce_ent5 (cdr (assoc 10 ent_data)))
;;; (setq ptemp2 (polar ce_ent5 (/ pi -2.0) r6))
;;; (command "zoom" "e")
;;; (command "trim" ent5 "" p7 ptemp1 "")
;;; (command "trim" entarc ent4 "" ptemp2 "")
(command "_fillet" "r" r6 "fillet" p6 p14)
;;;(command "_fillet" "r" r6 p6 p14)
(command "zoom" "e")
(command "_mirror" "w" p0 p9 entcen "" p0 pb "n")
(command "array" ent1 ent2 "" "p" p0 "3" "360" "y")
(setq x (car p12))
(setq x (- x (/ d1 2.0)))
(setq y (cadr p10))
(setq p16 (list x y))
(setq p17 (polar p16 (/ pi -2.0) h1))
(command "line" p16 p17 "")
(setq ent6 (entlast))
(command "mirror" ent6 "" p12 p13 "n")
(setq x1 (car p11))
(setq x2 (car p16))
(setq x (/ (+ x1 (/ (- b2 b1) 2.0) x2) 2.0))
(setq y (cadr p16))
(setq p18 (list x y))
(setq x (car p5))
(setq y (cadr p8))
(setq y (+ y (/ h1 2.0)))
(setq p19 (list x y))
(setq p20 (polar p18 (/ pi -2.0) h1))
(command "line" p18 p19 p20 "")
(bpoly (inters p16 p20 p18 p13))
(setq ent7 (entlast))
(setq ptemp1 (polar p16 0 d1))
(setq ptemp2 (polar p17 0 d1))
(bpoly (inters p10 ptemp2 p9 ptemp1))
(setq ent8 (entlast))
(command "zoom" "w" pb p10)
(command "hatch" "ansi31" 1 0 ent7 ent8 "")
(command "zoom" "p")
(setq x (car pb))
(setq x (- x (/ b1 2.0)))
(setq y (cadr pb))
(setq y (+ y h4))
(setq ps3 (list x y))
(setq pe3 (polar ps3 0 b1))
(setq ps2 (polar ps3 (/ pi 2.0) h5))
(setq pe2 (polar ps2 0 b1))
(setq ps1 (polar ps2 (/ pi 2.0) h6))
(setq pe1 (polar ps1 0 b1))
(command "line" ps1 pe1 "")
(command "line" ps2 pe2 "")
(command "line" ps3 pe3 "")
(setq ps (polar p0 pi (+ 3 r3)))
(setq pe (polar p0 0 (+ 3 r3)))
(command "line" ps pe "")
(setq ps (polar p0 (/ pi 2.0) (+ 3 r3)))
(setq pe (polar p0 (/ pi -2.0) (+ 3 h3)))
(command "line" ps pe "")
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun dialogs ()
(setq dcl_id (load_dialog "lispPs.dcl"))
(if (not (new_dialog "dcl_show" dcl_id))
(exit)
)
(setq x (dimx_tile "image")
y (dimy_tile "image")
)
(start_image "image")
(slide_image 0 0 x y "lispPs")
(end_image)
(action_tile "accept" " (getdat)(done_dialog 1) ")
(setq ret (start_dialog))
(unload_dialog dcl_id)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(dialogs)
(if (= ret 1)
(draw)
)
) |
|
置顶卡
