Allen
This is a similar request. I am using your routine to now search of multiple occurancess of the same attributed block.
And, I am stuck on how to do this. I have it searching for the right block which has three values. My problem is that it only lists
one occurrance of the block, and each drawing has up to fifteen.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;function to extract 2 attribute values from a specific block in the drawings of a specified folder
;;;by Jeff Mishler Feb. 9, 2006
;;;
;;;new functions and rewrite by Allen Butler
;;;
;;;added BrowseForFolder title and info
;;;added AutoCAD's progress bar while routine runs
;;;
;;;added reconstruct list coding
;;;added open notepad with room finish list
;;;
;;;by Gary Fowler
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;pulled out this function from getindex below
(defun getfolder ()
(defun BrowseForFolder (/ sh parentfolder folderobject result folder)
;;as posted the autodesk discussion customization group by Tony Tanzillo
(vl-load-com)
(setq sh
(vla-getInterfaceObject
(vlax-get-acad-object)
"Shell.Application"
)
)
(if (not ARCH#LOGO)(setq ARCH#LOGO " Your Logo"))
(setq folder
(vlax-invoke-method
sh 'BrowseForFolder 0 (strcat ARCH#LOGO " : Select drawing location for ''Room Files''\n\t\t Creates index of all drawings in folder.\n\t\t By: Jeff Mishler and Allen Butler") 0)
) ;;added BrowseForFolder title and info
(vlax-release-object sh)
(if folder
(progn
(setq parentfolder
(vlax-get-property folder 'ParentFolder)
)
(setq FolderObject
(vlax-invoke-method
ParentFolder
'ParseName
(vlax-get-property Folder 'Title)
)
)
(setq result
(vlax-get-property FolderObject 'Path)
)
(mapcar 'vlax-release-object
(list folder parentfolder folderobject)
)
result
)
)
)
(defun getdwglist (folderlist)
(apply 'append
(mapcar '(lambda (f)
(mapcar '(lambda (name)
(strcat f "\\" name)
)
(vl-directory-files f "*.dwg" 1)
)
)
folderlist
)
)
)
(browseforfolder) ; return the folder ;Allen Butler fix
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun getindex (blkList folder / *acad atts dwgs f layouts masterlist name odbx val1 val2 n)
(if (and (setq *acad (vlax-get-acad-object))
folder ;CAB
(setq dwgs (getdwglist (list folder)))
)
(progn
(setq n 1)
;;added progress bar count marker
(if (member "acetutil.arx" (arx))
(ACET-UI-PROGRESS-INIT
"Please Wait while the Program is Running"
(length dwg)))
;;added progress bar start
(setq odbx (if (< (atoi (substr (getvar "acadver") 1 2)) 16)
(vla-GetInterfaceObject *acad "ObjectDBX.AxDbDocument")
(vla-GetInterfaceObject *acad "ObjectDBX.AxDbDocument.16")))
(foreach
dwg dwgs
;;(ARCH:WORKING) ;;spinner test not used
(if (member "acetutil.arx" (arx))
(ACET-UI-PROGRESS-SAFE n)(ARCH:WORKING))
;;added progress bar running
(setq n (+ n 1))
;;added progress bar count marker
(if
(and (not (vl-catch-all-error-p
(vl-catch-all-apply '(lambda () (vla-open odbx dwg)))))
;; see if the block is even in the drawing
;; check for blocks
(vl-remove
nil
(mapcar
'(lambda (x)
(not (vl-catch-all-error-p
(vl-catch-all-apply
'(lambda () (vla-item (vla-get-blocks odbx) (car x)))))))
blklist))) ; and
(setq masterlist
(cons
(cons
(cons "DWG"
(strcat "" (vl-filename-base dwg) "")) ;.dwg
(GetBlockAtts odbx blkList))
masterlist))))
(mapcar 'vlax-release-object (list odbx *acad))))
(reverse masterlist))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;functions by Allen Butler
(defun getattvalues (blkobj taglist / valuelist tmptag)
(foreach
att (vlax-invoke blkobj 'getattributes)
(if (vl-position (setq tmptag (vla-get-tagstring att)) taglist)
(setq valuelist (cons (cons tmptag (vla-get-textstring att)) valuelist))))
valuelist)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;functions by Allen Butler
(defun getblockatts (doc inputlist / rtnlist tmplist tmpinputlist attlist)
(foreach
lst inputlist
(setq tmpinputlist (cons (mapcar 'strcase lst) tmpinputlist)))
(vlax-for
lo (vla-get-layouts doc)
(setq rtnlist
(if rtnlist
(append rtnlist
(list (cons "TAB" (strcat "--- " (vla-get-name lo) " ---"))))
(list (cons "TAB" (strcat "--- " (vla-get-name lo) " ---")))))
(vlax-for
obj (vla-get-block lo)
(if (and (= (vla-get-objectname obj) "AcDbBlockReference")
(setq tmplist (assoc (vla-get-name obj) tmpinputlist)))
(if (setq attlist (getattvalues obj (cdr tmplist)))
(setq rtnlist (append rtnlist attlist))))))
rtnlist)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;; List of Attributed Blocks Values - change to suite ;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun CRIIT (/ indexlist blkData file x a b c folder got-list op dcl_id)
(defun dcl_error ()
(ARCH:MsgBox
" DCL Error" 16"
File could not be Found.
--------------------------------------------------------------------------------------------
Lisp Routine's DCL File not found. Check and Verify Support Paths."
)
(exit)
)
(defun about_help ()
(ARCH:MsgBox
" Rules of Thumb" 64"
Program Information
--------------------------------------------------------------------------------------------
This routine searches for custom attributed blocks change to meet
your CAD Standards."
)
)
(setq folder (getfolder)) ;CAB
;;functions by Allen Butler
(defun padout (word len / spaces)
(repeat (- len (strlen word)) (setq spaces (cons 32 spaces)))
(strcat word (vl-list->string spaces)))
;--------------------------------------------------------------------------------
;;searchs for these blocks revision "RM-TAG"
(setq blkData '(("RM-TAG" "ROOM" "ROOM-NO" "FINISH")))
;--------------------------------------------------------------------------------
(setq indexlist (getindex blkdata folder)) ;get attributed blocks from all unit file drawings CAB
;--------------------------------------------------------------------------------
(if (member "acetutil.arx" (arx))
(ACET-UI-PROGRESS-DONE))
;;added progress bar finish
(setq file (open "C:\\Temp\\RoomIndex.txt" "w"))
;--------------------------------------------------------------------------------
(foreach
dwg indexlist
;;write to list_box and notepad
(if (assoc "DWG" dwg)(setq x (padout (cdr (assoc "DWG" dwg)) 10)))
(if (assoc (cadar blkdata) dwg)
(setq a (padout (cdr (assoc (cadar blkdata) dwg)) 16))
(setq a (padout "" 16)))
(if (assoc (caddar blkdata) dwg)
(setq b (padout (cdr (assoc (caddar blkdata) dwg)) 5))
(setq b (padout "" 5)))
(if (assoc (car (cdddar blkdata)) dwg)
(setq c (padout (cdr (assoc (car (cdddar blkdata)) dwg)) 10))
(setq c (padout "" 10)))
(write-line (strcat x) file)
(write-line (strcat " " a b c) file)
;;(setq got-list (append (list (strcat a b c)) got-list))
(setq got-list (append (list x) (list (strcat " " a b c)) got-list))
)
(close file)
;;added dialog box interface
(defun do_act (key_pr) (setq op key_pr)(done_dialog)(princ))
(setq ARCH#LOGO " Arch Program©")
(setq ARCH#YEAR (substr (rtos (getvar "CDATE") 2 16) 1 4))
;;(setq dcl_id (load_dialog (strcat "" "ARCH_CreateRoomIndex-CRI.dcl")))
(setq dcl_id (load_dialog (strcat ARCH#CUSF "BLOC/" "ARCH_CreateRoomIndex-CRI.dcl")))
(if (not (new_dialog "ARCH_RoomIndex" DCL_ID "" '(-1 -1))) (dcl_error))
(set_tile "set-title" (strcat ARCH#LOGO " : CRI Create Room Index List"))
(set_tile "set-copyright" (strcat ARCH#LOGO " " ARCH#YEAR " for AutoCAD®"))
(start_list "file-list")
(mapcar 'add_list got-list)
(end_list)
(set_tile "dir" (strcat " Room File Directory is [" folder "]"))
(action_tile "accept" "(do_act $key)")
(action_tile "about" "(about_help)")
(action_tile "cancel" "(princ \"\\n*** ///////// Program CANCELLED ///////// ***\")(done_dialog)")
(start_dialog)
(cond
((= op "accept")(command ".shell" "notepad C:\\Temp\\RoomIndex.txt"))
)
(unload_dialog dcl_id)
(princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;(prompt "\n* Command name is: \"CRI\" *")
(CRIIT)
(princ)