;;; lockwasherpro.lsp ;;; ;;; Copyright (C) 1998 by Charles Robbins and Martin Breunig ;;; ;;; Charles Robbins and Martin Breunig provide this code for your use. Use the code ;;; to your benifit and at your own risk. Charles Robbins and Martin Breunig do not ;;; warrant that the code is error free in your application. ;;; start the program (alert "lockwasherpro.lsp - Copyright (C) 1998 Martin Breunig and Charles Robbins. Type LW to start") (defun c:lw (/) ;;; drawing setup (setq osm (getvar "osmode")) (setvar "osmode" 0) (command "layer" "n" "dimension" "c" "red" "dimension" "") (command "layer" "n" "center" "c" "green" "center" "lt" "center" "center" "") (command "layer" "n" "hidden" "c" "magenta" "hidden" "lt" "hidden" "hidden" "") (command "layer" "s" "0" "") ;;; user input (initget 1 "0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16") (setq lw (getkword "\nWhat type lockwasher do you wish? [0 thru 16]...")) (setq sp (getpoint "\nPick the center of the washer "))(terpri) (if (= sp nil)(setq sp (list 0 0 0))) (if (= lw "0") (setq q 0.032 te 0.120 v 0.031 s 0.115 x 0.3465 r 0.4135 e 0.625 b 0.875 tangs 9 ) ) (if (= lw "1") (setq q 0.32 te 0.120 v 0.031 s 0.115 x 0.4245 r 0.4915 e 0.719 b 1.016 tangs 9 ) ) (if (= lw "2") (setq q 0.032 te 0.120 v 0.031 s 0.115 x 0.5415 r 0.6085 e 0.813 b 1.156 tangs 11 ) ) (if (= lw "3") (setq q 0.032 te 0.120 v 0.031 s 0.115 x 0.6195 r 0.6865 e 0.938 b 1.328 tangs 11 ) ) (if (= lw "4") (setq q 0.032 te 0.166 v 0.031 s 0.166 x 0.7415 r 0.8085 e 1.125 b 1.531 tangs 11 ) ) (if (= lw "5") (setq q 0.40 te 0.166 v 0.047 s 0.166 x 0.924 r 0.999 e 1.281 b 1.719 tangs 13 ) ) (if (= lw "6") (setq q 0.040 te 0.166 v 0.047 s 0.166 x 1.1105 r 1.203 e 1.500 b 1.922 tangs 13 ) ) (if (= lw "7") (setq q 0.040 te 0.166 v 0.047 s 0.166 x 1.3135 r 1.406 e 1.813 b 2.250 tangs 15 ) ) (if (= lw "8") (setq q 0.048 te 0.234 v 0.047 s 0.27 x 1.4925 r 1.593 e 2.000 b 2.469 tangs 15 ) ) (if (= lw "9") (setq q 0.048 te 0.234 v 0.062 s 0.27 x 1.704 r 1.8045 e 2.281 b 2.734 tangs 17 ) ) (if (= lw "10") (setq q 0.048 te 0.234 v 0.062 s 0.27 x 1.904 r 2.0045 e 2.438 b 2.922 tangs 17 ) ) (if (= lw "11") (setq q 0.053 te 0.234 v 0.062 s 0.27 x 2.089 r 2.1945 e 2.656 b 3.109 tangs 17 ) ) (if (= lw "12") (setq q 0.053 te 0.234 v 0.062 s 0.27 x 2.287 r 2.4125 e 2.844 b 3.344 tangs 17 ) ) (if (= lw "13") (setq q 0.053 te 0.234 v 0.062 s 0.27 x 2.475 r 2.6005 e 3.063 b 3.578 tangs 19 ) ) (if (= lw "14") (setq q 0.053 te 0.234 v 0.094 s 0.27 x 2.678 r 2.8035 e 3.313 b 3.828 tangs 19 ) ) (if (= lw "15") (setq q 0.062 te 0.328 v 0.094 s 0.27 x 2.8535 r 2.988 e 3.563 b 4.109 tangs 19 ) ) (if (= lw "16") (setq q 0.062 te 0.328 v 0.094 s 0.333 x 3.0575 r 3.192 e 3.844 b 4.375 tangs 19 ) ) ;;; do the math (setq rad1 (/ e 2.0)) (setq c1 te) (setq h1 (- rad1 (* 0.5 (sqrt (- (* 4.0 (expt rad1 2)) (expt c1 2)))))) (setq rad2 (/ r 2.0)) (setq c2 s) (setq h2 (- rad2 (* 0.5 (sqrt (- (* 4.0 (expt rad2 2)) (expt c2 2)))))) (setq rad3 (/ b 2.0)) (setq c3 te) (setq h3 (- rad3 (* 0.5 (sqrt (- (* 4.0 (expt rad3 2)) (expt c3 2)))))) (setq a1 (/ q (sqrt 2))) (setq rad4 (/ (- (/ b 2.0) a1))) (setq c4 te) (setq h4 (- rad4 (* 0.5 (sqrt (- (* 4.0 (expt rad4 2)) (expt c4 2)))))) (setq angtangspace (/ (* 2.0 pi) tangs)) (setq y0 (cadr sp)) (setq y4 (+ y0 (- (/ e 2.0) h1))) (setq angtang (atan (/ (/ te 2.0)(- y4 y0)))) (setq angp5 (+ (/ pi 2.0)(- angtangspace angtang))) (setq x0 (car sp) x1 (- x0 (/ te 2.0)) x2 (- x0 (/ s 2.0)) x3 (+ x0 (* (/ e 2.0)(cos angp5))) x4 (+ x0 0.125 (/ b 2.0)) x5 (+ x0 (/ s 2.0)) y1 (+ y0 (- x (/ r 2))) y2 (+ y0 (- (/ r 2.0) h2)) y3 (+ y0 (* (/ e 2.0)(sin angp5))) y6 (+ y0 (- (/ b 2.0) h3)) y7 (+ y0 (/ b 2.0)) y8 (- y6 h4) y9 (- y7 h4) ) ;;; point assignment (setq p1 (list x0 y0) p2 (list x4 y0) p3 (list x2 y1) p4 (list x2 y2) p5 (list x3 y3) p6 (list x1 y4) p7 (list x1 y6) p8 (list x0 y7) p9 (list x0 y1) p10 (list x1 y8) p11 (list x0 y9) p12 (list x5 y2) ) ;;; lets draw (command "layer" "s" "center" "") (command "line" p1 p2 "") (command "zoom" "e") (setq ss0 (ssget "l")) (command "layer" "s" "0" "") (command "line" p4 p3 "") (command "zoom" "e") (setq ss1 (ssget "l")) (command "line" p3 p9 "") (command "zoom" "e") (setq ss2 (ssget "l")) (command "line" p6 p7 "") (command "zoom" "e") (setq ss3 (ssget "l")) (command "arc" p6 "c" p1 p5) (command "zoom" "e") (setq ss4 (ssget "l")) (command "arc" p11 "c" p1 p10) (command "zoom" "e") (setq ss41 (ssget "l")) (command "arc" p8 "c" p1 p7) (command "zoom" "e") (setq ss5 (ssget "l")) (command "pedit" ss3 "y" "j" ss5 "" "") (command "zoom" "e") (setq ss6 (ssget "l")) (command "pedit" ss1 "y" "j" ss2 "" "") (command "zoom" "e") (setq ss7 (ssget "l")) (command "mirror" ss6 "" p1 p8 "" "") (command "zoom" "e") (setq ss8 (ssget "l")) (command "mirror" ss41 "" p1 p8 "" "") (command "zoom" "e") (setq ss81 (ssget "l")) (command "mirror" ss7 "" p1 p8 "" "") (command "array" ss0 "" "p" p1 "4" "" "") (command "array" ss4 ss41 ss6 ss8 ss81 "" "p" p1 tangs "" "" "") (command "arc" p4 "c" p1 p12) ;;; end of program (command "zoom" "e") (gc) (princ) )