Topic: Make Sheet Index using obectDBX

[CAB]

bp welcome to the swamp.

I hope someone has time to help you with this but at the moment I am swamped

I'll check back later.

[T.Willey]

Here is one I wrote for another site.  Once you have the document opened with ObjectDBX, pass this function with the document (drawing object) and the string you want to test for.

Code: [Select]

(defun TestForString (Doc String / flag)

(vl-catch-all-apply
 '(lambda ()
  (vlax-for Lo (vla-get-Layouts Doc)
   (vlax-for Obj (vla-get-Block Lo)
    (if
     (and
      (or
       (= (vla-get-ObjectName Obj) "AcDbText")
       (= (vla-get-ObjectName Obj) "AcDbMText")
      )
      (= (strcase (vla-get-TextString Obj)) (strcase String))
     )
     (progn
      (setq flag T)
      (exit)
     )
    )
   )
  )
 )
)
flag
)


[jmcshane]

Hi,

I'm sorry for dragging this post back up, but I have been trying to figure it out this last while
and I could really do with some guidance.

What I'm trying to do basically is extract 4 attributes from the title block and get a list of them in a readable format.
I don't need it exported to a file.

Here is what I have been trying to do. I'm not sure but I think it has to do with the masterlist variable.

Code: [Select]

;|function to extract 2 attribute values from a specific block in the drawings of a specified folder
  by Jeff Mishler Feb. 9, 2006 |;
(defun getindex (blkname attname1 attname2 attname3 attname4 / *acad atts dwgs f folder layouts masterlist name odbx val1 val2 val3 val4)
  (defun BrowseForFolder (/ sh folder parentfolder folderobject result)
    ;;as posted the autodesk discussion customization group by Tony Tanzillo
    (vl-load-com)
    (setq sh
   (vla-getInterfaceObject
     (vlax-get-acad-object)
     "Shell.Application"
   )
    )

    (setq folder
   (vlax-invoke-method
     sh 'BrowseForFolder 0 "" 0)
    )
    (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
   )
    )
  )
  (if (and (setq *acad (vlax-get-acad-object))
   (setq folder (browseforfolder))
   (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.17"
       )
     )
      )
      (foreach dwg dwgs
(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
    (not
      (vl-catch-all-error-p
(vl-catch-all-apply
  '(lambda ()
     (setq blk (vla-item (vla-get-blocks odbx) blkname))
   )
)
      )
    )
  )
   (progn
     ;;it is...carry on
     (setq layouts (vla-get-layouts odbx))
     (vlax-for layout layouts
       (if (not (eq "MODEL" (strcase (vla-get-name layout))))
(progn
   (vlax-for ent (vla-get-block layout)
     (if (and (eq (vla-get-objectname ent)
  "AcDbBlockReference"
      )
      (eq (strcase (vla-get-name ent))
  (strcase blkname)
      )
)
       (progn
(setq atts (vlax-invoke ent 'getattributes))
(foreach att atts
   (if (eq (vla-get-tagstring att)
   (strcase attname1)
       )
     (setq val1 (vla-get-textstring att))
   )
   (if (eq (vla-get-tagstring att)
   (strcase attname2)
       )
     (setq val2 (vla-get-textstring att))
   )
   (if (eq (vla-get-tagstring att)
   (strcase attname3)
       )
     (setq val3 (vla-get-textstring att))
   )
   (if (eq (vla-get-tagstring att)
   (strcase attname4)
       )
     (setq val4 (vla-get-textstring att))
   )
)
(setq masterlist
(cons (cons (cons (cons val1 val2) val3) val4) masterlist)
;(cons (list (vla-get-name odbx) (cons val1 val2)) masterlist);for testing
)
       )
     )
   )
)
       )
     )
   )
)
      )
      (mapcar 'vlax-release-object (list odbx *acad))
    )
  )
  (reverse masterlist)
)
;;;Test with my title block
(defun c:createindex ()
  (setq indexlist (getindex "A1-Landscape" "DRG-NO" "TITLE1" "TITLE2" "TITLE3"))
)

;;;(defun c:CreateIndex (/ indexlist)
;;;  (setq indexlist (getindex "A1-Landscape" "DRG-NO" "TITLE1" "TITLE2" "TITLE3"))
;;;  (princ "\n")
;;;  (repeat
;;;    (length indexlist)
;;;    (setq a     (car indexlist)
;;;   indexlist (cdr indexlist)
;;;    )
;;;    (princ (car a))
;;;    (princ "\t")
;;;    (princ (cdr a))
;;;    (princ "\t")
;;;    (princ (cadr a))
;;;    (princ "\t")
;;;    (princ (caadr a))
;;;    (princ "\n")
;;;  )
;;;)

(defun c:createindex (/ indexlist)
   (defun padout (word len / spaces)
    (repeat (- len (strlen word)) (setq spaces (cons 32 spaces)))
    (strcat word (vl-list->string spaces))
  )
  (setq indexlist (getindex "A1-Landscape" "DRG-NO" "TITLE1" "TITLE2" "TITLE3"))
  (foreach itm indexlist
    (princ "\n")
    (princ (strcat (padout (car itm) 12) (cdr itm)))
  )
  (princ)
)


;;;(defun c:CreateIndex (/ indexlist)
;;;  (setq indexlist (getindex "2436TBA" "A-01" "SHT_TTL"))
;;;  (princ "\n")
;;;  (repeat
;;;    (length indexlist)
;;;    (setq a (car indexlist) indexlist (cdr indexlist))
;;;    (princ (car a))
;;;    (princ "\t")
;;;    (princ (cdr a))
;;;    (princ "\n")
;;;  )
;;;)

Any help would be greatly appreciated.

John

[T.Willey]

Hi,

I'm sorry for dragging this post back up, but I have been trying to figure it out this last while
and I could really do with some guidance.

What I'm trying to do basically is extract 4 attributes from the title block and get a list of them in a readable format.
I don't need it exported to a file.

Here is what I have been trying to do. I'm not sure but I think it has to do with the masterlist variable.

<snip>

Welcome to theSwamp John first.

Second I would code it differently.  I would code it so that the attribute tags are in a list, then you can just change that list so that it will have the tags and value.  So the input would look like

(getindex blockname '(att1 att2 att3))

((dwgname ((att1 . val1)(att2 . val2)(att3 . val3))))

If this sounds good to you, then we can proceed, if not then we can wait for Jeff to chime in.

[jmcshane]

Thank you Tim,

I am willing to try anything at this stage but my programing skills are not what you would be used to here
in the Swamp, hence needing some help.

John

[T.Willey]

Thank you Tim,

I am willing to try anything at this stage but my programing skills are not what you would be used to here
in the Swamp, hence needing some help.

John

That is fine, as we are here to teach, and not just give hand outs.  So if you willing to try some stuff, then you will be up with the good people in no time.  Let me see what I can do real quick.  BRB

[T.Willey]

See how this works.  Changed the red parts.  Pink parts are parts I removed.  I can't test, but you can.

Code: [Select]

;|function to extract 2 attribute values from a specific block in the drawings of a specified folder
  by Jeff Mishler Feb. 9, 2006 |;
(defun getindex [color=red](blkname attList / [/color]*acad atts dwgs f folder layouts masterlist name odbx val1 val2 val3 val4)
  (defun BrowseForFolder (/ sh folder parentfolder folderobject result)
    ;;as posted the autodesk discussion customization group by Tony Tanzillo
    (vl-load-com)
    (setq sh
   (vla-getInterfaceObject
     (vlax-get-acad-object)
     "Shell.Application"
   )
    )

    (setq folder
   (vlax-invoke-method
     sh 'BrowseForFolder 0 "" 0)
    )
    (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
   )
    )
  )
[color=red]  (setq attList (mapcar '(lambda ( x ) (cons x "")) attList))[/color]
  (if (and (setq *acad (vlax-get-acad-object))
   (setq folder (browseforfolder))
   (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.17"
       )
     )
      )
      (foreach dwg dwgs
(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
    (not
      (vl-catch-all-error-p
(vl-catch-all-apply
  '(lambda ()
     (setq blk (vla-item (vla-get-blocks odbx) blkname))
   )
)
      )
    )
  )
   (progn
     ;;it is...carry on
     (setq layouts (vla-get-layouts odbx))
     (vlax-for layout layouts
       (if (not (eq "MODEL" (strcase (vla-get-name layout))))
(progn
   (vlax-for ent (vla-get-block layout)
     (if (and (eq (vla-get-objectname ent)
  "AcDbBlockReference"
      )
      (eq (strcase (vla-get-name ent))
  (strcase blkname)
      )
)
       (progn
(setq atts (vlax-invoke ent 'getattributes))
(foreach att atts
[color=pink]                ;|
   (if (eq (vla-get-tagstring att)
   (strcase attname1)
       )
     (setq val1 (vla-get-textstring att))
   )
   (if (eq (vla-get-tagstring att)
   (strcase attname2)
       )
     (setq val2 (vla-get-textstring att))
   )
   (if (eq (vla-get-tagstring att)
   (strcase attname3)
       )
     (setq val3 (vla-get-textstring att))
   )
   (if (eq (vla-get-tagstring att)
   (strcase attname4)
       )
     (setq val4 (vla-get-textstring att))
   )
               |;[/color]
[color=red]               (if (setq tempList (assoc (vla-get-TagString att) attList))
                    (setq attList (subst (cons (car tempList) (vla-get-TextString att)) tempList attList))
                )[/color]
)
(setq masterlist
                [color=red](cons (cons (vla-get-Name odbx) attList) masterlist)[/color]
;(cons (cons (cons (cons val1 val2) val3) val4) masterlist)
;(cons (list (vla-get-name odbx) (cons val1 val2)) masterlist);for testing
)
       )
     )
   )
)
       )
     )
   )
)
      )
      (mapcar 'vlax-release-object (list odbx *acad))
    )
  )
  (reverse masterlist)
)
;;;Test with my title block
(defun c:createindex ()
[color=red]  (setq indexlist (getindex "A1-Landscape" '("DRG-NO" "TITLE1" "TITLE2" "TITLE3")))[/color]
)

;;;(defun c:CreateIndex (/ indexlist)
;;;  (setq indexlist (getindex "A1-Landscape" "DRG-NO" "TITLE1" "TITLE2" "TITLE3"))
;;;  (princ "\n")
;;;  (repeat
;;;    (length indexlist)
;;;    (setq a     (car indexlist)
;;;   indexlist (cdr indexlist)
;;;    )
;;;    (princ (car a))
;;;    (princ "\t")
;;;    (princ (cdr a))
;;;    (princ "\t")
;;;    (princ (cadr a))
;;;    (princ "\t")
;;;    (princ (caadr a))
;;;    (princ "\n")
;;;  )
;;;)

(defun c:createindex (/ indexlist)
   (defun padout (word len / spaces)
    (repeat (- len (strlen word)) (setq spaces (cons 32 spaces)))
    (strcat word (vl-list->string spaces))
  )
  (setq indexlist (getindex "A1-Landscape" "DRG-NO" "TITLE1" "TITLE2" "TITLE3"))
  (foreach itm indexlist
    (princ "\n")
    (princ (strcat (padout (car itm) 12) (cdr itm)))
  )
  (princ)
)


;;;(defun c:CreateIndex (/ indexlist)
;;;  (setq indexlist (getindex "2436TBA" "A-01" "SHT_TTL"))
;;;  (princ "\n")
;;;  (repeat
;;;    (length indexlist)
;;;    (setq a (car indexlist) indexlist (cdr indexlist))
;;;    (princ (car a))
;;;    (princ "\t")
;;;    (princ (cdr a))
;;;    (princ "\n")
;;;  )
;;;)


[jmcshane]

Thanks Tim,

Firstly for your swift reply, and secondly for the code.

One question though (for now!)

I changed to the second version of the getindex as previously posted here
to try and get a cleaner result. I amended the line shown in red.

Code: [Select]

(defun c:CreateIndex (/ indexlist)
  (setq indexlist (getindex "A1-Landscape" '("TITLE1" "TITLE2" "TITLE3")))
  (princ "\n")
  (repeat
    (length indexlist)
    (setq a     (car indexlist)
  indexlist (cdr indexlist)
    )
    (princ (car a))
    (princ "\t")
    [color=red](princ (strcat (cdr (car (cdr a))) " " (cdr (cadr (cdr a))) " " (cdr (caddr (cdr a)))))[/color]
    (princ "\t")
;;;    (princ (cadr a))
;;;    (princ "\t")
;;;    (princ (caadr a))
    (princ "\n")
  )
)

and the result I got was this.

Code: [Select]

C:\Documents and Settings\Johnmcs\Desktop\Desktop\Drawings -
Various\Roscommon\Sheet Index Trial\DR 20408-93.dwg  LONGITUDINAL SECTIONS
SHEET 20 OF 23
C:\Documents and Settings\Johnmcs\Desktop\Desktop\Drawings -
Various\Roscommon\Sheet Index Trial\DR 20408-94.dwg  LONGITUDINAL SECTIONS
SHEET 21 OF 23
Is there a way to strip the DWGPREFIX from the front of the result in the main body of code
or would I be better getting the length of the string in (car a) and stripping it down?


Many thanks,

John

[T.Willey]

If you're looking for just the drawing name without the path, then look at ' vl-filename-base ', and see if that does what you want.

[jmcshane]

Nice one Tim.

That worked a treat.
2 Min's work in Notepad and now I have my contents sheet.

It will take me a while to fully understand the code but I firmly believe that if I throw enough sh*t at the wall
some of it is bound to stick for me.

If anyone is interested, here is the result.

Code: [Select]

;|function to extract 2 attribute values from a specific block in the drawings of a specified folder
  by Jeff Mishler Feb. 9, 2006
  And kindly edited by Tim Willey to extract 4 attributes|;
(defun getindex (blkname attList / *acad atts dwgs f folder layouts masterlist name odbx)
  (defun BrowseForFolder (/ sh folder parentfolder folderobject result)
    ;;as posted the autodesk discussion customization group by Tony Tanzillo
    (vl-load-com)
    (setq sh
  (vla-getInterfaceObject
    (vlax-get-acad-object)
    "Shell.Application"
  )
    )

    (setq folder
  (vlax-invoke-method
    sh 'BrowseForFolder 0 "" 0)
    )
    (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
  )
    )
  )
  (setq attList (mapcar '(lambda ( x ) (cons x "")) attList))
  (if (and (setq *acad (vlax-get-acad-object))
  (setq folder (browseforfolder))
  (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.17"
      )
    )
      )
      (foreach dwg dwgs
(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
   (not
     (vl-catch-all-error-p
(vl-catch-all-apply
 '(lambda ()
    (setq blk (vla-item (vla-get-blocks odbx) blkname))
  )
)
     )
   )
 )
  (progn
    ;;it is...carry on
    (setq layouts (vla-get-layouts odbx))
    (vlax-for layout layouts
      (if (not (eq "MODEL" (strcase (vla-get-name layout))))
(progn
  (vlax-for ent (vla-get-block layout)
    (if (and (eq (vla-get-objectname ent)
 "AcDbBlockReference"
     )
     (eq (strcase (vla-get-name ent))
 (strcase blkname)
     )
)
      (progn
(setq atts (vlax-invoke ent 'getattributes))
(foreach att atts
                (if (setq tempList (assoc (vla-get-TagString att) attList))
                    (setq attList (subst (cons (car tempList) (vla-get-TextString att)) tempList attList))
                )
)
(setq masterlist
                (cons (cons (vl-filename-base (vla-get-Name odbx)) attList) masterlist)
;(cons (cons (cons (cons val1 val2) val3) val4) masterlist)
;(cons (list (vla-get-name odbx) (cons val1 val2)) masterlist);for testing
)
      )
    )
  )
)
      )
    )
  )
)
      )
      (mapcar 'vlax-release-object (list odbx *acad))
    )
  )
  (reverse masterlist)
)
;;;Test with my title block
;;;(defun c:createindex ()
;;;  (setq indexlist (getindex "A1-Landscape" '("DRG-NO" "TITLE1" "TITLE2" "TITLE3")))
;;;)

(defun c:CreateIndex (/ indexlist)
  (setq indexlist (getindex "A1-Landscape" '("TITLE1" "TITLE2" "TITLE3")))
  (princ "\n")
  (repeat
    (length indexlist)
    (setq a    (car indexlist)
 indexlist (cdr indexlist)
    )
    (princ (car a))
    (princ "\t")
    (princ (strcat (cdr (car (cdr a))) " " (cdr (cadr (cdr a))) " " (cdr (caddr (cdr a)))))
;;;    (princ "\t")
;;;    (princ (cadr a))
;;;    (princ "\t")
;;;    (princ (caadr a))
    (princ "\n")
    (princ)
  )
)
;;;
;;;(strlen (car a))
;;;
;;;vl-filename-base
Which returns:

Code: [Select]

DR 20408-91      LONGITUDINAL SECTIONS SHEET 18 OF 23
DR 20408-92      LONGITUDINAL SECTIONS SHEET 19 OF 23
DR 20408-93      LONGITUDINAL SECTIONS SHEET 20 OF 23
DR 20408-94      LONGITUDINAL SECTIONS SHEET 21 OF 23
DR 20408-95      LONGITUDINAL SECTIONS SHEET 22 OF 23
DR 20408-96      LONGITUDINAL SECTIONS SHEET 23 OF 23

Many Thanks Tim.


John

[T.Willey]

You're welcome John.

[Vince]

CAB,

I am looking for a routine to develop a drawing index list and I came across this thread. I am having difficulty trying to adapt the code to work with the block and attribute tags I am using. Would it be too much of an inconvenience to ask your help in converting the code so I might be able to utilize it.

The block name I am using is "Drawing-Title" and the attribute tages I need to read are "NUM", "Title-1", "Title-2" and "Title-3".

Any assistance would be appreciated.


Regards,
Vince

[T.Willey]

I'm not CAB, but you should be able to just change this line ( shown in red ).  You have to copy the whole code that John posted three posts up.

Code: [Select]

(defun c:CreateIndex (/ indexlist)
[color=red]  (setq indexlist (getindex "A1-Landscape" '("TITLE1" "TITLE2" "TITLE3")))[/color]
  (princ "\n")
  (repeat
    (length indexlist)
    (setq a     (car indexlist)
  indexlist (cdr indexlist)
    )
    (princ (car a))
    (princ "\t")
    (princ (strcat (cdr (car (cdr a))) " " (cdr (cadr (cdr a))) " " (cdr (caddr (cdr a)))))
;;;    (princ "\t")
;;;    (princ (cadr a))
;;;    (princ "\t")
;;;    (princ (caadr a))
    (princ "\n")
    (princ)
  )
)

To

Code: [Select]

(setq indexlist (getindex "Drawing-Title" '("NUM" "Title-1" "Title-2" "Title-3)))

Might want to watch out on the tag strings though, as in the past they all were capital, and now they can be mix cased, so just watch out for that.  The order the tags are fed to the routine, is the way they will print out, IIRC.

[CAB]

Tim modified the main code to deal with any number of attributes so I think if you use this version it will also accommodate any number of attributes.

Code: [Select]

(defun c:CreateIndex (/ indexlist)
  (setq indexlist (getindex "Drawing-Title" '("NUM" "Title-1" "Title-2" "Title-3")))
  (princ "\n")
  (foreach dwg indexlist
    (princ (car dwg))
    (princ "\t")
    (mapcar
      '(lambda (att) (princ (cdr att)) (princ "\t"))
      (cdr dwg)
    )
    (princ "\n")
    (princ)
  )
)

[CAB]

OK for my use I did this:

Code: [Select]

(defun c:CreateIndex (/ indexlist StrList SortByIndex)

;;  CAB 07/17/09
;;  sort list given the position order to sort on
;;  positions may be ignored by omitting them from the order list
(defun SortByIndex (lst order / iidx)
  (setq len (length order))
  (vl-sort lst
           '(lambda (e1 e2 / idx)
              (setq idx -1)
              (while
                (and
                  (< (setq idx (1+ idx)) len)
                  (setq iidx (nth idx order))
                  (= (nth iidx e1) (nth iidx e2))
                )
              )
              (< (nth iidx e1) (nth iidx e2))
            )
  )
)
  
  (setq indexlist (getindex "Aproved Title Block D- Attr" '("SheetNo" "TITLE1" "TITLE2")))

  ;;  pre process the sub lists by flattening them to strings only
  ;;  then remove leading & trailing space, tab & CR
  ;;  then sort on 1st & 2nd items in the list
  (if indexlist
    (progn
      (setq StrList (mapcar '(lambda(dwg)
      (cons (car dwg) (mapcar 'cdr (cdr dwg)))
      ) indexlist))
      (setq StrList (mapcar '(lambda(dwg)
      (mapcar '(lambda(str)(vl-string-trim " \t\n" str)) dwg))
      StrList)
   StrList (SortByIndex StrList '(0 1)))
    )
      
  )

  ;;  Print the list
  (princ "\n")
  (foreach dwg StrList
    (mapcar '(lambda (str) (princ str) (princ "\t")) dwg)
    (princ "\n")
    (princ)
  )
)