Ok, please don't laugh, but I am stuck and need help with this. I am trying to use Tim Willey's
ReloadBindXrefs routine in an objectdbx function to bind all xrefs within the folder selected.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; MsgBox.lsp (c) 2001-2003, John F. Uhden, Cadlantic/CADvantage
;; A cute little utility to invoke a VBA message box and return a
;; value to AutoLisp.
;; Requires AutoCAD 2000 (R15) or higher.
;; The buttons are a Boolean value representing a logical sum of
;; the following values:
;;--------------------------------------------------------
;; MsgBox(prompt[, buttons][, title][, helpfile, context])
;; Buttons:
;; vbOKOnly 0 Display OK button only.
;; vbOKCancel 1 Display OK and Cancel buttons.
;; vbAbortRetryIgnore 2 Display Abort, Retry, and Ignore buttons.
;; vbYesNoCancel 3 Display Yes, No, and Cancel buttons.
;; vbYesNo 4 Display Yes and No buttons.
;; vbRetryCancel 5 Display Retry and Cancel buttons.
;; vbCritical 16 Display Critical Message icon.
;; vbQuestion 32 Display Warning Query icon.
;; vbExclamation 48 Display Warning Message icon.
;; vbInformation 64 Display Information Message icon.
;; vbDefaultButton1 0 First button is default.
;; vbDefaultButton2 256 Second button is default.
;; vbDefaultButton3 512 Third button is default.
;; vbDefaultButton4 768 Fourth button is default.
;; vbApplicationModal 0 Application modal; the user must respond to the
;; message box before continuing work in the current application.
;; vbSystemModal 4096 System modal; all applications are suspended until the
;; user responds to the message box.
;;
;; Revised (01-27-03) thanks to Ed Jobe's contribution about snagging the return value.
;;
;;(ARCH:MsgBox "Title" 64 "Message")
;;
(defun ARCH:MsgBox (Title Buttons Message / useri1 value)
(vl-load-com)
(or *acad* (setq *acad* (vlax-get-acad-object)))
(setq useri1 (getvar "useri1"))
(acad-push-dbmod)
(vla-eval
*acad*
(strcat
"ThisDrawing.SetVariable \"USERI1\","
"MsgBox (\""
Message
"\","
(itoa Buttons)
",\""
Title
"\")"
)
)
(setq value (getvar "useri1"))
(setvar "useri1" useri1)
(acad-pop-dbmod)
value)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;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
;;;modified with my title block attribute "2436TBA" with values "A-01" "SHT_TTL"
;;;added reconstruct list coding
;;;added open notepad with sheet list
;;;now gets date from titleblock "xrefed" drawing file
;;;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 ''Sheet Files''\n\t\t Xref Bind of all drawings in folder.\n\t\t By: Tim Willey") 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)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun getindex (folder)
(if (and (setq *acad (vlax-get-acad-object))
folder
(setq dwgs (getdwglist (list folder)))
)
(progn
(setq odbx (if (< (atoi (substr (getvar "acadver") 1 2)) 16)
(vla-GetInterfaceObject *acad "ObjectDBX.AxDbDocument")
(vla-GetInterfaceObject *acad "ObjectDBX.AxDbDocument.16")))
(foreach
dwg dwgs
(mapcar 'vlax-release-object (list odbx *acad))))
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Subroutines ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;by Tim Willey 8/24/06
(defun ReloadBindXrefs (Doc / XrefList LstLen TroubleList)
(vlax-for
Blk (vla-get-Blocks Doc)
(if (= (vla-get-IsXref Blk) :vlax-true)
(progn
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-Reload (list Blk)))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-Detach (list Blk)))
(setq TroubleList (cons Blk TroubleList))
(prompt (strcat "\n Detached xref: " (vla-get-Name Blk))))
(progn (vla-Bind Blk :vlax-true)
(if (and (= (vla-get-IsXref Blk) :vlax-true)
(not (vl-position (vla-get-Name Blk) XrefList)))
(setq XrefList (cons Blk XrefList))))))))
(setq LstLen (length XrefList))
(while (and (> LstLen 0) (> LstLen (setq LstLen (length XrefList))))
(foreach
Blk XrefList
(if (or (= (vla-get-IsXref Blk) :vlax-false)
(and (vla-Bind Blk :vlax-true) (= (vla-get-IsXref Blk) :vlax-true)))
(setq XrefList (vl-remove Blk XrefList)))))
(foreach
Blk (append XrefList TroubleList)
(prompt (strcat "\n Unable to bind xref: " (vla-get-Name Blk))))
(princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Main Function ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ReloadBindXrefsIT ()
(setq Result
(ARCH:WARNING-5
"Bind Insert"
" Bind ALL found Xrefs within the current\n"
" Drawing, ignors xrefs not found.\n\n"
" [ Yes ]\t to continue on...\n"
" [ No ]\t not at this time."
""
)
)
(cond
((= result 0)(c:xxx))
((= result 1)(prompt "\n*** ///////// Program CANCELLED ///////// ***"))
)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:TEST ()
(setq folder (getfolder))
(setq indexlist (getindex folder))
(foreach dwg dwgs
(ReloadBindXrefs (vla-get-ActiveDocument (vlax-get-Acad-Object))) ;;calling Tims function
)
(princ))
Gary
