home *** CD-ROM | disk | FTP | other *** search
/ BUG 15 / BUGCD1998_06.ISO / aplic / felixcad / fcaddata.z / FLX_PLAY.LSP < prev    next >
Lisp/Scheme  |  1997-12-01  |  2KB  |  81 lines
  1. ;;; FLX_PLAY.LSP
  2. ;;; ================================================================
  3. ;;; Provided by FELIX Computer Aided Technologies GmbH 1995-96
  4. ;;; ================================================================
  5. ;;; Created: Jan 20, 1996 vp
  6. ;;; Changed: Sep 29, 1996 vp
  7. ;;;          Nov 07, 1997 ht
  8. ;;; ================================================================
  9. ;;; This file is called by FLX_MAIN.LSP
  10. ;;; ================================================================
  11.  
  12. (defun FLX_PROPLAYER( / DlgInit ent entlst plyent sl laylst newlay selset idx)
  13.  
  14.     ;;; Dialog Initialization Function
  15.  
  16.     (defun DlgInit ( / s1)
  17.      (if FLX$WIN95 (foreach n 
  18.              '("IDCANCEL" "IDOK" "IDHELP" "layer" "Static1")
  19.          (Dlg_TileSetFont n 2)
  20.      ))
  21.      (Dlg_TileAction "IDCANCEL" "(setq newlay nil)(DLG_DialogDone)")
  22.      (Dlg_TileAction "IDOK" "(setq newlay (Dlg_TileGet \"layer\")) (DLG_DialogDone)")
  23.      (Dlg_TileAction "layer" 
  24.         "(if (= $reason 4) (progn (setq newlay (Dlg_TileGet \"layer\")) (DLG_DialogDone)))"
  25.      )
  26.      (setq laylst '())
  27.      (if (setq s1 (tblnext "LAYER" T)) (progn
  28.          (setq laylst (cons (cdr (assoc 2 s1)) laylst))
  29.          (while (setq s1 (tblnext "LAYER")) 
  30.              (setq laylst (append laylst (list (cdr (assoc 2 s1)))))
  31.          )
  32.      ))
  33.          (Dlg_ListAction "layer" laylst)
  34.      )
  35.  
  36.     ;;; Main
  37.  
  38.     (FLX_FUNC_INIT)
  39.     (setq selset (ssget))
  40.     (if (eq (type selset) 'PICKSET) 
  41.      (progn 
  42.       (if (FLX_DLGDSP "flx_dlg" "LayerModify" "(princ)" "(DlgInit)") (princ) (exit))
  43.       (if (eq (type newlay) 'STR)
  44.     (progn
  45.         (setq     newlay (nth (atoi newlay) laylst) 
  46.              newlay (cons 8 newlay)
  47.              idx (sslength selset)                                
  48.         )
  49.         (while 
  50.             (and 
  51.                 (<= 0 (setq idx (1- idx)))
  52.                 (setq ent (ssname selset idx))
  53.                 (setq entlst (entget ent))
  54.             ) 
  55.             (entmod (subst newlay (assoc 8 entlst) entlst))
  56.             (if 
  57.                 (= "POLYLINE" (cdr (assoc 0 entlst)))
  58.                 (progn
  59.                     (setq plyent ent)
  60.                     (while
  61.                        (and
  62.                         (/= "SEQEND" (cdr (assoc 0 entlst)))
  63.                         (setq ent (entnext ent))
  64.                         (setq entlst (entget ent))
  65.                       )
  66.                         (entmod (subst newlay (assoc 8 entlst) entlst))
  67.                 )
  68.             )
  69.             (entupd plyent)
  70.         )
  71.       )
  72.     ) 
  73.        )
  74.       )
  75.     )             
  76.     (FLX_FUNC_EXIT)
  77.     (princ)
  78. )
  79.  
  80. (princ)
  81.