Topic: Make Sheet Index using obectDBX

[GDF]

Allen

Your post, I understand. My second attempt at modifing Jeff's routine is a different condition, where I want to browse for folder one time,
and objectdbx search each drawing for two attributed blocks at a time instead on one. Each of the two blocks each has two values.

I want the final list to have each of the four values per line (if they exist).

Gary

[CAB]

To make it efficient you will need to modify getindex to accept a list
of blocks, but you already knew that.
You would call it like this.

Code: [Select]

(ARCH:CreateIndex  '(("TAG" "A-01" "SHT_TTL"))) ; 2436TAG

(ARCH:CreateIndex '(("2436TBA" "A-01" "SHT_TTL")
                    ("IAADD" "XX" "X"))) ; 2436TBA

(ARCH:CreateIndex '(("3042TBA" "A-01" "SHT_TTL"))) ; 3042TBA
And change to this

Code: [Select]

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;modified with my title block attribute "TAG" with values "A-01" "SHT_TTL"
;;;added reconstruct list coding
;;;added open notepad with sheet list
(defun ARCH:CreateIndex (lst / indexlist file)
  (setq indexlist (getindex lst))
  (if (member "acetutil.arx" (arx))(ACET-UI-PROGRESS-DONE)) ;;added progress bar finish
  (setq file (open "C:\\Temp\\SheetIndex.txt" "w"))
  (repeat
    (length indexlist)
    (setq a (car indexlist) indexlist (cdr indexlist))
    (write-line (strcat (car a) "\t" (cdr a)) file)
  )
  (close file)
  (command ".shell" "notepad C:\\Temp\\SheetIndex.txt")
)
;;;
The getIndex will take me some time to alter. I think Jeff is busy so if you can wait
I'll look at it tonight. Or maybe Tim will do it.

[GDF]

Tim

Thanks...I'm trying.

So do I keep or modify this line?

(defun getindex   (blkname attname1 attname2 / *acad atts dwgs f folder layouts masterlist name odbx val1 val2 n)

Gary

[GDF]

Allen

I get the following error:

Command: (ARCH:CreateIndex '(("2436TBA" "A-01" "SHT_TTL")("IAADD" "XX" "X")))
; error: too few arguments

Gary

[CAB]

You're jumping the gun.

The getindel must be modified to accept the list of block names & the code itself must be modified to step through the list.
Hold on for a bit & I'll see what I can come up with.

[GDF]

Allen

Thanks, I need to start taking the time to read all of the comments. I really thanks you guys for taking the time. I'm trying to find the light switch.
This has been a good exercise for me. I starting to learn how to work with list. I really like your code:


  (defun padout (word len / spaces)
    (repeat (- len (strlen word)) (setq spaces (cons 32 spaces)))
    (strcat word (vl-list->string spaces))
  )

Gary

[T.Willey]

Or maybe Tim will do it.

Why me?? 

Just kidding.  To get the most flexability out of it, I would enter into the function a list of lists.  First object in the list would be the block name, the second would be the tag names.  Then return a list of list, blockname (first object in the return list) and then a list of tag's values.

Something like

Code: [Select]

(defun GetAttValues (BlkObj TagList / ValueList)

(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
)
;--------------------------------------------------------------------------------
(defun GetBlockAtts (Doc InputList / RtnList)

(vlax-for LO (vla-get-Layouts Doc)
 (vlax-for Obj (vla-get-Block LO)
  (if
   (and
    (= (vla-get-ObjectName Obj) "AcDbBlockReference")
    (setq tmpList (assoc (vla-get-Name Obj) InputList))
   )
   (setq RtnList (cons (print (GetAttValues Obj (cdr tmpList))) RtnList))
  )
 )
)
RtnList
)
Then call it like

Code: [Select]

(setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(GetBlockAtts ActDoc (list (list "BlockName" "Att1" "Att2") (list "BlockName2" "Att1" "Att2")))

One note.  Right now the tag names are case sensitive.

[T.Willey]

Not case sensitve anymore.  Call the same as previous post.

Code: [Select]

(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
)
;--------------------------------------------------------------------------------
(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)
 (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 (cons AttList RtnList))
   )
  )
 )
)
RtnList
)
Output will look like

((("3MSCL" . "1/8\" = 1'-0\"")) (("3MR3" . "30") ("3MR2" . "29") ("3MR1" . "28")))

(TagName . AttValue)

[Jeff_M]

I'm in the process of moving, guys. I'll be out of action until Tuesday. But, Gary, it looks like your in good hands..

Good luck,
Jeff

[T.Willey]

I'm in the process of moving, guys. I'll be out of action until Tuesday. But, Gary, it looks like your in good hands..

Good luck,
Jeff

I'm still not totally unpacked from my move in August.  Hope you have a better experience.

[Kerry]

For some reason this flashed into my head ..

Little boxes on the hillside,
Little boxes made of ticky-tacky,
Little boxes, little boxes,
Little boxes, all the same.
There's a green one and a pink one
And a blue one and a yellow one
And they're all made out of ticky-tacky
And they all look just the same.

added:
probably due to a psychedelic episode from the 60's

[Tom]

Just thinking out loud but if this was expanded with a dialog  box with two columns in it.
one to find the blocks in a drawing and another to list the tags for the blocks picked it would be
a verry handy addition to any lisp library

[CAB]

Tom,
Good idea.
The problem with the routine as it was designed is that it pulls blocks from many drawings in the directory.
So the drawing you are selecting the block from may not contain the block you want.
Just a thought.

[GDF]

Jeff

Hope you move goes well. I expext you back to work on Wed?

Tim

Why you indeed....because you da man. Thanks for the code. I've got work to do.

In the mean time, I have made some modifications. I remembered that we have two identical blocks, except for the block name. The block name had
changed over the years. The routine (coded crudely) searchs block tag name, if not found uses the older block name. For now it works. Now to jump
into Tim's tips. Later.

Code: [Select]

(defun getfolder ()
  (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 (strcat " SHEET INDEX" "\tSelect drawing location for ''Sheet Files''\n\t\tCreates index of all drawings in folder.\n\t\tBy: Jeff Mishler ©2006") 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
   )
    )
  )
  (setq gotfolder (browseforfolder))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun getindex (blkname attname1 attname2 / *acad atts dwgs f folder layouts masterlist name odbx val1 val2 n)
  (if (and (setq *acad (vlax-get-acad-object))
   ;;(setq folder (browseforfolder))
           (setq folder gotfolder)
   (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)) ;;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
    (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))
   )
)
(setq masterlist
(cons (cons val1 val2) masterlist)
;(cons (list (vla-get-name odbx) (cons val1 val2)) masterlist);for testing
)
       )
     )
   )
)
       )
     )
   )
)
      )
      (mapcar 'vlax-release-object (list odbx *acad))
    )
  )
  (reverse masterlist) 
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;modified with my title block attribute "TAG" with values "A-01" "SHT_TTL"
;;;added reconstruct list coding
;;;added open notepad with sheet list
(defun ARCH:CreateIndex2436TAG ()
  (setq indexlist (getindex "TAG" "A-01" "SHT_TTL"))
  (if (member "acetutil.arx" (arx))(ACET-UI-PROGRESS-DONE)) ;;added progress bar finish   
)
;;;
(defun ARCH:CreateIndex2436TBA ()
  (setq indexlist (getindex "2436TBA" "A-01" "SHT_TTL"))
  (if (member "acetutil.arx" (arx))(ACET-UI-PROGRESS-DONE)) ;;added progress bar finish   
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:CSI (/ indexlist file)
  (getfolder)
  (ARCH:CreateIndex2436TBA)
  (if (= indexlist nil)(ARCH:CreateIndex2436TAG))
  (setq file (open "C:\\Temp\\SheetIndex.txt" "w"))
  (repeat
    (length indexlist)
    (setq a (car indexlist) indexlist (cdr indexlist))
    (write-line (strcat (car a) "\t" (cdr a)) file)
  )
  (close file)
  (command ".shell" "notepad C:\\Temp\\SheetIndex.txt")
)
(princ)

Gary

[CAB]

Gary,
This is what I have so far.
Did not look at your code, maybe later, gotta go.

My code errors out at the write to file as the list format has changed.
But I think you can fix that.

Code updated in another post