home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1993 #2 / Image.iso / cad / jun93.zip / TIP880B.LSP < prev   
Lisp/Scheme  |  1993-05-19  |  3KB  |  65 lines
  1. ;TIP 880B:  XTRACTT.LSP (C)1993, ROBERT L. ZIPPRICH
  2.  
  3.  
  4. ;------------------------------------------------------------------
  5. ;  User selects block and XTRACTT creates an attribute template file
  6. ;and an attribute prompt file, both with the same name as the block,
  7. ;(i.e. "ETBLOCK.TXT" and "ETBLOCK.DEF").  This function searches the
  8. ;drawing block table for the selected entity and its associated
  9. ;attributes.
  10. ;  The difference between XTRACT and XTRACTT being that the block
  11. ;table may contain a different definition of attributes than an
  12. ;inserted block.  Default values are 8 characters for the block name,
  13. ;X and Y coordinate fields of 7 digits rounded to .1 decimal place,
  14. ;and 20 characters for a prompt description.
  15. ;------------------------------------------------------------------
  16. (defun C:XTRACTT ()
  17.    (Setq BLK    (car (entsel "Select Block: "))
  18.          DATA   (entget BLK)
  19.          NAME   (cdr (assoc 2 DATA))
  20.          TBLENT (tblsearch "block" name)
  21.          BLK    (cdr (assoc -2 tblent))
  22.          file    (open (strcat name ".txt") "w")
  23.          file2   (open (strcat name ".def") "w")
  24.          blkname (strcat "BL:" name "                    ")
  25.          blkname (substr blkname 1 20)
  26.          blkname (strcat blkname "C008000")
  27.    )
  28.          (write-line blkname file)
  29.          (write-line         "Attribute Tag Names, Defaults, Prompts" file2)
  30.          (write-line (strcat "for: " name " in " 
  31.            (getvar "dwgname") ".DWG")  file2)
  32.          (write-line "" file2)
  33.          (write-line "  TAG          DEFAULT                  PROMPT" file2)
  34.          (write-line "" file2)
  35.          (write-line "BL:X                N007001" file)
  36.          (write-line "BL:Y                N007001" file)
  37.  
  38.    (while blk
  39.          (setq DATA (entget BLK))
  40.          (if (eq "ATTDEF" (cdr (assoc 0 data)))
  41.              (progn
  42.                (setq dflt (cdr (assoc 1 data))
  43.                      tag  (cdr (assoc 2 data))
  44.                      def  (cdr (assoc 3 data))
  45.                      dflt (strcat dflt "                       ")
  46.                      dflt (substr dflt 1 20)
  47.                      tag  (strcat tag "                       ")
  48.                      tag  (substr tag 1 14)
  49.                      tag2 (strcat tag "C020000")
  50.                )
  51.                (write-line tag2 file)
  52.                (write-line (strcat tag dflt def) file2)
  53.                (setq blk   (entnext blk))
  54.              )
  55.              (progn
  56.                  (setq blk (entnext blk))
  57.              )
  58.          ) ;end if
  59.    ) ;end while
  60.    (close file)
  61.    (close file2)
  62. ) ;end xtractt
  63. ;-------------------------------------------------------------
  64. cadlst29.ltr
  65.