;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; ;;;;
;;;; Copyright (c) Jun. 1996 by Takehiko Nagakura. ;;;;
;;;; All rights reserved. ;;;;
;;;; ;;;;
;;;; Do not copy, use, modify or distribute this software ;;;;
;;;; without written permission by Nagakura. Nagakura will ;;;;
;;;; not be responsible for any consequence of its use. ;;;;
;;;; ;;;;
;;;; Takehiko Nagakura (e-mail:
takehiko@mit.edu) ;;;;
;;;; Massachusetts Institute of Technology ;;;;
;;;; 77 Massachusetts Ave. 10-472M, Cambridge, MA 02139 ;;;;
;;;; ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Last updated Jan 1, 1997 by TN
;;This program demonstrates the use of AutoCAD commands,
;; car cdr append cons foreach mapcar apply
;;
;;It provides a function to draw a parabolic arch, which is
;;given by a simple formula,
;;
;; Y = - a XX + h
;; Functions and arguments
;;
;; (pline_from_points_1 point_list)
;; (pline_from_points_2 point_list)
;; (pline_from_points_3 point_list)
;; (get_coefficient wide high)
;; (draw_parabola wide high num_div)
;; (c:demo)
;;
; (defun c:r () (load "list_01.lsp"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Sets up layers
(command "cmdecho" 0)
(command "layer" "make" "connect" "color" 8 "connect" "") ; color 8 is gray
(command "layer" "make" "outline" "color" "white" "outline" "")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; The following 3 functions draw a pline from the give list of
; 2D points.
; The first version uses the AutoLISP function, 'repeat.
(defun pline_from_points_1 (point_list / num_pts counter)
(setq num_pts (length point_list)) ; total number of points
(setq counter 0) ; resets the counter
(command "pline") ; starts pline command
(repeat num_pts
(command (nth counter point_list)) ; extract the nth point
(setq counter (+ counter 1)) ; increment the counter
) ; end of repeat
(command "") ; finish the pline command
)
; (setq pl '((-5.0 0.0) (-2.5 15.0) (0.0 20.0) (2.5 15.0) (5.0 0.0)))
; (pline_from_points_1 pl) ; use this for test
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Another way of doing the same thing as 'pline_from_points_1.
; This time, I will use WHILE and a diminishing point list.
(defun pline_from_points_2 (point_list)
(command "pline") ; starts pline command
(while point_list
(command (car point_list)) ; always extract the first point
(setq point_list (cdr point_list)) ; get rid of the first point from the list
)
(command "")
)
; (pline_from_points_2 pl) ; use this for test
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Yet another way of doing the same thing as 'pline_from_points_1.
; It demonstrates the use of AutoLISP functions, 'apply and 'append.
(defun pline_from_points_3 (point_list / arg_list)
; arg_list is a list looking like ("pline" '(x1 y1) '(x2 y2) ..... "")
; this is the arguments required for "command" command next.
(setq arg_list
(append (list "pline") point_list (list "")))
; this does the same thing as (command pline" '(x1 y1) '(x2 y2) ..... "")
(apply 'command arg_list)
)
; (pline_from_points_3 pl) ; use this for test
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;This computes the parabola's coefficient values from the given
;wide and high of the parabola
; formula is Y = - a XX + h
; when X=0, Y = high
; when X=w/2, Y = 0
(defun get_coefficient (wide high / h a)
(setq h high)
(setq a (/ (* 4.0 high) (* wide wide)))
(list a h) ; returns a list whose first item is a's value and second is h's.
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;This draws the parabola of the given width and height. It has
;num_div points on the upper and lower outlines connected by
;lines.
;This function demostrates the use of AutoLISP functions,
; mapcar, foreach, nth
(defun draw_parabola (wide high num_div
/ a h upper_points lower_points double_points
x_inc x y pt )
(command "layer" "set" "outline" "")
;1] get the coefficient values for the equation
(setq coef (get_coefficient wide high)) ; this returns a list of a and h's values
(setq a (nth 0 coef)) ; takes out the first value for a
(setq h (nth 1 coef)) ; takes out the second value for h
;2] resets some local variables
(setq counter 0)
(setq upper_points nil)
(setq lower_points nil)
;3] repeat to create a series of points on the parabola
; points are stored in 'upper_points
; First, computes the increment for x
(setq wide (* wide 1.0)) ; make sure this is a real number and
; not an integer before division below
(setq x_inc (/ wide (* num_div)))
; Then, repeat to make the series of points on the parabola
(repeat (+ 1 num_div)
(setq x (- (/ wide 2.0) (* counter x_inc))) ; x decrements by x_inc in each loop
(setq y (+ (* (- a) x x) h)) ; formula is Y = - a XX + h
(setq pt (list x y))
(setq upper_points (cons pt upper_points)) ; this list grows in each loop
(setq counter (+ 1 counter))
) ;end repeat
(pline_from_points_1 upper_points) ;draw lines between the upper points
;4] make the points on the lower side of the arch by
; scaling the y-coordinates of the upper points by 0.85
(setq lower_points
(mapcar '(lambda (pt) ; this keeps x and scales the y of a point
(list (nth 0 pt) (* 0.85 (nth 1 pt))))
upper_points)
)
(pline_from_points_1 lower_points) ;draw lines between the lower points
;5] connect the upper points and lower points
(setq double_points (mapcar '(lambda (pt_u pt_l) (list pt_u pt_l))
upper_points lower_points))
(command "layer" "set" "connect" "")
(foreach 2pts double_points
(command "line" (nth 0 2pts) (nth 1 2pts) ""))
upper_points ; returns the points on the parabola
) ; end defun
;(draw_parabola 10 20 4)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:demo ()
(command "ucs" "world")
(command "plan" "")
(command "zoom" "window" (list -10 -5) (list 35 20))
;(command "ucs" "origin" (list 0 0))
(draw_parabola 5 7 20)
(command "ucs" "origin" (list 8 0))
(draw_parabola 5 7 4)
(command "ucs" "origin" (list 8 0))
(draw_parabola 5 15 20)
(command "ucs" "origin" (list 10 0))
(draw_parabola 10 6 20)
(command "ucs" "world")
(command "regen")
)
Tue Aug 21, 2007 10:20 pm
