OK Stusic, I wrote this general sql query like function for getting and changing Attributes in specified blocks in specified layouts with specified tagstrings and specified textstrings.
All of the fields accept WildCards.
Bon Apetite...
P=
Code:
;___________________________________________________________________________________________________________
; Written By: Peter Jamtgaard copyright 2015 All rights reserved
; Function to query a drawing database for blocks, layout, attribute tagstrings, and attribute textstrings
; Returning a list of sublists for the query (like an sql statement using 'Like')
;___________________________________________________________________________________________________________
(defun C:Stusic ()
(foreach lstOfSublists (BlockRecords "BORDER - B - LAND*" "3,4,5" "*" "*")
(foreach lstSublist lstOfSublists
(print lstSublist)
)
(print "")
)
)
;___________________________________________________________________________________________________________
;
; Changes the Revision attribute to be +1 on all layouts
;___________________________________________________________________________________________________________
(defun C:Revisions (/ intRevision objAttribute strTextString)
(foreach lstOfSublists (BlockRecords "BORDER - B - LAND*" "*" "REVISION" "*")
(foreach lstSublist (cddr lstOfSublists)
(and
(setq objAttribute (caddr lstSublist))
(setq strTextString (vla-get-textstring objAttribute))
(setq intRevision (1+ (atoi strTextString)))
(setq strTextString (itoa intRevision))
(while (< (strlen strTextString) 2)(setq strTextString (strcat "0" strTextString)))
(errortrap '(vla-put-textstring objAttribute strTextString))
)
)
)
)
;___________________________________________________________________________________________________________
;
; Changes the Drawnby attribute to be Fred Jones on sheets 3,4,5 in the BORDER - B - LAND* Blocks
;___________________________________________________________________________________________________________
(defun C:Stusic3 ()
(BlockFieldsPut "BORDER - B - LAND*" "3,4,5" "DRAWNBY" "*" "FRED JONES")
)
;___________________________________________________________________________________________________________
;
; Returns a list of sublists for a specified BlockName, Layout, TagString and TextString as wildcards
;___________________________________________________________________________________________________________
(defun BlockFields (strWCBlockName strWCLayout strWCTagString strWCTextString / lstOfSublists)
(if (setq lstOfSublists (BlockRecords strWCBlockName strWCLayout strWCTagString strWCTextString))
lstOfSublists
)
)
;___________________________________________________________________________________________________________
;
; Changes a TextString for a specified BlockName, Layout, TagString and TextString as wildcards
;___________________________________________________________________________________________________________
(defun BlockFieldsPut (strWCBlockName strWCLayout strWCTagString strWCTextString strNewTextString)
(foreach lstOfSublists (BlockRecords strWCBlockName strWCLayout strWCTagString strWCTextString)
(foreach lstSublist (cddr lstOfSublists)
(vla-put-textstring (caddr lstSublist) strNewTextString)
)
)
)
;___________________________________________________________________________________________________________
;
; Returns a list of sublists specified BlockName, Layout, TagString and TextString including as
; (see Stusic above)
;___________________________________________________________________________________________________________
(defun BlockRecords (strWCBlockName
strWCLayout
strWCTagString
strWCTextString
/
lstAttributeSublists
lstLayoutInformation
lstReturn
objItem
objLayout
objThisDrawing
strBlockName)
(setq objThisDrawing (vla-get-activedocument (vlax-get-acad-object)))
(vlax-for objLayout (vla-get-layouts objThisDrawing)
(vlax-for objItem (vla-get-block objLayout)
(and (wcmatch (strcase (vla-get-name objLayout)) (strcase strWCLayout))
(wcmatch (vla-get-objectname objItem) "AcDbBlockReference,AcDbMInsertBlock")
(wcmatch (strcase (setq strBlockName (vla-get-name objItem))) (strcase strWCBlockName))
(setq lstAttributeSublists (AttributeSublists objItem))
(setq lstAttributeSublists (AttributeFilter lstAttributeSublists strWCTagString strWCTextString))
(setq lstLayoutInformation (list "LAYOUT" (vla-get-name objLayout) objLayout))
(setq lstBlockInformation (list "BLOCK" strBlockName objItem))
(setq lstAttributeSublists (sortlistofsublistsbyitem lstAttributeSublists 0))
(setq lstAttributeSublists (cons lstBlockInformation lstAttributeSublists))
(setq lstAttributeSublists (cons lstLayoutInformation lstAttributeSublists))
(setq lstReturn (cons lstAttributeSublists lstReturn))
)
)
)
(reverse lstReturn)
)
;___________________________________________________________________________________________________________
;
; Sorts a list of sublists by a specified item
;___________________________________________________________________________________________________________
(defun sortListofSublistsbyItem (lstOfSublists intItem)
(vl-sort lstOfSublists '(lambda (X Y) (< (nth intItem X) (nth intItem Y))))
)
;___________________________________________________________________________________________________________
;
; Filters attributes by wildcard specification
;___________________________________________________________________________________________________________
(defun AttributeFilter (lstOfSublists strWCTagString strWCTextString / lstOfSublists2 lstSublist)
(foreach lstSublist lstOfSublists
(if (and (wcmatch (strcase (car lstSublist)) strWCTagString)
(wcmatch (strcase (cadr lstSublist)) strWCTextString)
)
(setq lstOfSublists2 (cons lstSublist lstOfSublists2))
)
)
(reverse lstOfSublists2)
)
;___________________________________________________________________________________________________________
;
; Returns a list of sublists for a block including each attribute
; Each sublist includes '(strTagstring strTextstring objAttribute)
;___________________________________________________________________________________________________________
(defun AttributeSubLists (objSelection / objAttribute)
(if (= (vla-get-hasattributes objSelection) :vlax-true)
(mapcar '(lambda (objAttribute) (list (strcase (vla-get-tagstring objAttribute))
(vla-get-textstring objAttribute)
objAttribute
)
)
(vlax-invoke objSelection "getattributes")
)
)
)
;___________________________________________________________________________________________________________
;
; Standard Error Trap
;___________________________________________________________________________________________________________
(defun ErrorTrap (symFunction / objError result)
(if (vl-catch-all-error-p
(setq objError (vl-catch-all-apply
'(lambda (X)(set X (eval symFunction)))
(list 'result))))
nil
(if result result 'T)
)
)
(vl-load-com)