home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 8 / CDASC08.ISO / VRAC / SEP93CAD.ZIP / TIP898.LSP < prev    next >
Lisp/Scheme  |  1993-08-31  |  2KB  |  67 lines
  1. ; TIP898:  GARMENTS.LSP  Garments for a Closet   (C)1993, Watson Kilbourne
  2.  
  3. ; Draws row of random spaced garments for plan view of wardrobe closets
  4. ;
  5. (defun rn () ; Random number generator, from 1.200 to 2.199
  6.    (if (not sd) (setq sd (getvar "DATE")))
  7.    (setq md 65536 mx 25173 nc 13849 sd (rem (+ (* mx sd) nc) md))
  8.    (setq nx (+ 1.2 (/ sd md)))
  9. )
  10. (defun c:GARMENTS (/ ce om bm fr sp ep dx an wd tk p1 p2 p3 p4 px py)
  11.    (setq ce (getvar "CMDECHO"))
  12.    (setq om (getvar "OSMODE"))
  13.    (setq bm (getvar "BLIPMODE"))
  14.    (setq fr (getvar "FILLETRAD"))
  15.    (defun ne (ne)
  16.       (setvar "CMDECHO" ce)
  17.       (setvar "OSMODE" om)
  18.       (setvar "BLIPMODE" bm)
  19.       (setvar "FILLETRAD" fr)
  20.       (princ "\nFunction cancelled ")
  21.       (princ)
  22.    )
  23.    (setq oe *error* *error* ne)
  24.    (setvar "CMDECHO" 0)
  25.    (setvar "OSMODE" 0)
  26.    (while (= sp nil) (setq sp (getpoint "\nStart <CL> of garment row: ")))
  27.    (while (= ep nil) (setq ep (getpoint "\nEnd point of garment row: ")))
  28.    (setq dx (distance sp ep))
  29.    (setq an (angle sp ep))
  30.    (setq wd (getdist "\nEnter width for garments <Default = 1/3 row length>: "))
  31.       (if (= wd nil) (setq wd (/ dx 3)))
  32.    (setvar "BLIPMODE" 0)
  33.    (setvar "FILLETRAD" (/ wd 20))
  34.    (setq tk (/ wd 8)
  35.          p1 (polar sp (+ an (/ pi 2)) (/ wd 2))
  36.          p2 (polar p1 an tk)
  37.          p3 (polar sp (+ an (* pi 1.5)) (/ wd 2))
  38.          p4 (polar p3 an tk)
  39.          px p1 py p3
  40.    )
  41.    (while (not (or (> (distance p2 px) (- dx tk))
  42.                    (> (distance p4 py) (- dx tk ))))
  43.       (command ".PLINE" p1 "W" 0 0 p2 p4 p3 "C" ".FILLET" "P" "L")
  44.       (setq p1 (polar p1 an (* tk 1.2))
  45.             p2 (polar p1 an tk)
  46.             p3 (polar p3 an (* tk (rn)))
  47.             p4 (polar p3 an tk)
  48.       )
  49.       (command ".PLINE" p1 p2 p4 p3 "C" ".FILLET" "P" "L")
  50.       (setq p1 (polar p1 an (* tk (rn)))
  51.             p2 (polar p1 an tk)
  52.             p3 (polar p3 an (* tk 1.2))
  53.             p4 (polar p3 an tk)
  54.       )
  55.    )
  56.    (if (and (< (distance px p2) dx) (< (distance py p4) dx))
  57.        (command ".PLINE" p1 p2 p4 p3 "C" ".FILLET" "P" "L")
  58.    )
  59.    (setvar "FILLETRAD" fr)
  60.    (setvar "BLIPMODE" bm)
  61.    (setvar "OSMODE" om)
  62.    (setvar "CMDECHO" ce)
  63.    (setq *error* oe oe nil)
  64.    (princ)
  65. )
  66.  
  67.