home *** CD-ROM | disk | FTP | other *** search
/ Share Gallery 1 / share_gal_1.zip / share_gal_1 / GR / GR505.ZIP / LSP.EXE / BLKUPD.LSP < prev    next >
Lisp/Scheme  |  1989-09-06  |  3KB  |  73 lines
  1. ;  BLKUPD.LSP
  2. ;
  3. ;  by Mark W. Stayton  [72140,365]
  4. ;
  5. ;  This routine will re-insert blocks with attributes into a drawing that
  6. ;  contains earlier versions of blocks with the same name.  Developed as a
  7. ;  result of cosmetic changes to blocks in an existing application that
  8. ;  required older drawings to be updated with the new blocks.
  9. ;
  10. ;  NOTE:  This won't change the insertion point, style (including justification)
  11. ;         or height of the attribute text entities if they've been changed from
  12. ;         those of the originally inserted block.
  13.  
  14.  
  15. ;     List of Block Names (with Attributes) to be Updated
  16. ;     Block names in this list must be all upper case
  17.  
  18.  
  19. (setq block_list '("BLOCK1" "BLOCK2" "BLOCK3" "BLOCKN"))       ;  Change this list to the block names
  20.                                                                ;  you're updating.
  21.  
  22. ;     Return contents of entity field "num"
  23. ;     (from the AutoLISP Release 9.0 Programmer's Reference Manual, Pg. 73)
  24.  
  25.  
  26. (defun fld (num)
  27.   (cdr (assoc num d))
  28. )
  29.  
  30.  
  31. ;     Block Update Procedure
  32.  
  33.  
  34. (defun C:BLKUPD(/ sset sslen loaded i newblk first)
  35.   (setvar "CmdEcho" 0)
  36.   (princ "\nUpdating blocks...")
  37.   (setq sset (ssget "X" '((66 . 1))))          ;  Get all blocks with attributes
  38.   (setq sslen (sslength sset))                 ;  Number of entities in selection set
  39.   (setq loaded nil)                            ;  Initialize set of duplicate blocks
  40.   (command "RegenAuto" "Off")                  ;  Don't regen until we're done updating
  41.   (setq i 0)                                   ;  Initialize counter
  42.   (setq first T)
  43.   (while (< i sslen)
  44.      (setq e (ssname sset i))                  ;  Get a block entity
  45.      (setq d (entget e))                       ;  Get the block's attribute subentity
  46.      (if (and (member (fld 2) block_list)      ;  Is the block name in the list?
  47.               (not (member (fld 2) loaded))    ;  Has it been loaded already?
  48.          )
  49.          (progn                                ;  No,
  50.             (setq newblk (fld 2))              ;  so get the block name to reload
  51.             (command "Insert" (strcat newblk "="))
  52.             (command)
  53.             (if first                          ;  If it's the first block updated,
  54.                 (progn                         ;  then create the "loaded" list
  55.                    (setq loaded (list newblk))
  56.                    (setq first nil)
  57.                 )
  58.                 (setq loaded (cons newblk loaded))  ;  If not the first, then add it to the list
  59.             )
  60.          )
  61.      )
  62.      (setq i (1+ i))                                ;  Increment the counter
  63.   )
  64.   (command "RegenAuto" "On")                        ;  We're done, so regen the drawing
  65.   (if (null loaded)                                 ;  Send the appropriate message
  66.       (princ "\nNo matching blocks found")
  67.       (princ "\nBlock update completed")
  68.   )
  69.   (setvar "CmdEcho" 1)
  70.   (prin1)                                           ;  and exit clean
  71. )
  72.  
  73.