home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p047 / 4.ddi / TY / HARRAY.LSP < prev    next >
Encoding:
Text File  |  1989-01-17  |  1.3 KB  |  53 lines
  1. ;*******TY\HARRAY.LSP****** 10-17-89
  2. (if (null ls1) (setq ls1 "ls1"))
  3. ;----------
  4. (defun C:HARRAY ( )
  5.   (if (listp ls1) (princ ls1) (mls1))
  6.   (setq wcy 1)
  7.   (while wcy
  8. (setq wxr (getint "\n 1.Mls1/2.Vcopy/3.Hcopy<or RETURN for none>:"))
  9.     (if (null wxr) (setq wcy nil))
  10.     (if (= wxr 1) (mls1))
  11.     (if (= wxr 2) (vcopy))
  12.     (if (= wxr 3) (hcopy))
  13.   )
  14. )
  15. (defun mls1 ( )
  16.   (setq wxr 1 ls1 (list "ls1"))
  17.   (if (or (= mmm "m") (= mmm "M")) (prompt "!mmm=m,"))
  18.   (while wxr
  19.     (setq ll (getreal "\n enter ll <or RETURN for continue>:"))
  20.       (if (null ll) (setq wxr nil) (setq ls1 (cons ll ls1)))
  21.   )
  22.   (setq ls1 (reverse ls1))
  23. )
  24. ;----------
  25. (defun vcopy ( )
  26.   (setq ppp (ssget))
  27.   (setq wxr 1 adl 0.0 n 1)
  28.   (setq af (getangle "\n enter angle <0>:"))
  29.     (if (null af) (setq af 0)) (setq ra (* (/ af pi) 180.0))
  30.   (while wxr
  31.     (setq dl (nth n ls1))
  32.     (if (= dl nil) (setq wxr nil) (progn 
  33.       (setq adl (+ adl dl))
  34.       (command "copy" ppp "" '(0 0) (polar '(0 0) af adl))
  35.       (setq n (1+ n)))
  36.     )
  37.   )
  38. )
  39. ;----------
  40. (defun hcopy ( )
  41.   (setq ppp (ssget))
  42.   (setq wxr 1 adl 0.0 n 1)
  43.   (while wxr
  44.     (setq dl (nth n ls1))
  45.     (if (= dl nil) (setq wxr nil) (progn 
  46.       (setq adl (+ adl dl))
  47.       (command "copy" ppp "" '(0.0 0 0) (list 0 0 adl))
  48.       (setq n (1+ n)))
  49.     )
  50.   )
  51. )
  52. (princ)
  53.