I've long used specific routines for specific blocks with block names and tagstrings hard coded.
This single routine replaces several of the others by by presenting attribute data in a dialog on the fly.
Nothing new, I know, but the dialog allows you to toggle the attributes that you want to map to other instances of the block.
;;; ATTMAP.LSP
;;; Without reinventing the wheel, I've added a re-tread for better milaage...
;;;
;;; Thanks to AfraLisp.com and the Swamp.org
;;; The code is mostly a 're-tooling' of DCLATT.LSP Written by Kenny Ramage & Stig Madsen - May 2002
;;; Most of the subroutines are examples of Ken & Stig's fine work and in their original form.
;;; A clip of the disclaimer follows:
;;;
;;; " All Tutorials and Code are provided "as-is" for purposes of instruction and
;;; utility and may be used by anyone for any purpose entirely at their own risk.
;;; Please respect the intellectual rights of others.
;;; All material provided here is unsupported and without warranty of any kind.
;;; No responsibility will be taken for any direct or indirect consequences
;;; resulting from or associated with the use of these Tutorials or Code.
;;;
;;; AfraLisp
;;; http://www.afralisp.com
;;; afralisp@afralisp.com
;;; afralisp@mweb.com.na "
;;;
;;; I have only modified enough to provide for mapping selected atts to blocks with like atts.
;;; Purpose:
;;; Edit the att vals of a block then map selected att vals to blocks having like atts.
;;; Useful when many blocks need att vals revised to the same value.
;;; Notes:
;;; Error checking = nil
;;; A directory path: "C:\Temp" is necessary for writing and invoking the temporary dcl file.
;;; The dialog is made on the fly by mapping the att info of the source block to a temp dcl file.
;;; So, this should work with any normal attributed block (well, so far, anyway) notwithstanding...
;;; The number of atts displayed in the dialog box will be subject to hardware limitations.
;;; I have been successful with 18 thus far. I haven't had need for more.
;;; The temp dcl file is deleted upon exiting the dialog box.
;;; Usage:
;;; Load the routine from a search path by typing (load "ATTMAP") at the command prompt.
;;; Enter "attmap" on the commandline.
;;; Select a "source" block (i.e. the block which will be used to provide the att tags/vals).
;;; A dialog box, listing the available atts, will be invoked.
;;; Edit the values as desired.
;;; If no mapping is desired, select the "OK" button to exit the dialog box.
;;; The "source" block will be updated with the att vals of the dialog box.
;;; If mapping is desired, toggle the desired atts to "ON" in the dialog box.
;;; Select the "OK" button to exit the dialog box.
;;; You will be promted (at the commandline) to select the target blocks for mapping.
;;; Use any selection method you like to select blocks with like atts.
;;; The selection set will be filtered for "INSERTS" that have attributes.
;;; Each member of the sset with like atts
;;; will be updated with the toggled att vals of the dialog box.
;;;
;;; With additional thanks to:
;;; The Swamp.org > 99% of my programming inspiration comes from there.
;;;
;;; Permissions:
;;; All are free to use, modify..etc.
;;;
;;; Platforms:
;;; I am limited to ADT 3.3 on Acad 2002 at work, so, most of my routines are written accordingly.
;;; Tested on Acad 2002,only.
;;;
;;; Version:
;;; 1.0 - 01.03.10 - FIRST RELEASE
;;; 2.0 - -
;;; 3.0 - -
;;;=====================================================================================================
(defun c:attmap (/ atts2map cntr dcl_id dlg-vals fn fname indx key-lst l lg map-targs nu relist
taglist targs-ss tggls tg-lst theblock theblocko thelist trgnam txtlist x y z)
;start fresh by clearing possible values from required variables
(foreach xi '(atts2map cntr dcl_id dlg-vals fn fname indx key-lst l lg map-targs nu
relist taglist targs-ss tggls tg-lst theblock theblocko thelist trgnam
txtlist x y z) (set xi nil))
(vl-load-com)
(setq theblock (car (entsel))) ;get the source block entity name
(setq theblockO (vlax-ename->vla-object theblock)) ;convert to vl object
(if (= (vlax-get-property theblockO 'objectname) "AcDbBlockReference")
;check if it's a block; if it is, do the following
(progn
(if (= (vlax-get-property theblockO 'hasattributes) :vlax-true)
;check if it has attributes ;if it has attributes, do the following
(progn
(getattmap theblockO) ;get the attributes
(create_attmap_dialog) ;create the dialog
(run_attmap_dialog) ;run the dialog
(upattmap)) ;update the attributes ;if No attributes, alert the user
(alert "This Block has No Attributes!! - Please try again.")))
(alert "This is not a Block!! - Please try again.")) ;if it's not a block, alert the user
;if atts were toggled in the dialog box,
; map the selected attributes to the selected blocks
(if atts2map
(progn (setq map-targs nil targs-ss nil)
(setq targs-ss (ssget '((0 . "INSERT") (66 . 1))))
(setq indx 0)
(while (setq trgnam (ssname targs-ss indx))
(setq map-targs (append map-targs (list trgnam)))
(setq indx (1+ indx)))
(foreach xi map-targs
(foreach ix atts2map (matt_putone xi (car ix) (strcase (cadr ix))))))
(princ "\n No atts were selected for mapping."))
(princ))
;;;================= edit one attribute ==========================================
(defun matt_putone (en tag new / el) ; variables are cleared in the main routine
(setq en (entnext en) el (entget en))
(while
(and (= (cdr (assoc 0 el)) "ATTRIB") (/= (cdr (assoc 2 el)) tag))
(setq en (entnext en) el (entget en)))
(if (= (cdr (assoc 0 el)) "ATTRIB")
(progn (entmod (subst (cons 1 new) (assoc 1 el) el)) (entupd en))))
;retrieve the attributes
(defun getattmap (enam /) ; variables are cleared in the main routine
(setq thelist (vlax-safearray->list (variant-value (vla-getattributes enam))))
(foreach n thelist ;process each attribute
(setq taglist (cons (vla-get-tagstring n) taglist) ;get the tag attribute data
txtlist (cons (vla-get-textstring n) txtlist) ;get the text attribute data
lg (length taglist))) ;how many attributes?
(setq taglist (reverse taglist) ;reverse the lists
txtlist (reverse txtlist))
(setq tg-lst (mapcar '(lambda (x y z) (list x y z)) tggls taglist txtlist)))
(defun create_attmap_dialog () ; variables are cleared in the main routine
(setq fname "c:\\temp\\attmap.dcl") ;create a temp DCL file
(setq fn (open fname "w")) ;open it to write
;write the dialog header
(write-line "attmap:dialog { label = \"Edit/Map Attributes\";" fn)
(setq nu 0) ;reset the incremental control number
(repeat lg ;start the loop to create the edit boxes
(write-line
(strcat ":row {" ":toggle {" (strcat "key=\"tg" (itoa nu) "\";}") " :edit_box {"
(strcat " key=" (strcat "\"" "eb" (itoa nu) "\"" ";"))
(strcat " label=" "\"" (nth nu taglist) "\"" ";")
(strcat " value = " "\"" (nth nu txtlist) "\"" ";")
" alignment=left; edit_width=30;}" "}") fn)
(setq nu (1+ nu))) ;increment the counter
(write-line ":row {spacer_1;}" fn)
(write-line ":row {spacer_1; ok_only; spacer_1;}}" fn)
(close fn)) ;close the internal file
;load the dialog file and definition
(defun run_attmap_dialog (); variables are cleared in the main routine
(setq key-lst nil dlg-vals nil)
(defun get-dlg-vals () ;subroutine to get all dialog vals
(setq cntr 0 key-lst nil)
(repeat lg
(setq key-lst (append key-lst (list
(list (strcat "tg" (itoa cntr)) (strcat "eb" (itoa cntr))))))
(setq cntr (1+ cntr)))
(setq cntr 0 dlg-vals nil)
(foreach xi key-lst
(setq dlg-vals (append dlg-vals (list (list
(car xi) (strcase (get_tile (car xi)))
(get_attr (cadr xi) "label") (get_tile (cadr xi)))))))
(setq cntr 0 atts2map nil)
(foreach xi dlg-vals
(if (= (cadr xi) "1")
(setq atts2map (append atts2map (list (list (caddr xi) (last xi))))) nil))
);end sub
(setq dcl_id (load_dialog fname))
(mode_tile "eb0" 2)
(if (not (new_dialog "attmap" dcl_id)) (exit))
(action_tile "accept" "(get-dlg-vals)(retattmap)") ;if the OK button is selected
(start_dialog) ;start the dialog
(unload_dialog dcl_id) ;unload the dialog
(vl-file-delete fname)) ;delete the temp DCL file
(defun retattmap () ; variables are cleared in the main routine
(setq nu 0) ;reset the increment counter
(repeat lg ;start the loop
(setq l (get_tile (strcat "eb" (itoa nu)))) ;retrieve the tile value
(setq relist (cons l relist)) ;add it to the list
(setq nu (1+ nu))) ;increment the counter
(setq relist (reverse relist))
(done_dialog))
(defun upattmap () ; variables are cleared in the main routine
(setq nu 0) ;reset the increment counter
(repeat lg ;start the loop
(vla-put-textstring (nth nu thelist) (strcase (nth nu relist))) ;update the attribute
(setq nu (1+ nu))) ;increment the counter
(vla-update theblockO)) ;update the block
;;; end