;;;---------------------------------------------------------------------;;;
;;; MatchAtts.lsp ;;;
;;; Created by Will DeLoach ;;;
;;; Copyright 2005 ;;;
;;; ;;;
;;;FUNCTION ;;;
;;;Creates a variable sized dialog box with attribute tagstrings from the;;
;;;the Source Attribute. The user selects the values they want to match;;;
;;;and then selects blocks withe same name as the source block and the ;;;
;;;selected attributes will be changed to match the source attribute. ;;;
;;; ;;;
;;;USAGE ;;;
;;;(load "matchatts) ;;;
;;;matchatts ;;;
;;; ;;;
;;;PLATFORMS ;;;
;;;Tested on 2006; but could work for earlier versions. ;;;
;;; ;;;
;;;VERSION ;;;
;;; 1.0 October 3, 2005 ;;;
;;; 1.01 October 4, 2005 Fixed Att Selection for Attributes only. ;;;
;;; 1.02 October 5, 2005 Fixed bug in cond statement ;;;
;;; 1.03 November 15, 2005 Replaced get_att SUBR (recmd by T. Willey);;;
;;; 1.1 April 6, 2006 Modifications made by CAB from theSwamp.org ;;;
;;; Fixed duplicate tagname bug. ;;;
;;; 1.11 Added the write_line function. ;;;
;;; 1.2 Fixed block selection to work with Dynamic Blocks. ;;;
;;; 1.21 Corrected an error with 'EffectiveName' assumption. ;;;
;;; ;;;
;;; ;;;
;;; THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED ;;;
;;; WARRANTY. ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR ;;;
;;; PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED. ;;;
;;; ;;;
;;; You are hereby granted permission to use, copy and modify this ;;;
;;; software without charge, provided you do so exclusively for ;;;
;;; your own use or for use by others in your organization in the ;;;
;;; performance of their normal duties, and provided further that ;;;
;;; the above copyright notice appears in all copies and both that ;;;
;;; copyright notice and the limited warranty and restricted rights ;;;
;;; notice below appear in all supporting documentation. ;;;
;;; ;;;
;;;---------------------------------------------------------------------;;;
(defun c:matchatts
(/ blk
;The entity name for the Reference Attribute
eblk ;Entity list of blk
atts ;List of attributes for 'blk'
tags ;List of 'tagstrings' for atts
keys ;List of 'handle' for atts
vals ;List of 'textstring' for atts
dcl_id ;Id number for the dialog box
dcl_name ;Name for the dialog box
strt ;Id from the done_dialog call
lst ;List of values for the toggles
ssa ;List of attributes the user selects
morder ;flag to chack att order, for future use
ename ;entity name
lst ;List of Keys
rname ;Reference Block Name
i ;Increment
)
;;;---------------------------------------------------------------------;;;
;;;A rewrite of the entsel function. ;;;
;;;---------------------------------------------------------------------;;;
(defun ent_sel
(msg
/ ent
) (princ "\nSelection missed. Please try again.") )
)
)
ent
)
;;;---------------------------------------------------------------------;;;
;;;This is a utility function to return Attribute References for the ;;;
;;;supplied object or entity name. ;;;
;;;---------------------------------------------------------------------;;;
)
;;;---------------------------------------------------------------------;;;
;;;This creates a variable dialog box that changes size based on how ;;;
;;;many attributes are passed to it. The dialog box is temporary and is;;;
;;;created on the fly. It is stored in your Acad Temp path location. ;;;
;;;---------------------------------------------------------------------;;;
(defun createdialog
(lst keys
/ num tfn fn wid cnt str
) ((> num
12) (setq wid
3)) )
(write_line
"temp : dialog { label = \"Match Attributes\";"
": boxed_column { label = \"Select Attributes Values to Match: \";"
": row {"
)
fn
)
"\""
str
"\""
"; key = "
"\""
"\""
";}"
)
fn
)
)
)
)
)
(write_line
"}"
"spacer_1;"
" : toggle { key = \"All\"; label = \"Select All\";}"
"}"
"ok_cancel;"
"}"
)
fn
)
tfn
)
;;;---------------------------------------------------------------------;;;
;;;This is the action for 'Select All' Check Box. ;;;
;;;---------------------------------------------------------------------;;;
(defun on_all_pick
(lst
/ str
) )
)
;;;---------------------------------------------------------------------;;;
;;;This takes two lists and compares the two. Every item in vals that ;;;
;;;equals "1" is replace with the corresponding item in objs. ;;;
;;;---------------------------------------------------------------------;;;
;;; CAB modified, create a list of pairs (tagname flag) where flag 1 0 t/nil
(defun create_list
(vals objs
) 1
0
)
)
)
vals
objs
)
)
)
;;;---------------------------------------------------------------------;;;
;;;Receives a Selection Set and returns Entity Names ;;;
;;;---------------------------------------------------------------------;;;
(defun ssnames
(selection_set
/ num lst
) )
)
lst
)
;;;---------------------------------------------------------------------;;;
;;;Accepts a Group code and an Entity List and returns the value. ;;;
;;;---------------------------------------------------------------------;;;
;;;---------------------------------------------------------------------;;;
;;;---------------------------------------------------------------------;;;
;;;---------------------------------------------------------------------;;;
;;;Main program starts here.
(setq blk
(car (ent_sel
"\nSelect Source Object: "))) ((not (eq (dxf
0 eblk
) "INSERT")) (princ "\nPlease select a block with attributes. ") )
((not (eq (dxf
66 eblk
) 1)) (princ "\nPlease select a block with attributes. ") )
(T blk)
)
)
(setq atts
(get_atts blk
) )
(and ; Creates a temporary dialog box with toggles for each ; of the tagstrings in tags. This is a variable dialog
; box that changes size based on the number of attributes.
(setq dcl_name
(createdialog tags keys
)) ; Loads the dialog box ; If any toggle other than 'Select All' is pressed then
; this will turn off the 'Select All' toggle.
keys
)
"accept"
"(setq lst (mapcar '(lambda (x)(get_tile x)) keys))(done_dialog 1)"
;; CAB removed morder code
;; "(setq morder (= (get_tile \"morder\") \"1\")lst (mapcar '(lambda (x)(get_tile x)) keys))(done_dialog 1)"
)
;; (set_tile "morder" "1")
(setq morder t
) ; overridefor now, keep for future use (and ; creates a list of attribute objects from the ; reference object that were selected in the dialog box.
;; CAB start =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
;; replace the attriburtes in one insert
;; if morder is true the tag and the order in the list must match
;; else the first matching tag will get the new value
(defun replaceatts
(ent atlst tags vals
/ blkobj cnt idx
) cnt 0
)
((and morder
; order must match (= 1 (cdr (nth cnt atlst
))) ; flag, ok to replace )
)
(not morder
) ; ignore order (= 1 (cdr (nth cnt atlst
))) ; flag, ok to replace )
)
)
)
)
;; CAB - a list of pairs (tagname flag) where flag 1 0 t/nil
(setq atts
(create_list lst atts
)) "\nSelect blocks to update or enter ALL for all matching blocks."
)
)
(progn (setq rname
(vla
-get
-effectivename rname
)) (vla-get-effectivename
)
)
)
)
(ssnames ssa)
)
)
)
)
)
(ssnames ssa)
)
)
)
)
(progn ; itterate through the selected inserts (if (not (eq ename blk
)) ; ignore doner block (replaceatts ename atts tags vals)
)
)
(princ "\nInvalid blocks selected. Please start over. ") )
)
)
;; CAB end =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
) ; This is returned if the user hits Cancel.
(princ "\nFunction Terminated by User!") )
)
)
