VBA - Title Block Attribute

[Ixoye]

Hello,

  I had been asked if I could find a way to automate the creation of an Index for the Title Page for our projects, in as few steps as possible. the Index is simple, consisting of two Header elements (1) "Sheet No." and (2) "Drawing Title".

  I have successfully been able to create the "Index" with the (1) column of the "Sheet No." using VBA into an Excel speadsheet then pasting it back into AutoCad. Where I am getting stuck is in capturing the "Drawing Title" that resides with in the Title Block of each drawing files as an attribute. I need automate this for each drawing in the project and do not want to use the Data Extraction.

  Any help would be greatly appreciated and get me going in the right direction.

[BIGAL]

Your welcome to edit this

 

; dwg index to a table
; by Alan H NOV 2013
(defun AH:dwgindex (/ doc objtable ss1 lay ans ans2 plotabs ss1 tag2 tag3 list1 list2 curlayout colwidth numcolumns numrows INC rowheight )

(vl-load-com)
(setq curlayout (getvar "ctab"))
(if (= curlayout "Model")
(progn
(Alert "You need to be in a layout for this option")
(exit)
) ; end progn
) ; end if model
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(setq curspace (vla-get-paperspace doc))
(setq pt1 (vlax-3d-point (getpoint "\nPick point for top left hand of table:  "))) 

; read values from title blocks

(setq bname "DA1DRTXT")

(setq tag2 "DRG_NO") ;attribute tag name
(setq tag3 "WORKS_DESCRIPTION") ;attribute tag name

(setq ss1 (ssget "x"  (list (cons 0 "INSERT") (cons 2 bname))))

(if (= ss1 nil) ; for tomkinson jobs
(progn 
(setq bname "COGG_TITLE")
(setq ss1 (ssget "x"  (list (cons 0 "INSERT") (cons 2 bname))))
)
)

(setq INC (sslength ss1))  
(repeat INC
(foreach att (vlax-invoke (vlax-ename->vla-object (ssname SS1 (SETQ INC (- INC 1)) )) 'getattributes) 
        (if (= tag2 (strcase (vla-get-tagstring att)))
            (progn
            (setq ans (vla-get-textstring att))
            (if (/= ans NIL)
            (setq list1 (cons ans list1))
            ) ; if 
            ); end progn
          ) ; end if
        (if (= tag3 (strcase (vla-get-tagstring att)))
          (progn
          (setq ans2 (vla-get-textstring att))
          (if (/= ans2 NIL)
              (setq list2 (cons ans2 list2)) 
           ) ; end if
           ) ; end progn
     ) ; end if tag3 
    
) ; end foreach

) ; end repeat
(setvar 'ctab curlayout)
(command "Zoom" "E")
(command "regen")


(reverse list1)
;(reverse list2)

; now do table 
(setq numrows (+ 2 (sslength ss1)))
(setq numcolumns 2)
(setq rowheight 0.2)
(setq colwidth 150)
(setq objtable (vla-addtable curspace pt1 numrows numcolumns rowheight colwidth))
(vla-settext objtable 0 0 "DRAWING REGISTER")
(vla-settext objtable 1 0 "DRAWING NUMBER") 
(vla-settext objtable 1 1 "DRAWING TITLE") 

(SETQ X 0)
(SETQ Y 2)

(REPEAT (sslength ss1)
  (vla-settext objtable Y 0 (NTH X LIST1))
  (vla-settext objtable Y 1 (NTH X LIST2))
  (vla-setrowheight objtable y 7)

  (SETQ X (+ X 1))
  (SETQ Y (+ Y 1))
)

(vla-setcolumnwidth objtable 0 55)
(vla-setcolumnwidth objtable 1 170)

(command "_zoom" "e")

); end AH defun

(AH:dwgindex)

(princ)

[Ixoye]

Thanks BIGAL,

I will modify and implement this into my code and process.