home *** CD-ROM | disk | FTP | other *** search
/ Share Gallery 1 / share_gal_1.zip / share_gal_1 / GR / GR505.ZIP / LSP.EXE / NEWPLI.LSP < prev    next >
Text File  |  1989-09-10  |  4KB  |  131 lines
  1. ;    NEWPLINE is an lisp function for a new AutoCAD command.
  2. ;    Newpline prompts the user for a list of "control" points that
  3. ;    are the vertices of a Pline.  The user is prompted for the
  4. ;    starting direction of the Pline.  A command list is
  5. ;    constructed and evaluated, which draws the Pline.  A slow but
  6. ;    effective "drag" option has been implemented, to change the
  7. ;    shape of the Pline by dragging the starting direction.
  8. ;    Multiple Plines can be drawn using the same list of control
  9. ;    points, with different starting directions.
  10. ;    This function was originally created for use in drawing smooth
  11. ;    curves for boat hulls.
  12. ;
  13. ;    Written by Brad Zehring 73417,705  12/29/86
  14. ;    PC Consulting
  15. ;    1519 San Pascual  Santa Barbara, CA  93101 (805) 965-3160
  16. ;    Comments and suggestions are welcome.
  17.  
  18. ;    Get_start_ang returns the angle in degrees from point f_p
  19. ;    to a user-selected point.
  20.  
  21. (defun get_start_ang ()
  22.     (setq start_ang
  23.      (/ (* 180 (getangle f_p "\nTangent direction: ")) pi)
  24.     )
  25. )
  26.  
  27. ;    Get_point_list prompts for and creates a list of user-
  28. ;    selected points, variable point_list.  Variable f_p is bound
  29. ;    to the first point selected.  Point_list is reversed to
  30. ;    reflect the true order of points selected.
  31.  
  32. (defun get_point_list (/ x)
  33.     (setq point_list nil)
  34.     (setq x (getpoint "\nFrom point: "))
  35.     (setq f_p x)
  36.     (while x
  37.         (setq point_list (cons x point_list))
  38.         (setq x (getpoint "\nTo point: "))
  39.     )
  40.     (setq point_list (reverse point_list))
  41. )
  42.  
  43. ;    Make_quote_list takes one argument which must be a list, and
  44. ;    returns a list, variable quote_list, that quotes each element
  45. ;    from the original argument.
  46.  
  47. (defun make_quote_list (x / y)
  48.     (if (listp x)
  49.      (progn
  50.       (setq quote_list nil)
  51.       (setq x (reverse x))
  52.       (while x
  53.        (setq y (cons 'quote (list (car x))))
  54.        (setq quote_list (cons y quote_list))
  55.        (setq x (cdr x))
  56.       )
  57.      )
  58.      (prompt "\nArgument to Make_quote_list function not a list. ")
  59.     )
  60. )
  61.  
  62. ;    Make_com_list creates a Pline command list from the points
  63. ;    stored in quote_list and the direction obtained from
  64. ;    get_start_ang.
  65.  
  66. (defun make_com_list ()
  67.     (setq com_list
  68.      (append
  69.       (append '(command "pline")
  70.        (append (list (car quote_list) '"A" '"D" (get_start_ang))
  71.         (cdr quote_list)
  72.        )
  73.       )
  74.      '(""))
  75.     )
  76. )
  77.  
  78. ;    Drag_newpl implements a rudimentary and ***SLOW*** "drag"
  79. ;    feature.  Recommended only for fast AT class machines.
  80.  
  81. (defun drag_newpl (/ reading new_ang drag_test)
  82.     (setq drag_test
  83.      (strcase (getstring "\nDrag the arcs (y/n)? <Y>: "))
  84.     )
  85.     (if (= drag_test '"N") (setq drag_test nil) (setq drag_test t))
  86.     (while drag_test
  87.         (entdel (entlast))
  88.         (setq reading (grread t))
  89.         (setq new_ang
  90.          (/ (* 180 (angle f_p (cadr reading))) pi)
  91.         )
  92.         (setq com_list
  93.          (subst new_ang (nth 5 com_list) com_list)
  94.         )
  95.         (eval com_list)
  96.         (if (= (car reading) 3) (setq drag_test nil))
  97.     )
  98. )
  99.  
  100. (defun c:newpline ()
  101.     (setvar "cmdecho" 0)
  102.     (graphscr)
  103.     (get_point_list)
  104.     (make_quote_list point_list)
  105.     (setq user_test T)
  106.     (while user_test
  107.         (make_com_list)
  108.         (eval com_list)
  109.         (drag_newpl)
  110.         (setq user_test
  111.          (strcase
  112.           (getstring "\nTry again (y/n)? <Y>: ")
  113.          )
  114.         )
  115.         (if (= user_test '"N")
  116.          (setq user_test nil)
  117.           (progn
  118.            (setq user_test T)
  119.            (setq del_test
  120.             (strcase
  121.              (getstring "\nErase last pline (y/n)? <Y>: ")
  122.             )
  123.            )
  124.            (if (not (= del_test '"N"))
  125.               (command "erase" "l" "")
  126.            )
  127.           )
  128.         )
  129.     )
  130. )
  131. á(VyÄⁿRNDTGA  COM ╜ë'òY╛AROA     ARC ∞Ü&αR)ROBOT   ARC lá(vyτîkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk