home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p047 / 4.ddi / TY / PPLIST.LSP < prev    next >
Encoding:
Text File  |  1988-10-30  |  1.2 KB  |  52 lines
  1. ;*******TY\PPLIST.LSP******
  2. (if (null lst) (setq lst "ll1"))
  3. ;----------
  4. (defun C:MPPLSt ( )
  5.   (mpplst0)
  6. )
  7. (defun mpplst0 ( )
  8.   (setq wcy 1 pplst (list "pp1"))
  9.   (while wcy
  10.     (setq pt (getpoint "\n enter point <or RETURN none>:"))
  11.       (if (null pt) (setq wcy nil) (setq pplst (cons pt pplst)))
  12.   )
  13.   (setq pplst (reverse pplst))
  14. )
  15. ;----------
  16. (defun C:LCPPP1 ( )
  17.   (setq ppp (ssget))
  18.   (setq bp (getpoint "Base point:"))
  19.   (mpplst0)
  20.   (lcppp0)
  21. )
  22. (defun C:LCPPP ( )
  23.   (setq bp (getpoint "Base point:"))
  24.   (lcppp0)
  25. )
  26. (defun lcppp0 ( )
  27.   (setq k 1)
  28.   (while k
  29.     (setq pt (nth k pplst))
  30.     (if (= pt nil) (setq k nil) (progn 
  31.       (command "copy" ppp "" bp pt)
  32.       (setq k (1+ k))))
  33.   )
  34. )
  35. ;----------
  36. (defun C:LIPPP ( )
  37.   (setq bname (getstring "\n Block name:"))
  38.   (setq xs (getreal "\n X scale factor <1>:"))
  39.     (if (null xs) (setq xs 1.0))
  40.   (setq ys (getreal "\n Y scale factor <default=X>:"))
  41.     (if (null ys) (setq ys xs))
  42.   (setq ra (getreal "\n Rotation angle <0>:"))
  43.     (if (null ra) (setq ra 0.0))
  44.   (setq k 1)
  45.   (while k
  46.     (setq pt (nth k pplst))
  47.     (if (= pt nil) (setq k nil) (progn
  48.     (command "insert" bname pt xs ys ra)
  49.     (setq k (1+ k))))
  50.   )
  51. )
  52.