home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p047 / 4.ddi / TY / PLAY.LSP < prev    next >
Encoding:
Text File  |  1990-03-17  |  1.1 KB  |  37 lines
  1. ;****** TY\PLAY.LSP ******  03-17-90 BJ
  2. (defun C:PLAY ( )
  3.   (setq wcy 1)
  4.   (while wcy
  5.     (setq mode (getint 
  6.       "\n 1.!-lay/2.cha-lay/3.f-/4.t- <or RETRUN for none>:"))
  7.     (if (null mode) (setq wcy nil))
  8.     (if (= mode 1) (command "layer" "?" "" ""))
  9.     (if (= mode 2) (clay))
  10.     (if (= mode 3) (progn (s-s02) (command "layer" "f" ss02 "")))
  11.     (if (= mode 4) (progn (s-s02) (command "layer" "t" ss02 "")))
  12.   )
  13. )
  14. ;-----------
  15. (defun s-s02 ( )
  16.   (setq s02 (substr (getstring "enter layer name --? <1>:") 1 1))
  17.   (if (= s02 "") (setq s02 "1"))
  18.   (setq ss02 (strcat "zx" s02 ",qc" s02 ",cc" s02 ",mc" s02))
  19.   (setq ss02 (strcat ss02 ",pm" s02 ",hz" s02 ",sj" s02))
  20. )
  21. ;------------
  22. (defun clay ( )
  23.   (setq ppp (ssget))
  24.   (setq s02 (substr (getstring "enter layer name --? <1>:") 1 1))
  25.   (if (= s02 "") (setq s02 "1"))
  26.   (setq wxr 0 n (sslength ppp))
  27.   (while (< wxr n)
  28.     (setq ss (entget (ssname ppp wxr)))
  29.     (setq s01 (substr (cdr (assoc 8 ss)) 1 2))
  30.     (setq s12 (strcat s01 s02))
  31.     (setq ss (subst (cons 8 s12) (assoc 8 ss) ss))
  32.     (entmod ss)
  33.     (setq wxr (1+ wxr))
  34.   )
  35. )
  36. ;------------
  37.