home *** CD-ROM | disk | FTP | other *** search
/ Current Shareware 1994 January / SHAR194.ISO / cad_util / v8n8_cad.zip / BLEDIT.LSP next >
Lisp/Scheme  |  1993-07-23  |  1KB  |  40 lines
  1. (defun c:bledit ( / blk ent ent_lst ent_def old new)
  2.   (setq blk (nentsel "\nSelect block: "))
  3.   (while (/= nil blk)
  4. ;
  5. ;(cadddr blk) is only present when nentsel selects an ;entity
  6. ;that is nested within a block.
  7. ;
  8.    (if (= nil (cadddr blk)) (alert "Not a block.")
  9.      (progn
  10.        (setq ent_lst (list (last (last blk))))
  11.        (setq ent (cdr (last (tblsearch "block" (cdr (assoc 2 (entget (car ent_lst))))))))
  12. ;
  13. ;Steps through nested entity data extracting all blocks
  14. ;and adding their entity name to the ent_lst variable
  15. ;
  16.         (while (/= nil ent)
  17.           (if (= "INSERT" (cdr (assoc 0\(entget ent))))
  18.             (setq ent_lst (append ent_lst (list (cdar (entget ent)))))
  19.           )
  20.           (setq ent (entnext ent))
  21.         )
  22. ;
  23. ;Steps backwards through list of entity names and ;prompts for new layer.
  24. ;Last entity prompted is main block. This causes the ;redraw to
  25. ;display the changes on the screen.
  26. ;
  27.       (foreach ent (reverse ent_lst)
  28.         (setq ent_def (entget ent) old (assoc 8 ent_def)
  29.             new (cons 8 (getstring (strcat "\nNew layer             for block " (cdr (assoc 2 ent_def)) " <"(cdr         old) ">: "))))
  30.           (if (= "" (cdr new)) (setq new old))
  31.           (setq ent_def (subst new old ent_def))
  32.           (entmod ent_def) (redraw ent)
  33.         )
  34.       )
  35.     )
  36.     (setq blk (nentsel "\nSelect block: "))
  37.   );end while
  38. (prin1))
  39.  
  40.