home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1993 #2 / Image.iso / cad / jun93.zip / TIP880A.LSP < prev    next >
Lisp/Scheme  |  1993-05-19  |  2KB  |  49 lines
  1. ;TIP 880A:  XTRACT.LSP (C)1993, ROBERT L. ZIPPRICH
  2.  
  3.  
  4. ;-----------------------------------------------------------------
  5. ;  User selects block and XTRACT creates an attribute template file
  6. ;with the same name as the block, (i.e. "ETBLOCK.TXT").
  7. ;  This function searches the selected entity for attributes.
  8. ;------------------------------------------------------------------
  9. (defun C:XTRACT ()
  10.    (Setq BLK   (car (entsel "Select Block: "))
  11.          DATA  (entget BLK)
  12.          NAME  (cdr (assoc 2 DATA))
  13.          Ental (Entget BLK))
  14.           (if (eq 1 (CDR (Assoc 66 Ental)))
  15.              (progn
  16.                (setq file    (open (strcat name ".txt") "w")
  17.                      blkname (strcat "BL:" name "                    ")
  18.                      blkname (substr blkname 1 20)
  19.                      blkname (strcat blkname "C008000"))
  20.                (write-line blkname file)
  21.                (write-line "BL:X                N007001" file)
  22.                (write-line "BL:Y                N007001" file)
  23.                (setq blk   (entnext blk)
  24.                      DATA  (entget BLK)
  25.                      Ental (entget BLK)
  26.                      l     (cdr (assoc 0 data))
  27.                )
  28.                (while (eq l "ATTRIB")
  29.                  (setq tag  (cdr (assoc 2 data))
  30.                        tag  (strcat tag "                    ")
  31.                        tag  (substr tag 1 20)
  32.                        tag  (strcat tag "C020000")
  33.                  )
  34.                  (write-line tag file)
  35.                  (setq blk   (entnext blk)
  36.                        DATA  (entget BLK)
  37.                        EntAL (Entget BLK)
  38.                        l     (cdr (assoc 0 data))
  39.                  )
  40.                )
  41.                (close file)
  42.              )
  43.              (progn
  44. ;               (close file)
  45.                (prompt "\n Entity has no attributes!")
  46.              )
  47.           )
  48. ) ;end xtract
  49.