Request for AutoLISP Program for Automatic Loop Drawing Index Generation
I'm not sure where this information is being sourced from. Are the sample drawings Loop-1 and Loop-2 related to the entries shown in the drawing index? If so, I can't see where the corresponding data is coming from. If not, could you please show us the expected or correct data for Loop-1 and Loop-2 so we can better understand the intended output?
Loop No. and Dwg no. appears to be the same for both Loop-1 and Loop-2 drawing file.
TITLE on the drawing index for 17 and 18 is the same as well.
Just another question to simplify the task. Can the Rev. date be a single cell so no horizontal line between them ? The image in yellow is a table, rather than lines and text. I see getting table correct as first task.
In your example you have a Rev/ Date, but there is no date in the title block, where is it ?
I realise may need two versions of this task, "does the details already exist so update the index", else "add the current dwg details in correct order by sheet number". Also can not use fields. Maybe even a 3rd option Excel link.
Ok reread the posts understand you will fill in Rev and date into index. Will try to do something.
This is a 1st attempt and uses OBDX to read the other dwg's. Limited testing. At the moment it will only work for up to 20 dwg's but that should be ok for a couple of tests and comments. Its not super fast doing 840 in one go no idea how long it will take. Maybe Aeccoreconsole is the way to go.
; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/request-for-autolisp-program-for-automatic-loop-drawing-index/td-p/14264973
; do index of multiple dwg's
; By AlanH Sept 2026
(defun doindex (lst2 row / )
(foreach val lst2
(vla-settext objtable row 0 (nth 1 val))
(vla-settext objtable row 1 (nth 0 val))
(vla-settext objtable row 2 (nth 2 val))
(setq row (1+ row))
)
(princ)
)
(defun ahmktable ( / colwidth numcolumns numrows rowheight sp vgad vgao vgms)
(setq sp (vlax-3d-point (getpoint "select point for table")))
(setq curspc (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
(setq numrows 21)
(setq numcolumns 15)
(setq rowheight 10)
(setq colwidth 50)
(setq objtable (vla-addtable curspc sp numrows numcolumns rowheight colwidth))
(vla-put-TitleSuppressed Objtable :vlax-true)
(vla-put-HeaderSuppressed Objtable :vlax-true)
(vla-UnmergeCells Objtable 0 0 0 8)
(vla-SetTextHeight Objtable acDataRow 3.0)
(vla-SetAlignment Objtable acDataRow acMiddleCenter)
(vla-Setcolumnwidth Objtable 0 18)
(vla-Setcolumnwidth Objtable 1 65)
(vla-Setcolumnwidth Objtable 2 18)
(vla-Setcolumnwidth Objtable 3 18)
(vla-Setcolumnwidth Objtable 4 18)
(vla-Setcolumnwidth Objtable 5 18)
(vla-Setcolumnwidth Objtable 6 65)
(vla-Setcolumnwidth Objtable 7 18)
(vla-Setcolumnwidth Objtable 8 18)
(vla-Setcolumnwidth Objtable 9 18)
(vla-Setcolumnwidth Objtable 10 18)
(vla-Setcolumnwidth Objtable 11 64 )
(vla-Setcolumnwidth Objtable 12 18)
(vla-Setcolumnwidth Objtable 13 18)
(vla-Setcolumnwidth Objtable 14 18)
(vla-settext objtable 0 0 "SHEET\nNo.")
(vla-settext objtable 0 1 "TITLE")
(vla-settext objtable 0 2 "REV.\nDATE")
(vla-settext objtable 0 3 "REV.\nDATE")
(vla-settext objtable 0 4 "REV.\nDATE")
(vla-settext objtable 0 5 "SHEET\nNo.")
(vla-settext objtable 0 6 "TITLE")
(vla-settext objtable 0 7 "REV.\nDATE")
(vla-settext objtable 0 8 "RE.\nDATE")
(vla-settext objtable 0 9 "REV.\nDATE")
(vla-settext objtable 0 10 "SHEET\nNo.")
(vla-settext objtable 0 11 "TITLE")
(vla-settext objtable 0 12 "REV.\nDATE")
(vla-settext objtable 0 13 "REV.\nDATE")
(vla-settext objtable 0 14 "REV.\nDATE")
(princ)
)
;; Directory Files - Lee Mac
;; Retrieves all files of a specified filetype residing in a directory (and subdirectories)
;; dir - [str] Root directory for which to return filenames
;; typ - [str] Optional filetype filter (DOS pattern)
;; sub - [bol] If T, subdirectories of the root directory are included
;; Returns: [lst] List of files matching the filetype criteria, else nil if none are found
(defun LM:directoryfiles ( dir typ sub )
(setq dir (vl-string-right-trim "\\" (vl-string-translate "/" "\\" dir)))
(append (mapcar '(lambda ( x ) (strcat dir "\\" x)) (vl-directory-files dir typ 1))
(if sub
(apply 'append
(mapcar
'(lambda ( x )
(if (not (wcmatch x "`.,`.`."))
(LM:directoryfiles (strcat dir "\\" x) typ sub)
)
)
(vl-directory-files dir nil -1)
)
)
)
)
)
(defun makeindex ( / )
(vlax-for dbobj (vla-get-ModelSpace dbx)
(if (and (= (vla-get-ObjectName dbobj) "AcDbBlockReference" )(= (vlax-get dbobj 'name) "A3LM"))
(progn
(setq atts (vlax-invoke dbobj 'Getattributes))
(setq desc (vlax-get (nth 5 atts) 'textstring))
(setq shtno (vlax-get (nth 7 atts) 'textstring))
(setq rev (strcat (vlax-get (nth 10 atts) 'textstring) "\n-"))
(setq lst (cons (list desc shtno rev) lst))
)
)
)
(princ)
)
;;;;;;;;;;;;; starts here ;;;;;;;;;;;
(defun c:index1 ( / dbx direc filelst file)
(setq dbx
(vl-catch-all-apply 'vla-getinterfaceobject
(list (setq app (vlax-get-acad-object))
(if (< (setq vrs (atoi (getvar 'acadver))) 16)
"objectdbx.axdbdocument" (strcat "objectdbx.axdbdocument." (itoa vrs))
)
)
)
)
(setq direc (VL-FILENAME-DIRECTORY (getfiled "Select dwg File for top directory " "" "dwg" 16)))
(setq filelst (LM:directoryfiles direc "*.dwg" T))
(setq lst '())
(foreach file filelst
(vla-open dbx file)
(makeindex)
)
(setq lst (vl-sort lst '(lambda (x y) (< (cadr x)(cadr y)))))
(ahmktable)
(if (= row nil) (setq row 1))
(doindex lst row)
(vlax-release-object dbx)
(princ)
)
(c:index1)
Still makes sense to me to have date in the dwg. Yes needs way more work but one step at a time.
What happens when you get to Rev 4 ? Needs a shuffle yes can be done.
Hello Sea-Haven,
Sorry for the delayed response. I tried to use it, but unfortunately, I was unable to get it working. Could you please guide me through the procedure step by step? This would help me understand the process more clearly and ensure that I am following the correct procedure. Thank you for your support.
Ref. screen shot below.
I think the issue is in the choose dwg names, I will see if can do it in a better way. I used Lee-mac's get all dwgs in a directory. That may be where the issue is, you may have to run the code with no dwgs open from within the chosen directory. When asked to pick a dwg you only need to pick one this returns the directory name where the dwg's are, then the Lee-mac code selects all dwgs in that directory.
It currently does not have any error handling for if an incorrect dwg is in that directory ie Title block not found.
I used this for testing with a hard coded list.
(setq direc (VL-FILENAME-DIRECTORY (getfiled "Select dwg File for top directory " "" "dwg" 16)))
; (setq filelst (LM:directoryfiles direc "*.dwg" T))
(setq filelst (list "D:\\temp\\loop-1.dwg" "d:\\temp\\loop-2.dwg"))If the index dwg is the current dwg can remove that from the OBDX list and update separately. Will add that after getting to work in a simple way.
Try with a hard coded list. The variable "filelst" don't forget to use double slashes. Then can try to improve on user interface. Don't forget I have only allowed for 1st 20 dwgs at this stage for testing, just try a few gradually increasing the number of dwg's. I am not sure about speed.
Given the number of dwgs involved you may be better looking for a "Project drawing management" program that updates indexes and say links to Excel etc. We had a system but it was only at top level using an Access database. Could look up dwg's since 1999.
