Wednesday, February 24, 2010

CAM.lsp

;;;********************************************************************

;;;

;;;    Program Name: CAM.lsp

;;;    Program Purpose: Create a Simple harmonic motion cam displacement

;;;             diagram and cam profile

;;;    Program Written By: James Kevin Standiford

;;;    Program Date : 01-31-99

;;;

;;;********************************************************************

;;;

;;;    Main Program

;;;

;;;********************************************************************

(defun c:cam (/     cir lo_l_c inc     up_r_c pt1a    pt2a pt1b

     pt2b pt1c pt2c pt1d     pt2d     pt1e    pt2e pt1f

     pt2f pt1g pt2g pt1h     pt2h     pt1i    pt2i pt1j

     pt2j pt1k pt2k pt1l     pt2l

     )

(setvar "cmdecho" 0)

(setq base (getreal "\nEnter base circle diameter : "))

(setq fo_heigh (getreal "\nEnter follower height : "))

(if (and (/= base nil) (/= fo_heigh nil))

(progn

(setq

    cir (* base pi)

    lo_l_c (getpoint "\nSelect lower left hand corner of graph : ")

    ;;

    ;;

    ;; Determines the outer edges of the grid, and calculates the vertical

    ;; lines of the grid. The variable lo_l_c is the lower left-hand corner

    ;; of the graph. The variable up_r_c is the upper right hand corner of

    ;; the graph. The variables pt1? represent the lower portion of the vertical

    ;; grid line. The variables pt2? represent the upper portion of the vertical

    ;; grid line.

    ;;

    ;;

    inc (/ cir 12)

    up_r_c lo_l_c

    up_r_c (subst (+ cir (car lo_l_c))

         (car lo_l_c)

         (subst (+ fo_heigh (cadr lo_l_c))

             (car (cdr lo_l_c))

             lo_l_c

         )

     )

    pt1a (list (+ inc (car lo_l_c)) (cadr lo_l_c))

    pt2a (list (car pt1a) (cadr up_r_c))

    pt1b (list (+ (* 2 inc) (car lo_l_c))

         (car (cdr lo_l_c))

     )

    pt2b (list (car pt1b) (cadr up_r_c))

    pt1c (list (+ (* 3 inc) (car lo_l_c))

         (car (cdr lo_l_c))

     )

    pt2c (list (car pt1c) (cadr up_r_c))

    pt1d (list (+ (* 4 inc) (car lo_l_c))

         (car (cdr lo_l_c))

     )

    pt2d (list (car pt1d) (cadr up_r_c))

    pt1e (list (+ (* 5 inc) (car lo_l_c))

         (car (cdr lo_l_c))

     )

    pt2e (list (car pt1e) (cadr up_r_c))

    pt1f (list (+ inc (car lo_l_c))

         (car (cdr lo_l_c))

     )

    pt2f (list (car pt1f) (cadr up_r_c))

    pt1g (list (+ (* 6 inc) (car lo_l_c))

         (car (cdr lo_l_c))

     )

    pt2g (list (car pt1g) (cadr up_r_c))

    pt1h (list (+ (* 7 inc) (car lo_l_c))

         (car (cdr lo_l_c))

     )

    pt2h (list (car pt1h) (cadr up_r_c))

    pt1i (list (+ (* 8 inc) (car lo_l_c))

         (car (cdr lo_l_c))

     )

    pt2i (list (car pt1i) (cadr up_r_c))

    pt1j (list (+ (* 9 inc) (car lo_l_c))

         (car (cdr lo_l_c))

     )

    pt2j (list (car pt1j) (cadr up_r_c))

    pt1k (list (+ (* 10 inc) (car lo_l_c))

         (car (cdr lo_l_c))

     )

    pt2k (list (car pt1k) (cadr up_r_c))

    pt1l (list (+ (* 11 inc) (car lo_l_c))

         (car (cdr lo_l_c))

     )

    pt2l (list (car pt1l) (cadr up_r_c))

)

;;

;;

;; Constructs a rectangle thatrepresents the outline of the grid and

;; all vertical grid lines.

;;

;;

(command "line"

     lo_l_c

     (subst (car up_r_c) (car lo_l_c) lo_l_c)

     up_r_c

     (subst (cadr up_r_c) (cadr lo_l_c) lo_l_c)

     "c"

     "line"

     pt1a

     pt2a

     ""

     "line"

     pt1b

     pt2b

     ""

     "line"

     pt1c

     pt2c

     ""

     "line"

     pt1d

     pt2d

     ""

     "line"

     pt1e

     pt2e

     ""

     "line"

     pt1g

     pt2g

     ""

     "line"

     pt1h

     pt2h

     ""

     "line"

     pt1i

     pt2i

     ""

     "line"

     pt1j

     pt2j

     ""

     "line"

     pt1k

     pt2k

     ""

     "line"

     pt1l

     pt2l

     ""

)

;;

;;

;; Calculates the horizontal grid lines and the intersections of

;; of the cam displacement graph with the grid, thus establishing the

;; location of the displacement graph.

;;

;;

(setq first_y_di

            (abs (-    (+ (* (cos (/ (* 30 pi) 180)) (/ fo_heigh 2))

                 (/ fo_heigh 2)

                )

                fo_heigh

             )

            )

     second_y_di

            (abs (-    (+ (* (cos (/ (* 60 pi) 180)) (/ fo_heigh 2))

                 (/ fo_heigh 2)

                )

                fo_heigh

             )

            )

     third_y_di    (/ fo_heigh 2)

     fourth_y_di

            (abs (-    (+ (* (cos (/ (* 120 pi) 180)) (/ fo_heigh 2))

                 (/ fo_heigh 2)

                )

                fo_heigh

             )

            )

     fifth_y_di

            (abs (-    (+ (* (cos (/ (* 150 pi) 180)) (/ fo_heigh 2))

                 (/ fo_heigh 2)

                )

                fo_heigh

             )

            )

     pt3a    (list (car lo_l_c)

             (setq fya (+ first_y_di (cadr lo_l_c)))

            )

     pt4a    (list (car up_r_c) fya)

     pt3b    (list (car lo_l_c)

             (setq fyb (+ second_y_di (cadr lo_l_c)))

            )

     pt4b    (list (car up_r_c) fyb)

     pt3c    (list (car lo_l_c)

             (setq fyc (+ third_y_di (cadr lo_l_c)))

            )

     pt4c    (list (car up_r_c) fyc)

     pt3d    (list (car lo_l_c)

             (setq fyd (+ fourth_y_di (cadr lo_l_c)))

            )

     pt4d    (list (car up_r_c) fyd)

     pt3e    (list (car lo_l_c)

             (setq fye (+ fifth_y_di (cadr lo_l_c)))

            )

     pt4e    (list (car up_r_c) fye)

)

;;

;;

;; Draws the horizontal lines and displacement diagram.

;;

;;

(command "line"

     pt3a

     pt4a

     ""

     "line"

     pt3b

     pt4b

     ""

     "line"

     pt3c

     pt4c

     ""

     "line"

     pt3d

     pt4d

     ""

     "line"

     pt3e

     pt4e

     ""

     "spline"

     lo_l_c

     (list (car pt1a) (cadr pt3a))

     (list (car pt1b) (cadr pt3b))

     (list (car pt1c) (cadr pt3c))

     (list (car pt1d) (cadr pt3d))

     (list (car pt1e) (cadr pt3e))

     (list (car pt1g) (cadr up_r_c))

     (list (car pt1h) (cadr pt3e))

     (list (car pt1i) (cadr pt3d))

     (list (car pt1j) (cadr pt3c))

     (list (car pt1k) (cadr pt3b))

     (list (car pt1l) (cadr pt3a))

     (list (car up_r_c) (cadr lo_l_c))

     ""

     ""

     ""

)

;;

;;

;; Prompts the user to select the location of the CAM profile.

;; Calculates the point defining the CAM profile. Draws the CAM

;; Profile.

;;

;;

(setq basepoint (getpoint "\nSelect location for cam profile : "))

(command

    "spline"

    (list (car basepoint) (+ (cadr basepoint) base))

    (list (- (car basepoint) (* (+ first_y_di base 0.05) 0.5))

     (+ (cadr basepoint)

         (* (+ first_y_di base 0.05) 0.866025403)

     )

    )

    (list (- (car basepoint)

         (* (+ second_y_di base 0.05) 0.866025403)

     )

     (+ (cadr basepoint) (* (+ second_y_di base 0.05) 0.5))

    )

    (list (- (car basepoint) (* (+ third_y_di base 0.05) 1))

     (+ (cadr basepoint) (* (+ third_y_di base 0.05) 0))

    )

    (list (- (car basepoint)

         (* (+ fourth_y_di base 0.05) 0.866025403)

     )

     (- (cadr basepoint) (* (+ fourth_y_di base 0.05) 0.5))

    )

    (list (- (car basepoint) (* (+ fifth_y_di base 0.05) 0.5))

     (- (cadr basepoint)

         (* (+ fifth_y_di base 0.05) 0.866025403)

     )

    )

    (list (car basepoint)

     (- (cadr basepoint) (+ fo_heigh base 0.05))

    )

    (list (+ (car basepoint) (* (+ fifth_y_di base 0.05) 0.5))

     (- (cadr basepoint)

         (* (+ fifth_y_di base 0.05) 0.866025403)

     )

    )

    (list (+ (car basepoint)

         (* (+ fourth_y_di base 0.05) 0.866025403)

     )

     (- (cadr basepoint) (* (+ fourth_y_di base 0.05) 0.5))

    )

    (list (+ (car basepoint) (* (+ third_y_di base 0.05) 1))

     (+ (cadr basepoint) (* (+ third_y_di base 0.05) 0))

    )

    (list (+ (car basepoint)

         (* (+ second_y_di base 0.05) 0.866025403)

     )

     (+ (cadr basepoint) (* (+ second_y_di base 0.05) 0.5))

    )

    (list (+ (car basepoint) (* (+ first_y_di base 0.05) 0.5))

     (+ (cadr basepoint)

         (* (+ first_y_di base 0.05) 0.866025403)

     )

    )

    (list (car basepoint) (+ (cadr basepoint) base))

    ""

    ""

    ""

    "circle"

    basepoint

    base

)

)

(princ "\nInsufficient Data Press enter to try again : ")

)

)

(princ "\nTo excute enter cam at the command prompt ")

(princ)

No comments:

Post a Comment