;; Version 06+
;; CAB 10.11.09
;; This lisp will handle blocks with more than 8 attributes by paging
;; the DCL using [Previous] [Next] buttons
;; Added option to edit Prompt String in attribute, note that this edit
;; will change all INSERTS as the prompt string resides in the block def.
;;
;; The following are three routines
;; MyAttEditDCL - Option to do one of three tasks: see below
;; MyAttEdit - This will edit a single Insert
;; MyAttEditG - Updates only changed values for ALL inserts in the DWG
;; MyAttEditL - Updates only changed values in selected layouts

;; =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;; Example of a selected Layout edit version
;; Updates only changed values in selected layouts
;; Layouts are selected via DCL pick list
;; =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
(defun c:MyAttEditDcl (/ ent obj cnt)
(vl-load-com)
(setq *EditType "** Layout Block Edit **")
(if (and (or (setq ent (entsel "\nPick a block."))
(prompt "\nMissed Pick."))
(setq ent (car ent))
(setq obj (vlax-ename->vla-object ent))
(or (= (vla-get-objectname obj) "AcDbBlockReference")
(prompt "\nError - Not a Block"))
(or (= (vla-get-hasattributes obj) :vlax-true)
(prompt "\nInsert has no attributes."))
(or (setq tabList (GetEditOptions (vla-get-name obj))) ; get user options for which inserts
(prompt "\nUser Quit"))
)
(if (and (setq attlst (myattedit ent nil nil t))
(vl-some (function(lambda(x) (caddr x) )) attlst) ; verify that there are changes needed
)
(progn
(cond
((= tablist 1) ; single insert update - not working yet <----------<< cnt 0)
)
(prompt (strcat "\n" (itoa cnt)" "(vla-get-name obj)" Blocks updated."))
(prompt "\nNo other blocks found")
)
)
)
(Update_Prompt_String obj attlst)
)
(prompt "\nNothing to do.")
) ; endif
) ; endif
(princ)
)
(prompt "\nGlobal Attedit Loaded, Enter MyAttEditDCL to run.")
(princ)

;; -------------------------------------------------------------------------
;; update only changed attributes, not prompt strings
(defun update_atts (obj attlst)
(setq atts (vlax-invoke obj "getattributes"))
(foreach lst attlst ; step through the changed attribute list, not the insert attributes
(and (setq att (nth (car lst) atts)) ; match indexed position
(= (vla-get-tagstring att) (cadr lst)) ; match tag name
(/= (vla-get-textstring att) (caddr lst)) ; text changed?
(vla-put-textstring att (caddr lst)) ; update text
)
)
)
;; -------------------------------------------------------------------------

(defun Update_Prompt_String (obj attlist)
;; Update prompt string if changed, Prompt string is in the BLOCK definition
;; CAB 10.06.09
;; (att-obj prompt-string att-value tag-string)
;; verify that there are changes needed
(if (vl-some (function(lambda(x) (last x) )) attlist)
(progn
(setq blocks (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))))
(vlax-for x (vla-item blocks (vla-get-name obj))
(if (equal "AcDbAttributeDefinition" (vlax-get x 'ObjectName))
(setq BlkAtts (cons x BlkAtts))
)
)
(setq BlkAtts (reverse BlkAtts))
(foreach lst attlist
(if (and (= (vla-get-tagstring (nth (car lst) BlkAtts)) (cadr lst))
(/= (vla-get-promptstring (nth (car lst) BlkAtts)) (last lst)))
(vla-put-promptstring (nth (car lst) BlkAtts) (last lst))
)
)
)
)
)

;; =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;; User selects Tabs from a DCL list Box
;; Returns a list of selected tab names
;; =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
(defun GetEditOptions (blkName / dclfile dcl# layouts ptr tablist)
(setq dclfile "myattedit06.dcl")
;;(setq dclfile (findfile dclfile)) ; for debug
(cond
((not (create_attedit_dcl dclfile)) ; need to restore this function <-------<<<
(alert "Could not create DCL File. - Aborting.")
)
((< (setq dcl# (load_dialog dclfile)) 0) ; Error
(prompt (strcat "\nCannot load " dclfile "."))
)
((not (new_dialog "atteditselect" dcl#)) ; Error
(prompt (strcat "\nProblem with " dclfile "."))
)
(t ; No DCL problems: fire it up
(setq layouts (cons "Model" (vl-sort (vl-remove "Model" (layoutlist)) 'vla-object ent))
(= (vla-get-objectname obj) "AcDbBlockReference")
(= (vla-get-hasattributes obj) :vlax-true)
)
(if (and (setq attlst (myattedit ent nil nil t))
(vl-some (function(lambda(x) (caddr x) )) attlst) ; verify that there are changes needed
)
(progn
(update_atts obj attlst)
(Update_Prompt_String obj attlst)
)
)
)
(princ)
)

;; =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;; Example of a global edit version
;; Updates only changed values for all inserts in the DWG
;; =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
(defun c:MyAttEditG (/ ent obj cnt)
(vl-load-com)
(setq *EditType "** Global Block Edit **")
(prompt "\n*** All matching blocks will be updated whth changed attributes only.")
(if (and (setq ent (entsel "\nPick the block."))
(setq ent (car ent))
(setq obj (vlax-ename->vla-object ent))
(= (vla-get-objectname obj) "AcDbBlockReference")
(= (vla-get-hasattributes obj) :vlax-true)
)
(if (and (setq attlst (myattedit ent nil nil t))
(vl-some (function(lambda(x) (caddr x) )) attlst) ; verify that there are changes needed
)
(progn
(if (and (setq cnt (update_global_atts (vla-get-name obj) attlst nil))
(> cnt 0))
(prompt (strcat "\n" (itoa cnt) " Blocks updated."))
(prompt "\nNo other blocks found")
)
(Update_Prompt_String obj attlst)
)
)
)
(princ)
)
(prompt "\nGlobal Attedit Loaded, Enter MyAttEditG to run.")
(princ)

;; =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;; Example of a selected Layout edit version
;; Updates only changed values in selected layouts
;; Layouts are selected via DCL pick list
;; =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
(defun c:MyAttEditL (/ ent obj cnt)
(vl-load-com)
(setq *EditType "** Layout Block Edit **")
(prompt "\n*** All matching blocks will be updated whth changed attributes only.")
(if (and (setq ent (entsel "\nPick the block."))
(setq ent (car ent))
(setq obj (vlax-ename->vla-object ent))
(= (vla-get-objectname obj) "AcDbBlockReference")
(= (vla-get-hasattributes obj) :vlax-true)
(setq tabList (GetTabList))
)
(if (and (setq attlst (myattedit ent nil nil t))
(vl-some (function(lambda(x) (caddr x) )) attlst) ; verify that there are changes needed
)
(progn
(if (and (setq cnt (update_global_atts (vla-get-name obj) attlst TabList))
(> cnt 0))
(prompt (strcat "\n" (itoa cnt) " Blocks updated."))
(prompt "\nNo other blocks found")
)
(Update_Prompt_String obj attlst)
)
(prompt "\nNothing to do.")
)
)
(princ)
)
(prompt "\nGlobal Attedit Loaded, Enter MyAttEditL to run.")
(princ)

;; <<<<<<>>>>>>>

;; =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;; User selects Tabs from a DCL list Box
;; Returns a list of selected tab names
;; =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
(defun GetTabList (/ dclfile dcl# layouts ptr tablist)
(setq dclfile "LayoutSelect.dcl")
(cond
((not (create_LayoutSel_dcl dclfile))
(alert "Could not create DCL File. - Aborting.")
)
((< (setq dcl# (load_dialog dclfile)) 0) ; Error
(prompt (strcat "\nCannot load " dclfile "."))
)
((not (new_dialog "layoutselect" dcl#)) ; Error
(prompt (strcat "\nProblem with " dclfile "."))
)
(t ; No DCL problems: fire it up
(setq layouts (cons "Model" (vl-sort (layoutlist) '<)))
(start_list "layouts") (mapcar 'add_list layouts) (end_list)
(set_tile "LStitle" " Layout Selector by CAB v1.0")
(action_tile "layouts" "(setq ptr $value)")
(action_tile "ok" "(done_dialog 5)")
(action_tile "cancel" "(done_dialog 1)")
(setq action (start_dialog))
(unload_dialog dcl#)
(if (and ptr (= action 5)) ; get the list of selections to list of numbers
(setq ptr (read (strcat "(" ptr ")"))
tablist (mapcar '(lambda (x) (nth x layouts)) ptr))
)
) ; end cond T
) ; end cond
tablist
)

;; =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;; CAB 15/20/2006 modified 10.06.09
;; Function to update selected attributes of a given block
;; only those values included in the list will be updated **
;; usage-
;; (update_global_atts "BlockName"
;; '((index# tag-string new_value new_prompt) ...)
;; '())
;; NOTE the index# is to accommodate the use of identical tags names
;; which is allowed in ACAD
;; new_value and new_prompt
;; if the value is unchanged use nil to flag that else the new value
;;
;; Arguments
;; bname block text label
;; attlist list as describe above
;; tabs is a list of layout names to update or nil for entire dwg
;; Returns the block count if successful else nil
;; Note that the prompt string edit is in the block definition & not
;; included in the block count
;; =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

;; netchanges = '((index# tag-string new_text_value new_prompt_string) ...)

;; note to self, may want a flag to supress messages <---------------<<vla-object ename)
atts (vlax-invoke blk "getattributes")
)
(foreach lst attlist ; step through the changed attribute list, not the insert attributes
(and (setq att (nth (car lst) atts)) ; match indexed position
(= (vla-get-tagstring att) (cadr lst)) ; match tag name
(/= (vla-get-textstring att) (caddr lst)) ; text changed?
(vla-put-textstring att (caddr lst)) ; update text
)
)
(setq cnt (1+ cnt)) ; does not reflect any failures
(vla-update blk)
)
(if (not (minusp idx)) (1- idx))
)
)
) ; foreach ss
) ; endif

(Update_Prompt_String bname attlist)

cnt
)

;; <<<<<<<<>>>>>>>

;;; ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;;; + MyAttEdit.lsp +
;;; + Created by C. Alan Butler +
;;; + Copyright 2005-2009 +
;;; + by Precision Drafting & Design All Rights Reserved. +
;;; + Contact at ab2draft@TampaBay.rr.com +
;;; ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;;;
;;; FUNCTION
;;; Dialog box to replace the ATTEDIT dialog
;;;
;;; USAGE
;;; (Myattedit ename taglst editflag promflag)
;;;
;;; ARGUMENTS
;;; ename entity name of the block to edit
;;; taglst list of tag names to edit, nil = edit all
;;; editflg T edit names in list, nil = exclude names in list
;;; PromFlag Prompt Edit Flag when true will allow the edit
;;;
;;; Note, that the Tag Names are in Upper case & no spaces allowed.
;;; If you pass nil then all non-constant tag will be edited
;;;
;;; RETURNS
;;; a list if pairs only for changed values
;;; '((index# tag-string new_text_value new_prompt_string) ...)
;;;
;;; PLATFORMS
;;; 2000+
;;;
;;;
;;; VERSION
;;; 1.03 Sep 13,2005
;;; 1.2 May 19,2006 Returns a list, see above
;;; 1.3 May 20,2006 Returns a list, see above, added index number
;;; 1.6 Oct 06,2009 Added Prompt String Edit
;;;

(defun Myattedit (ename ; block entity ename
taglst ; list of tag names, may be nil
editflg ; edit flag if T edit names in list
;; if nil exclude names in list
proflag ; if true allow edit of Prompt String
/
;; local variables
dlc_id blkname bname newlst action dcl_id obj netchanges
;; local functions
do_prev do_next get_att_tags put_att_tags load_page save_page
set_actions myattedit_help @check home
)
(vl-load-com)

;; Global variables to nil
(mapcar '(lambda (x) (set x nil)) '(*blkdata *page *maxpage *ptr *modlst *oldlst))

;; XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
;; X L o c a l F u n c t i o n s X
;; XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

;;-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
;; Page Up to Previous Panel
(defun do_prev ()
(if (> *page 1)
(progn
(save_page)
(setq *page (1- *page)
*ptr (- *ptr 8)
)
(load_page *blkdata)
)
)
)

;;-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
;; Page Down to next panel
(defun do_next ()
(if (vla-object ename))
(if (= (vla-get-hasattributes blkobj) :vlax-false)
nil ; no attributes
(progn
;; get the Prompt Strings in sequential order from the BLOCK def
(setq blocks (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))))
(setq blkdef (vla-item blocks (vlax-get blkobj 'Name)))
(vlax-for x blkdef
(if (equal "AcDbAttributeDefinition" (vlax-get x 'ObjectName))
(setq plist (cons (vla-get-promptstring x) plist))
)
)

;; get the value from the insert & complete the list
(setq idx 0
plist (reverse plist)
)
(setq attlst (vlax-invoke blkobj "getattributes"))
(foreach att attlst
(setq lst (cons (list att ; att object
(nth idx plist) ; prompt string
(vla-get-textstring att) ; text value
(vla-get-tagstring att)) ; tag string
lst)
idx (1+ idx)
)
)

;; process the Tag list passed by the user
(cond
((null taglst)) ; edit all tags
(t ; modify edit list
;; check each because the tags can have the same name
(foreach x lst
(if editflg ; edit names in list
(if (member (last x) taglst)
(setq tmp (cons x tmp))
)
(if (not (member (last x) taglst))
(setq tmp (cons x tmp))
)
)
)
(setq lst (reverse tmp))
)
)
;; *oldlst and *blkdata are identical at this point
;; '((att-obj prompt-string att-value tag-string)...)
(setq *oldlst (reverse lst)) ; return list
)
)
)

;;++++++++++++++++++++++++++++++++++++++++++++++++++++
;; Display Edit Buttons, Blue Square with red center
(defun PromptButton (tile / x y)
;; Image version
(setq X (dimx_tile tile)
Y (dimy_tile tile)
)
(start_image tile)
(fill_image 0 0 x y 5) ; all blue
(fill_image 4 4 4 4 1) ; red center
(end_image)
;; end image version
)

;;++++++++++++++++++++++++++++++++++++++++++++++++++
;; Display an asterisk when data has changed
(defun asterisk (tile / x y)
;;(set_tile tile "*") ; old text version
;; Image version
(setq X (dimx_tile tile)
Y (dimy_tile tile)
)
(start_image tile)
(fill_image 0 0 x y -15)
(mapcar 'vector_image ; Color 1 Red
(list 5 1 1 0) ; x1
(list 0 9 1 5) ; y1
(list 5 9 9 10) ; x2
(list 10 1 9 5) ; y2
(list 1 1 1 1) ; color
);mapcar
(end_image)
;; end image version
)

;;++++++++++++++++++++++++++++++++++++++++++++++++++
;; No asterisk when no data has changed
(defun ast_clear (tile / x y)
;;(set_tile tile "") ; old text version
;; Image version
(setq X (dimx_tile tile)
Y (dimy_tile tile)
)
(start_image tile)
(fill_image 0 0 x y -15)
(end_image)
;; end image version
)

;;++++++++++++++++++++++++++++++++++++++++++++++++++
;; Load 8 lines per page or less to the the DCL
(defun load_page (*blkdata / ref tag idx)
;; ptr points to the first record on a page
(setq ref 1
idx *ptr
)
(repeat 8
(if (<= idx (length *blkdata))
(progn
(setq tag (nth (1- idx) *blkdata))
(set_tile (strcat "pro" (itoa ref)) (cadr tag)) ; prompt
(set_tile (strcat "eb" (itoa ref)) (caddr tag)) ; value
(mode_tile (strcat "eb" (itoa ref)) 0)
(if (= idx 4) (princ)) ; debug
;; chack the text value & prompt for changes
;; '((att-obj prompt-string att-value tag-string)...)
(if (and (= (cadr (nth (1- idx) *oldlst)) (cadr tag))
(= (caddr (nth (1- idx) *oldlst)) (caddr tag)))
(ast_clear (strcat "im" (itoa ref)))
(asterisk (strcat "im" (itoa ref))) ; value changed
)
(if proflag ; display the button & enable it
(progn
(PromptButton (strcat "aep" (itoa ref)))
(mode_tile (strcat "aep" (itoa ref)) 0) ; allow Button
)
(mode_tile (strcat "aep" (itoa ref)) 1) ; disallow Button
)
)
(progn
(set_tile (strcat "pro" (itoa ref)) "")
(set_tile (strcat "eb" (itoa ref)) "")
(mode_tile (strcat "eb" (itoa ref)) 1)
(ast_clear (strcat "im" (itoa ref)))
(mode_tile (strcat "aep" (itoa ref)) 1) ; disallow Button
)
) ; endif
(if proflag
(set_tile "edprostatus" "Edit Prompt String allowed. Click Button to edit.")
(set_tile "edprostatus" "Edit Prompt String disabled.")
)
(mode_tile (strcat "pro" (itoa ref)) 1) ; disable

(setq ref (1+ ref)
idx (1+ idx)
)
)
(cond
((= *maxpage 1)
(mode_tile "next" 1) ; disabled
(mode_tile "prev" 1) ; disabled
)
((= *page 1)
(mode_tile "next" 0) ; enabled
(mode_tile "prev" 1) ; disabled
)
((= *page *maxpage)
(mode_tile "next" 1) ; disabled
(mode_tile "prev" 0) ; enabled
)
(t
(mode_tile "next" 0) ; enabled
(mode_tile "prev" 0) ; enabled
)

) ; end cond stmt

;; update the header
(set_tile "version" *EditType)
(set_tile "page" (strcat "Page# " (itoa *page)))
(mode_tile "eb1" 2) ; focus to first edit box
(set_tile "colheader1" "[ PROMPT ]")
(set_tile "colheader2" "[ED PROMPT?]")
(set_tile "colheader3" "[ VALUE ]")
)

;;++++++++++++++++++++++++++++++++++++++++++++++++++++++
;; save the current page in case something was changed
(defun save_page (/ ref tag idx)
;; ptr points to the first record on a page
(setq ref 1
idx *ptr
)
(repeat 8
(if (vla-object ename))
;;-------------------------------------------------
;; do some error checking and exit if error found
;;-------------------------------------------------
(cond
;; verify block has attributes
((not (vlax-property-available-p obj "hasattributes"))
(alert "No attributes found.")
)

((not (create_attedit_dcl "myattedit06.dcl"))
(alert "Could not create DCL File. - Aborting.")
)
;; verify open of the dcl file
((not (setq dcl_id (load_dialog "myattedit06.dcl")))
(alert "DCL File not found. - Aborting.")
)

;; verify the dialog name is in the dcl file
((not (new_dialog "MyAttEdit" dcl_id))
(alert "DCL Label not found. - Aborting.")
)

;; make sure there are tags to be modified
;; *blkdata = '((att-obj prompt-string att-value tag-string)...)
;; *oldlst and *blkdata are identical at this point
((null (setq *blkdata (get_att_tags ename taglst editflg)))
(unload_dialog dcl_id)
(alert "No matching attributes found.")
)

(t
;; Set up dialog box
(setq *maxpage (fix (1+ (/ (1- (length *blkdata)) 8))))
(setq bname (cdr (assoc 2 (entget ename))))
(set_tile "txtblock" (strcat "> Block name: " bname))
(set_tile "gatt_title" " MyAttEdit by CAB v1.6c")

(setq *page 1
*ptr 1
)
(load_page *blkdata)
(set_actions)

(setq action (start_dialog))
(unload_dialog dcl_id)

(if (= action 5) ; save changes
(progn
;; (put_att_tags ename *blkdata) ; update the first selected insert
(setq netchanges (getnet))
)
)
)

) ; end cond stmt

;; Global variables to nil
(mapcar '(lambda (x) (set x nil)) '(*blkdata *page *maxpage *ptr *modlst *oldlst))

netchanges ; return list or nil
;; netchanges = '((index# tag-string new_value new_prompt) ...)
;; if the value is unchanged use nil to flag that else the new value
) ; END DEFUN

;; ***************************************************
;; create_dcl function to create a dcl support
;; file if it does not exist
;; Usage : (create_dcl "file name")
;; Returns : T if successful else nil
;; ***************************************************
(defun create_LayoutSel_dcl (fname / acadfn dcl-rev-check)
;;=======================================
;; check revision date Routine
;;=======================================
(defun dcl-rev-check (fn / rvdate ln lp)
;; revision flag must match exactly and must
;; begin with //
(setq rvflag "// Revision Control 10/08/2009@19:40" )
(if (setq fn (findfile fn))
(progn ; check rev date
(setq lp 5) ; read 4 lines
(setq fn (open fn "r")) ; open file for reading
(while (> (setq lp (1- lp)) 0)
(setq ln (read-line fn)) ; get a line from file
(if (vl-string-search rvflag ln)
(setq lp 0)
)
)
(close fn) ; close the open file handle
(if (= lp -1)
nil ; no new dcl needed
t ; flag to create new file
)
)
t ; flag to create new file
)
)
(if (null(wcmatch (strcase fname) "*`.DCL"))
(setq fname (strcat fname ".DCL"))
)
(if (dcl-rev-check fname)
;; create dcl file in same directory as ACAD.PAT
(progn
(setq acadfn (findfile "ACAD.PAT")
fn (strcat (substr acadfn 1 (- (strlen acadfn) 8))fname)
fn (open fn "w")
)
(foreach x (list
"// WARNING file will be recreated if you change the next line"
rvflag
"layoutselect : dialog { key = LStitle;"
" : boxed_row { label = \"\";"
" :list_box { key = \"layouts\"; height = 15 ; width = 30 ;"
" fixed_width = true; multiple_select = true; alignment = centered ;"
" }"
" } "
" : row {"
" : button { key = \"ok\" ; label = \"Continue\" ; fixed_width = true ;} "
" : cancel_button {}"
" }"
"}"
""
) ; endlist
(princ x fn)
(write-line "" fn)
) ; end foreach
(close fn)
(setq acadfn nil)
(alert (strcat "\nDCL file created, please restart the routine"
"\n again if an error occures."))
t ; return True, file created
)
t ; return True, file found
)
) ; end defun

;; ***************************************************
;; create_dcl function to create a dcl support
;; file if it does not exist
;; Usage : (create_dcl "file name")
;; Returns : T if successful else nil
;; ***************************************************
(defun create_attedit_dcl (fname / acadfn dcl-rev-check)
;;=======================================
;; check revision date Routine
;;=======================================
(defun dcl-rev-check (fn / rvdate ln lp)
;; revision flag must match exactly and must
;; begin with //
(setq rvflag "// Revision Control 01/05/2010@13:10" )
(if (setq fn (findfile fn))
(progn ; check rev date
(setq lp 5) ; read 4 lines
(setq fn (open fn "r")) ; open file for reading
(while (> (setq lp (1- lp)) 0)
(setq ln (read-line fn)) ; get a line from file
(if (vl-string-search rvflag ln)
(setq lp 0)
)
)
(close fn) ; close the open file handle
(if (= lp -1)
nil ; no new dcl needed
t ; flag to create new file
)
)
t ; flag to create new file
)
)
(if (null(wcmatch (strcase fname) "*`.DCL"))
(setq fname (strcat fname ".DCL"))
)
(if (dcl-rev-check fname)
;; create dcl file in same directory as ACAD.PAT
(progn
(setq acadfn (findfile "ACAD.PAT")
fn (strcat (substr acadfn 1 (- (strlen acadfn) 8))fname)
fn (open fn "w")
)
(foreach x (list
"// WARNING file will be recreated if you change the next line"
rvflag
"// MyAttEdit.dcl used by MyAttEdit.lsp"
"// Version 1.06c 01/05/2010 "
""
""
"//"
"// general dcl settings "
"//"
""
"dcl_settings : default_dcl_settings { audit_level = 3; }"
""
"// =-=-=-=-=-=-=-=-=-=-=-=-=-="
"// sub assembly definitions "
"// =-=-=-=-=-=-=-=-=-=-=-=-=-="
""
"//attribute_prompt : text { value = \"Attribute Prompt\" ; width = 30; fixed_width = true;}"
"attribute_prompt : edit_box { edit_width = 30; edit_limit = 200; fixed_width = true; is_tab_stop = false;}"
""
"attribute_value : edit_box { edit_width = 38; edit_limit = 200; fixed_width = true;}"
""
"//attribute_edit : toggle {}"
"attribute_edit : image_button { color = -15; height = 1; width = 2; //aspect_ratio = 1;"
" fixed_height = true; fixed_width = true; is_tab_stop = false; }"
" "
"attribute_state : image { height = 1; width = 6; fixed_width = true; fixed_height = true; color = -15;}"
""
"// next is for text version of astericks, no longer un use"
"//attribute_state : text { fixed_width = true; width = 1; is_bold = true;}"
""
"mybutton : button { width = 12; fixed_width = true;}"
""
"spcr : spacer {width = 5; }"
"rowspacer : spacer {height = 0.01; }"
""
"// =-=-=-=-=-=-=-=-=-=-=-=-=-="
"// dialog definition "
"// =-=-=-=-=-=-=-=-=-=-=-=-=-="
""
"MyAttEdit : dialog { key = \"gatt_title\" ;"
" "
" : text { key = \"txtblock\"; value = \"Block Name: My Block\"; width = 50;} "
""
" : row {"
" : text { key = \"version\"; value = \"Edit Type\"; width = 20; alignment = top; } "
" : spacer {width = 18; }"
" : text { key = \"page\"; value = \"Page # \"; width = 10; alignment = bottom;} "
" }"
" : boxed_column {"
" : row {"
" : concatenation { : spacer {width = 7; }"
" : text_part { key = \"colheader1\"; width = 20;}"
" : text_part { key = \"colheader2\"; width = 14;}"
" : spacer {width = 8; }"
" : text_part { key = \"colheader3\"; width = 12;}"
" }"
" }"
" : row {"
" : attribute_prompt { key = \"pro1\"; } "
" : attribute_edit { key = \"aep1\"; } : spcr {} "
" : attribute_value { key = \"eb1\"; } "
" : attribute_state { key = \"im1\"; } "
" }"
" : rowspacer {}"
" : row {"
" : attribute_prompt { key = \"pro2\"; } "
" : attribute_edit { key = \"aep2\"; } : spcr {} "
" : attribute_value { key = \"eb2\"; } "
" : attribute_state { key = \"im2\"; } "
" }"
" : rowspacer {}"
" : row {"
" : attribute_prompt { key = \"pro3\"; } "
" : attribute_edit { key = \"aep3\"; } : spcr {} "
" : attribute_value { key = \"eb3\"; } "
" : attribute_state { key = \"im3\"; } "
" }"
" : rowspacer {}"
" : row {"
" : attribute_prompt { key = \"pro4\"; } "
" : attribute_edit { key = \"aep4\"; } : spcr {} "
" : attribute_value { key = \"eb4\"; } "
" : attribute_state { key = \"im4\"; } "
" }"
" : rowspacer {}"
" : row {"
" : attribute_prompt { key = \"pro5\"; } "
" : attribute_edit { key = \"aep5\"; } : spcr {} "
" : attribute_value { key = \"eb5\"; } "
" : attribute_state { key = \"im5\"; } "
" }"
" : rowspacer {}"
" : row {"
" : attribute_prompt { key = \"pro6\"; } "
" : attribute_edit { key = \"aep6\"; } : spcr {} "
" : attribute_value { key = \"eb6\"; } "
" : attribute_state { key = \"im6\"; } "
" }"
" : rowspacer {}"
" : row {"
" : attribute_prompt { key = \"pro7\"; } "
" : attribute_edit { key = \"aep7\"; } : spcr {} "
" : attribute_value { key = \"eb7\"; } "
" : attribute_state { key = \"im7\"; } "
" }"
" : rowspacer {}"
" : row {"
" : attribute_prompt { key = \"pro8\"; } "
" : attribute_edit { key = \"aep8\"; } : spcr {} "
" : attribute_value { key = \"eb8\"; } "
" : attribute_state { key = \"im8\"; } "
" }"
" : text {key = \"edprostatus\"; width = 60;} // msg re prompt enable / disable"
" }"
" spacer_1;"
""
" : row { "
" : mybutton { key = \"ok\"; label = \"&OK\"; }"
" : mybutton { key = \"cancel\"; label = \"&Cancel\"; is_cancel = true; }"
" : mybutton { key = \"prev\"; label = \"&Previous\"; }"
" : mybutton { key = \"next\"; label = \"&Next\"; }"
" : mybutton { key = \"help\"; label = \"&Help\"; }"
" }"
""
"}"
"atteditselect : dialog { key = \"AEtitle\";"
" : boxed_radio_column { key = \"rbc\" ; label = \"[ Insert Attribute Edit Options ]\";"
" : radio_button { key = \"rb1\"; label = \"Edit this Insert Only\";}"
" : radio_button { key = \"rb2\"; label = \"Edit Inserts on selected Layouts\";}"
" : radio_button { key = \"rb3\"; label = \"Edit ALL Insert in the drawing\";}"
" }"
" : boxed_column { label = \"\";"
" :list_box { key = \"layouts\"; height = 15 ; width = 50 ;"
" fixed_width = true; multiple_select = true; alignment = centered ;"
" }"
" } "
" : row { : spacer {width = 10; }"
" : button { key = \"ok\" ; label = \"Continue\" ; fixed_width = true ;} "
" : cancel_button {}"
" : spacer {width = 10; }"
" }"
"}"
) ; endlist
(princ x fn)
(write-line "" fn)
) ; end foreach
(close fn)
(setq acadfn nil)
(alert (strcat "\nDCL file created, please restart the routine"
"\n again if an error occures."))
t ; return True, file created
)
t ; return True, file found
)
) ; end defun

(c:MyAttEditDcl)

;; /---\
;; -==-
;; \---/

Advertisements