TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: GDF on February 09, 2006, 02:19:58 PM
-
Please don't think of me as being too lazy, but has anyone know of an objectDBX routine that that will extract an attribute with two values.
I want to be able to select a directory of drawings and get two values from an attributed block from each drawing to compile a lst for asheet index.
ex: value one = A1.00 (sheet number)
value two = Cover Sheet (sheet title)
Gary
-
All you need is the block name and the two attributes tags you want. Seach the space where the block should be inserted, if you don't know that, then search all the layout spaces. To do this with ObjectDBX you will have to use the ActiveX controls. Is this enough to get you started? What part of the code do you have already?
-
Tim
I have not made up my mind which way to go. I like Peter Jamtgaard's DBXTX routine and I like your DBX-BlockCopy.lsp routine.
Where i need help is extracing the two attributes values from each sheet and compiling them into a list.
I have heard of a routine out there that is similar to this....at least to get me going.
Here is Peter's routine (uncompiled).
Would I start with this?
;;; Extract attribute value given Block object and Tagstring
(defun CODE:GET_ATTVAL (EOBJ TAG / ATTOBJ STR)
(vl-load-com)
(if (= (type EOBJ) 'ename)
(setq EOBJ (vlax-ename->vla-object EOBJ))
)
(if (and (= (type EOBJ) 'vla-object)
(= (vla-get-hasattributes EOBJ) :vlax-true)
)
(progn
(foreach
ATTOBJ
(vlax-safearray->list
(variant-value
(vla-getattributes EOBJ)
)
)
(if (= (strcase (vla-get-tagstring ATTOBJ))
(strcase TAG)
)
(setq STR (vla-get-textstring ATTOBJ))
)
)
)
)
(if (not STR)
(setq STR "")
)
STR
)
Gary
-
Here is code that will search the whole drawing, and return a list of block objects that match the block name supplied.
(defun GetBlockList (Doc BlkName / BlkList)
(vlax-for LO (vla-get-Layouts Doc)
(vlax-for Obj (vla-get-Block LO)
(if
(and
(= (vla-get-ObjectName Obj) "AcDbBlockReference")
(= (strcase (vla-get-Name Obj)) (strcase BlkName))
)
(setq BlkList (cons Obj BlkList))
)
)
)
BlkList
)
Now all you have to do is get the correct attributes to extract the inforamation you want.
(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
)
Untested, but should work.
-
Thanks Tim. I will work on it tonight.
I got a lot broken links in my google search...searching for objectdbx attrubute
Gary
-
Gary,
See if this will do what you want....or at least get you close.
;|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 / *acad atts dwgs f folder layouts masterlist name odbx val1 val2)
(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.16"
)
)
)
(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))
)
)
(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)
)
;;;Test with my title block
(defun c:createindex ()
(setq indexlist (getindex "TDG" "NO" "SHEET_NAME"))
)
This returns:
(("1" . "TITLE SHEET") ("2" . "NOTES AND SECTIONS") ("3" . "GRADING PLAN") ("4"
. "IMPROVEMENT PLAN") ("5" . "PROFILES") ("6" . "PINER ROAD X-SECTIONS") ("7" .
"SIGNING, LIGHTING AND STRIPING PLAN") ("8" . "EROSION CONTROL PLAN") ("9" .
"OFFSITE STORM DRAIN IMPROVEMENT PLAN"))
Edit: Added the returned value and changed the return from the function to be (reverse masterlist)
-
Just know that when you use ObjectDBX you can't use any ssget stuff. You have to use the ActiveX controls to step though the document, and make sure that you release it. Jeff wrote an article about ObjectDBX, and I think it is here. Just do an advance search, with the author Jeff_M and then ObjectDBX, and you should come up with some good stuff.
Jeff beat me to the punch, but I still want to post what I typed.
-
Gary,
See if this will do what you want....or at least get you close.
........
I reckon that'd be pretty close :-)
-
Thanks Jeff
Man how do you guys learn this stuff?
All I see is vla-blahblahblah.........I am going to have learn this.
Gary
-
Jeff
THANK YOU
I just realized that you had a complete routine!
This is my rusetls from your routine:
(("A0.00" . "Cover") ("A0.01" . "Site Plan") ("A1.01" . "Project Data")
("A1.02a" . "Fire Proofing Data") ("A1.02b" . "Fire Proofing Data") ("A1.02c" .
"Fire Proofing Data") ("A1.03" . "Fair Housing Data") ("A1.04" . "TAS Handicap
Data") ("A1.05" . "TAS Handicap Data") ("A2.00a" . "Foundation Layout Plan")
("A2.00b" . "First Floor Layout Plan") ("A2.00c" . "Second Floor Layout Plan")
("A2.00d" . "Third Floor Layout Plan") ("A2.00e" . "Roof Layout Plan")
("A2.01a" . "Foundation Plan Bldg I") ("A2.01b" . "First Floor Plan Bldg I")
("A2.01c" . "Second Floor Plan Bldg I") ("A2.01d" . "Third Floor Plan Bldg I")
("A2.01e" . "Roof Plan Bldg I") ("A2.02a" . "Foundation Plan Bldg II")
("A2.02b" . "First Floor Plan Bldg II") ("A2.02c" . "Second Floor Bldg II")
("A2.02d" . "Third Floor Plan Bldg II") ("A2.02e" . "Roof Plan Bldg II")
("A3.00" . "Schedules") ("A3.01" . "Unit Plan A2") ("A3.02a" . "Unit Plan A3")
("A3.02b" . "Unit Plan A3 HC") ("A3.03" . "Unit Plan B1") ("A3.04a" . "Unit
Plan B3") ("A3.04b" . "Unit Plan B3 HC") ("A4.01" . "Building Elevations")
("A4.02" . "Building Elevations") ("A4.03" . "Building Elevations") ("A4.04" .
"Building Elevations") ("A4.05" . "Building Elevations") ("A4.06" . "Building
Elevations") ("A5.01" . "Wall Section") ("A5.02" . "Wall Section") ("A5.03" .
"Wall Section") ("A5.04" . "Wall Section") ("A6.01" . "Stair Plans") ("A6.02" .
"Elevator") ("A6.03" . "Enlarged Plans") ("A6.04" . "Stair Sections") ("A6.05"
. "Stair Sections") ("A7.01" . "Detail") ("A7.02" . "Details") ("A7.03" .
"Details") ("A7.04" . "Details") ("A7.05" . "Details") ("A7.06" . "Details")
("A7.06" . "Details") ("A7.06" . "Details") ("A7.07" . "Details") ("A8.01a" .
"Foundation Plan Club") ("A8.01b" . "First Floor Plan Club") ("A8.01c" .
"Second Floor Plan Club") ("A8.01d" . "Third Floor Plan Club") ("A8.01e" .
"Roof Plan Club") ("A8.02a" . "First Floor RCP Club") ("A8.02b" . "Second Floor
RCP Club") ("A8.02c" . "Third Floor RCP Club") ("A8.03" . "Elevations")
("A8.04" . "Elevations - Bldg Sections") ("A8.05" . "Enlarged Plans") ("A8.06"
. "Wall Section") ("A8.07" . "Wall Section") ("A8.08" . "Wall Section")
("A9.01" . "Maintenance") ("A9.02" . "Trash"))
Gary (I'm in your debt)
-
You're welcome! Your request for this rekindled an idea I had about a year ago that I shelved for lack of time....and promptly forgot about.
Just out of curiosity, what is a "rusetls"? A new type of potato? :lmao: :kewl:
-
Really, I speak better than I type.
Gary
-
Jeff
Here is a modified version:
code:
(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")
)
)
Results:
A0.00 Cover
A0.01 Site Plan
A1.01 Project Data
A1.02a Fire Proofing Data
A1.02b Fire Proofing Data
A1.02c Fire Proofing Data
A1.03 Fair Housing Data
A1.04 TAS Handicap Data
A1.05 TAS Handicap Data
A2.00a Foundation Layout Plan
A2.00b First Floor Layout Plan
A2.00c Second Floor Layout Plan
A2.00d Third Floor Layout Plan
A2.00e Roof Layout Plan
A2.01a Foundation Plan Bldg I
A2.01b First Floor Plan Bldg I
A2.01c Second Floor Plan Bldg I
A2.01d Third Floor Plan Bldg I
A2.01e Roof Plan Bldg I
A2.02a Foundation Plan Bldg II
A2.02b First Floor Plan Bldg II
A2.02c Second Floor Bldg II
A2.02d Third Floor Plan Bldg II
A2.02e Roof Plan Bldg II
A3.00 Schedules
A3.01 Unit Plan A2
A3.02a Unit Plan A3
A3.02b Unit Plan A3 HC
A3.03 Unit Plan B1
A3.04a Unit Plan B3
A3.04b Unit Plan B3 HC
A4.01 Building Elevations
A4.02 Building Elevations
A4.03 Building Elevations
A4.04 Building Elevations
A4.05 Building Elevations
A4.06 Building Elevations
A5.01 Wall Section
A5.02 Wall Section
A5.03 Wall Section
A5.04 Wall Section
A6.01 Stair Plans
A6.02 Elevator
A6.03 Enlarged Plans
A6.04 Stair Sections
A6.05 Stair Sections
A7.01 Detail
A7.02 Details
A7.03 Details
A7.04 Details
A7.05 Details
A7.06 Details
A7.06 Details
A7.06 Details
A7.07 Details
A8.01a Foundation Plan Club
A8.01b First Floor Plan Club
A8.01c Second Floor Plan Club
A8.01d Third Floor Plan Club
A8.01e Roof Plan Club
A8.02a First Floor RCP Club
A8.02b Second Floor RCP Club
A8.02c Third Floor RCP Club
A8.03 Elevations
A8.04 Elevations - Bldg Sections
A8.05 Enlarged Plans
A8.06 Wall Section
A8.07 Wall Section
A8.08 Wall Section
A9.01 Maintenance
A9.02 Trash
Thank you again.
Gary
-
Jeff
FYI
You can place in a string value for a titlle in the BrowseForFolder:
(setq folder
(vlax-invoke-method
sh 'BrowseForFolder 0 (strcat "Jeff Mishler's" " : Select Drawings Folder for Sheet Index") 0)
)
Gary
-
Gary,
Try this for formatting.
(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 "2436TBA" "A-01" "SHT_TTL"))
(foreach itm indexlist
(princ "\n")
(princ (strcat (padout (car itm) 12) (cdr itm)))
)
(princ)
)
-
Thanks, Gary! I knew about being able to add a description to that dialog, but it never even crossed my mind to make it like that.
/me is off to update dozens of functions that utilize that......
-
Jeff
I still can't thank you enough. Hope you don't mind, I've added to you routine the following:
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
My next goal is to use excel in lieu of notepad, and fill in cells within the excel file. There are probably some examples out there.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; This original Copyrighted routine has been modified...
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;function to extract 2 attribute values from a specific block in the drawings of a specified folder
;;;by Jeff Mishler Feb. 9, 2006
;;;
;;;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
;;;by Gary Fowler
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun getindex (blkname attname1 attname2 / *acad atts dwgs f folder layouts masterlist name odbx val1 val2 n)
(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
)
)
)
(if (and (setq *acad (vlax-get-acad-object))
(setq folder (browseforfolder))
(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 (/ indexlist file)
(setq indexlist (getindex "TAG" "A-01" "SHT_TTL"))
(if (member "acetutil.arx" (arx))(ACET-UI-PROGRESS-DONE)) ;;added progress bar finish
;|
(princ "\n")
(repeat
(length indexlist)
(setq a (car indexlist) indexlist (cdr indexlist))
(princ (car a))
(princ "\t")
(princ (cdr a))
(princ "\n")
)
|;
(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")
)
;;;
(defun ARCH:CreateIndex2436TBA (/ indexlist file)
(setq indexlist (getindex "2436TBA" "A-01" "SHT_TTL"))
(if (member "acetutil.arx" (arx))(ACET-UI-PROGRESS-DONE)) ;;added progress bar finish
;|
(princ "\n")
(repeat
(length indexlist)
(setq a (car indexlist) indexlist (cdr indexlist))
(princ (car a))
(princ "\t")
(princ (cdr a))
(princ "\n")
)
|;
(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")
)
;;;
(defun ARCH:CreateIndex3042TBA (/ indexlist file)
(setq indexlist (getindex "3042TBA" "A-01" "SHT_TTL"))
(if (member "acetutil.arx" (arx))(ACET-UI-PROGRESS-DONE)) ;;added progress bar finish
;|
(princ "\n")
(repeat
(length indexlist)
(setq a (car indexlist) indexlist (cdr indexlist))
(princ (car a))
(princ "\t")
(princ (cdr a))
(princ "\n")
)
|;
(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)
;;;(ARCH:CreateIndex2436TAG)
;;;(ARCH:CreateIndex2436TBA)
;;;(ARCH:CreateIndex3042TBA)
[\code]
Gary
-
Allen
Thanks for the cleaner list formatting. I am the worst when it comes to handling lists.
Gary
-
...
My next goal is to use excel in lieu of notepad, and fill in cells within the excel file. There are probably some examples out there.
...
Gary,
Try this (http://www.theswamp.org/forum/index.php?topic=7467.msg93479#msg93479) for starters.
-
Jeff
I still can't thank you enough. Hope you don't mind,
<snip>
Not at all.....recall what I posted with the original code:See if this will do what you want....or at least get you close
it was my intention to get the basic code for what you needed and left it up to you how the returned data was used. :-D And I think you've done quite well!
-
Thanks WHDJR
Thanks for the link......I have a lot to study up on this weekend.
p.s. what is your first name?
Gary
-
Gary, check his sig line......
-
p.s. what is your first name?
Gary
It's a secret...I could tell you but you know what would happen... :-D
What Jeff said. :wink:
-
Will
You know i wear trifocals..............
Gary
-
That means 3 times better than me right?
-
Jeff
I have another question for you. How would you modify your example to handle 2 attributed blocks, each having two values?
Already have the first attributed block for No. and Title.... second attributed block would be for Date and # (if block exist). I'm
looking but need some hints.
The routine wold need to go thru each sheet as before and give the following results:
Date # No. Title
----------------------------------------------------------------------
12 Feb 2006 1 A0.00 Cover
Gary
-
Jeff
This is my first attemp....as you can see, this is not what I want. I'm trying.
(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"
)
)
(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 Creates index of all drawings in folder.\n\t\t By: 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)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:TBA (/ indexlist padout)
(getfolder)
(setq indexlist1 (getindex "2436TBA" "A-01" "SHT_TTL"))
(setq indexlist2 (getindex "IAADD" "XX" "X"))
(if (member "acetutil.arx" (arx))(ACET-UI-PROGRESS-DONE)) ;;added progress bar finish
(princ)
)
Gary
-
Gary
You can make this a reusable function like this.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;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 (blkname attname1 attname2 / indexlist file)
(setq indexlist (getindex blkname attname1 attname2))
(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")
)
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(princ)
(ARCH:CreateIndex "TAG" "A-01" "SHT_TTL") ; 2436TAG
(ARCH:CreateIndex "2436TBA" "A-01" "SHT_TTL") ; 2436TBA
(ARCH:CreateIndex "3042TBA" "A-01" "SHT_TTL") ; 3042TBA
-
Allen
My head hurts.
Thanks, but now how would I use the routine for compiling the list using the two blocks so that I would have only one list?
(setq indexlist1 (getindex "2436TBA" "A-01" "SHT_TTL")) ;first block
(setq indexlist2 (getindex "IAADD" "XX" "X")) ;second block
Gary
-
If you want to check while in the same drawing for different blocks, then change this area.
(if (and (eq (vla-get-objectname ent)
"AcDbBlockReference"
)
(eq (strcase (vla-get-name ent))
(strcase blkname)
)
)
to
(if
(and
(eq (vla-get-objectname ent) "AcDbBlockReference" )
(vl-position (strcase (vla-get-name ent)) BlkNameList)
)
Then enter in just a list of block names, in all capitols, when calling the sub.
-
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
-
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.
(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
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;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.:)
-
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
-
Allen
I get the following error:
Command: (ARCH:CreateIndex '(("2436TBA" "A-01" "SHT_TTL")("IAADD" "XX" "X")))
; error: too few arguments
Gary
-
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.
-
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
-
Or maybe Tim will do it.:)
Why me?? :cry:
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
(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
(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.
-
Not case sensitve anymore. Call the same as previous post.
(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)
-
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 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.
-
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
-
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
-
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.
-
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.
(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
-
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
-
Allen
Thanks. I think your on the right track, don't know why it stops.
(ARCH:CreateIndex '(("2436TBA" "A-01" "SHT_TTL")("IAADD" "XX" "X")))
Command: (ARCH:CreateIndex '(("2436TBA" "A-01" "SHT_TTL")("IAADD" "XX" "X")))
; error: bad argument type: stringp (("SHT_TTL" . "Cover") ("A-01" . "A0.00"))
Will play with it at home. I'm out to.
Gary
-
Allen
YES, THANK YOU. I got the following to work. Now it's back to recompiling the 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")
|;
(princ indexlist)
)
I did a small test on one drawing that has both blocks and this is the result:
Block one is 2436TBA .....this is the sheet attribute which contains sheet number and name
Block two is IRREV .........this is revison delta with revision number and date
(ARCH:CreateIndex '(("2436TBA"
"A-01" "SHT_TTL")("IRREV" "XX" "X")))
((((XX . 20 May 2002) (X . 2))))(((("XX" . "20 May 2002") ("X" . "2"))))
So, now its back to working with the resulting list, and making the following work:
(repeat
(length indexlist)
(setq a (car indexlist) indexlist (cdr indexlist))
(write-line (strcat (car a) "\t" (cdr a)) file)
)
Thank you again for your time Allen (and to Jeff and Tim).
Gary (I found the light switch, now can someone reach it)
-
Oops, I spoke too soon. It's only reading one of the two blocks.
Grrrrrrrrrrr
-
Here try this one.
Code removed to update.
-
Good idea.
The problem with the routine as it was designed is that it pulls blocks from many drawings in the directory.
You could have a select drawing or select directory button
or just filter out drawings that do not contain the required blocks or tags
-
Revised code.
List in in drawing order/tab order with headers.
Code removed, revised
-
Allen
Thanks for the new update. Thanks for your time on this.
I have here the results of yours and Tim's previous routine fixes for my request for finding two attributed blocks within each drawing.
("TAG" "A-01" "SHT_TTL") is the "sheet title-number"
("IRREV" "XX" "X") is the "revision number-date"
;;;from the CRX.lso routine (stripped down version which uses your previous fix)
(defun C:CRX () ;(/ indexlist)
(defun padout (word len / spaces)
(repeat (- len (strlen word)) (setq spaces (cons 32 spaces)))
(strcat word (vl-list->string spaces))
)
(setq indexlist (getindex '(("IRREV" "XX" "X") ("TAG" "A-01" "SHT_TTL"))))
(if (member "acetutil.arx" (arx))(ACET-UI-PROGRESS-DONE)) ;;added progress bar finish
(foreach itm indexlist
(princ "\n")
(princ (strcat
(padout (cdr (caar itm)) 16) (cdr (cadar itm)) ;this may not be the best way?
"\t"
(padout (cdr (caadr itm)) 22) (cdr (cadadr itm))) ;this may not be the best way?
)
)
(princ)
)
This is the result that I am after with princ to the command line (similar to write to file):
11 Feb 2006 1 Title Sheet A0.00
12 Feb 2006 2 Site Plan A0.01
12 Feb 2006 3 Project Data A1.01
The next question I have is how do I keep the routine from erroring out if the second block "revision number-date" is not found? In other words all
of the drawings in the directory will have the "shee ttitle-number" block and some will only have an "revision number-date" block. I f the "revision number-date"
is not found the routine quits.
11 Feb 2006 1 Title Sheet A0.00
error (if "revision number-date" not found) <-- here I want only the "sheet title-number" found in every drawing
I have included stripped down drawings. In the second drawing, erase the revison attributed block and run the routine.
Gary
-
Allen
Sorry, I should have tried this latest version before I posted the last time. Thank you again for your time and effort. I am in your debt.
I tested your laters version. It work perfectly. I had to change it to: (ARCH:CreateIndex '(("IRREV" "XX" "X") ("2436TBA" "A-01" "SHT_TTL")))
I f the revision block is found it reads it, if not found it skips over it. Not explain how you did this...remeber I'm a beginner.
P.S. your previous fix and Tim's fix worked also, only if both blocks are found. Sinc I only use one layout how would you modify this latest version
to get the following format?
11 Feb 2006 1 Title Sheet A0.00
Site Plan A0.01
12 Feb 2006 3 Project Data A1.01
The reason I ask is because my next step is to prepare the results for importing into excel.
Results from your latest version:
<<< A0-00.dwg >>>
--- FullSize ---
SHT_TTL Cover
A-01 A0.00
--- Model ---
<<< A0-01.dwg >>>
--- FullSize ---
SHT_TTL Site Plan
A-01 A0.01
--- Model ---
<<< A1-01.dwg >>>
--- FullSize ---
SHT_TTL Project Data
A-01 A1.01
--- Model ---
<<< A1-02.dwg >>>
--- FullSize ---
SHT_TTL Fire Proofing Data
A-01 A1.02
--- Model ---
<<< A1-03.dwg >>>
--- FullSize ---
SHT_TTL Fair Housing Data
A-01 A1.03
--- Model ---
<<< A1-04.dwg >>>
--- FullSize ---
SHT_TTL ADA Handicap Data
A-01 A1.04
--- Model ---
<<< A1-05.dwg >>>
--- FullSize ---
SHT_TTL TAS Handicap Data
A-01 A1.05
--- Model ---
<<< A2-01a.dwg >>>
--- FullSize ---
SHT_TTL Foundation Plan
A-01 A2.01a
--- Model ---
<<< A2-01b.dwg >>>
--- FullSize ---
SHT_TTL Floor Plan
A-01 A2.01b
--- Model ---
<<< A2-01c.dwg >>>
--- FullSize ---
SHT_TTL Floor Plan
A-01 A2.01c
--- Model ---
<<< A2-01d.dwg >>>
--- FullSize ---
SHT_TTL Floor Plan
A-01 A2.01d
--- Model ---
<<< A2-01e.dwg >>>
--- FullSize ---
SHT_TTL Roof Plan
A-01 A2.01e
--- Model ---
<<< A2-02a.dwg >>>
--- FullSize ---
SHT_TTL Foundation Plan
A-01 A2.02a
--- Model ---
<<< A2-02b.dwg >>>
--- FullSize ---
SHT_TTL Floor Plan
A-01 A2.02b
--- Model ---
<<< A2-02c.dwg >>>
--- FullSize ---
SHT_TTL Floor Plan
A-01 A2.02c
--- Model ---
<<< A2-02d.dwg >>>
--- FullSize ---
SHT_TTL Floor Plan
A-01 A2.02d
--- Model ---
<<< A2-02e.dwg >>>
--- FullSize ---
SHT_TTL Roof Plan
A-01 A2.02e
--- Model ---
<<< A2-03a.dwg >>>
--- FullSize ---
SHT_TTL Foundation Plan
A-01 A2.03a
--- Model ---
<<< A2-03b.dwg >>>
--- FullSize ---
SHT_TTL Floor Plan
A-01 A2.03b
--- Model ---
<<< A2-03c.dwg >>>
--- FullSize ---
SHT_TTL Floor Plan
A-01 A2.03c
--- Model ---
<<< A2-03d.dwg >>>
--- FullSize ---
SHT_TTL Floor Plan
A-01 A2.03d
--- Model ---
<<< A2-03e.dwg >>>
--- FullSize ---
SHT_TTL Roof Plan
A-01 A2.03e
--- Model ---
<<< A3-00.dwg >>>
--- FullSize ---
SHT_TTL Schedules
A-01 A3.00
--- Model ---
<<< A3-01.dwg >>>
--- FullSize ---
SHT_TTL Unit Plan
A-01 A3.01
--- Model ---
<<< A3-02a.dwg >>>
--- FullSize ---
SHT_TTL Unit Plan
A-01 A3.02a
--- Model ---
<<< A3-02b.dwg >>>
--- FullSize ---
SHT_TTL Unit Plan
A-01 A3.02b
--- Model ---
<<< A3-02c.dwg >>>
--- FullSize ---
SHT_TTL Unit Plan
A-01 A3.02c
--- Model ---
<<< A3-03a.dwg >>>
--- FullSize ---
SHT_TTL Unit Plan
A-01 A3.03a
--- Model ---
<<< A3-03b.dwg >>>
--- FullSize ---
SHT_TTL Unit Plan
A-01 A3.03b
--- Model ---
<<< A3-03c.dwg >>>
--- FullSize ---
SHT_TTL Unit Plan
A-01 A3.03c
--- Model ---
<<< A3-03d.dwg >>>
--- FullSize ---
SHT_TTL Unit Plan
A-01 A3.03d
--- Model ---
<<< A3-03e.dwg >>>
--- FullSize ---
SHT_TTL Unit Plan
A-01 A3.03e
--- Model ---
<<< A3-04.dwg >>>
--- FullSize ---
SHT_TTL Unit Plan
A-01 A3.04
--- Model ---
<<< A3-05a.dwg >>>
--- FullSize ---
SHT_TTL Unit Plan
A-01 A3.05a
--- Model ---
<<< A3-05b.dwg >>>
--- FullSize ---
SHT_TTL Unit Plan
A-01 A3.05b
--- Model ---
<<< A3-05c.dwg >>>
--- FullSize ---
SHT_TTL Unit Plan
A-01 A3.05c
--- Model ---
<<< A4-01.dwg >>>
--- FullSize ---
SHT_TTL Building Elevations
A-01 A4.01
--- Model ---
<<< A4-02.dwg >>>
--- FullSize ---
SHT_TTL Building Elevations
A-01 A4.02
--- Model ---
<<< A4-03.dwg >>>
--- FullSize ---
SHT_TTL Building Elevations
A-01 A4.03
--- Model ---
<<< A5-01.dwg >>>
--- FullSize ---
SHT_TTL Wall Sections
A-01 A5.01
--- Model ---
<<< A5-02.dwg >>>
--- FullSize ---
SHT_TTL Wall Sections
A-01 A5.02
--- Model ---
<<< A5-03.dwg >>>
--- FullSize ---
SHT_TTL Wall Sections
A-01 A5.03
--- Model ---
<<< A5-04.dwg >>>
--- FullSize ---
SHT_TTL Wall Sections
A-01 A5.04
--- Model ---
<<< A5-05.dwg >>>
--- FullSize ---
SHT_TTL Wall Sections
A-01 A5.05
--- Model ---
<<< A6-01.dwg >>>
--- FullSize ---
SHT_TTL Stairs
A-01 A6.01
--- Model ---
<<< A6-02.dwg >>>
--- FullSize ---
SHT_TTL Stairs
A-01 A6.02
--- Model ---
<<< A6-03.dwg >>>
--- FullSize ---
SHT_TTL Stairs
A-01 A6.03
--- Model ---
<<< A6-04.dwg >>>
--- FullSize ---
SHT_TTL Stairs
A-01 A6.04
--- Model ---
<<< A7-01.dwg >>>
--- FullSize ---
SHT_TTL Details
A-01 A7.01
--- Model ---
<<< A7-02.dwg >>>
--- FullSize ---
SHT_TTL Details
A-01 A7.02
XX 22 July 2005
X 2
--- Model ---
<<< A7-03.dwg >>>
--- FullSize ---
SHT_TTL Details
A-01 A7.03
--- Model ---
<<< A7-04.dwg >>>
--- FullSize ---
SHT_TTL Details
A-01 A7.04
--- Model ---
<<< A7-05.dwg >>>
--- FullSize ---
SHT_TTL Details
A-01 A7.05
--- Model ---
<<< A7-06.dwg >>>
--- FullSize ---
SHT_TTL Details
A-01 A7.06
--- Model ---
<<< A7-07.dwg >>>
--- FullSize ---
SHT_TTL Details
A-01 A7.07
--- Model ---
<<< A8-00.dwg >>>
--- FullSize ---
SHT_TTL Schedules
A-01 A8.00
--- Model ---
<<< A8-01.dwg >>>
--- FullSize ---
SHT_TTL Foundation Plan
A-01 A8.01
--- Model ---
<<< A8-02.dwg >>>
--- FullSize ---
SHT_TTL Leasing Office Plan
A-01 A8.02
--- Model ---
<<< A8-03.dwg >>>
--- FullSize ---
SHT_TTL Ceiling Plan
A-01 A8.03
--- Model ---
<<< A8-04.dwg >>>
--- FullSize ---
SHT_TTL Roof Plan
A-01 A8.04
--- Model ---
<<< A8-05.dwg >>>
--- FullSize ---
SHT_TTL Elevations
A-01 A8.05
--- Model ---
<<< A8-06.dwg >>>
--- FullSize ---
SHT_TTL Elevations
A-01 A8.06
--- Model ---
<<< A8-07.dwg >>>
--- FullSize ---
SHT_TTL Elevations
A-01 A8.07
--- Model ---
<<< A8-08.dwg >>>
--- FullSize ---
SHT_TTL Wall Sections
A-01 A8.08
--- Model ---
<<< A9-01.dwg >>>
--- FullSize ---
SHT_TTL Mail Kiosk
A-01 A9.01
--- Model ---
<<< A9-02.dwg >>>
--- FullSize ---
SHT_TTL Garage / Maint. Bldg.
A-01 A9.02
--- Model ---
<<< A9-03.dwg >>>
--- FullSize ---
SHT_TTL Garage
A-01 A9.03
--- Model ---
<<< A9-04.dwg >>>
--- FullSize ---
SHT_TTL Garage
A-01 A9.04
--- Model ---
<<< A9-05.dwg >>>
--- FullSize ---
SHT_TTL Sign and Cabana
A-01 A9.05
--- Model ---
-
Here is a revision:
Look at the new CRX routine.
Note all routines are new.
-
Allen
You are good, and fast.
In your previous routine:
(foreach dwg indexlist
(foreach itm dwg
(if (cdr itm) ;this is to test of non nil?
(write-line (strcat "" "\t" (cdr itm)) file)
;(write-line (strcat (car itm) "\t" (cdr itm)) file) ;if not needed
;(write-line (car itm) file) ;if not needed
)
)
)
I like you latest version the best.
And, I see how you did it in the latest version. Sweet. I tried yesterday to figure it out and I was too close to the trees.
I have learned at lot from this exercise. I now have a better handle on lists and I forgot all about assoc. The car's are getting easier.
Saying thanks again seems so lame. You have helped me understand lisp what no book could ever do.
THANKS AGAIN
Gary
-
One more time, found a bug when write to a file.
You're welcome. :-)
-
Allen
This does not include your latest fix. Where is the bug located (which function)?
Here is my revised routine base upon your latest post and a typical sheet index from the revised routine.
The routine searchs for these two blocks: revision "IRREV" and addedum "IAADD".
It also searchs for the sheet title block either: "TAG" and if not found then "2436TBA".
This works perfectly, an update to your latest post:
(setq blkData '(("IRREV" "XX" "X")("2436TBA" "A-01" "SHT_TTL")("IAADD" "XX" "X")("TAG" "A-01" "SHT_TTL")))
All I need to do now is revise the routine to read the issue date found in the titleblock drawing
"2436TB.dwg", which is xrefed into each sheet file and located in the sheet file directory. Then I can
remove the temporate function: (setq date (ARCH:C_DATE-ISSUE (getvar "tdupdate"))).
Until this search of drawing "2436TB.dwg" is made, I will just have to update the "SheetIndex.txt" file.
;;current date function:
(defun ARCH:C_DATE-ISSUE (j / y d m)
(setq j (fix j)
j (- j 1721119.0)
y (fix (/ (1- (* 4 j)) 146097.0))
j (- (* j 4.0) 1.0 (* 146097.0 y))
d (fix (/ j 4.0))
j (fix (/ (+ (* 4.0 d) 3.0) 1461.0))
d (- (+ (* 4.0 d) 3.0) (* 1461.0 j))
d (fix (/ (+ d 4.0) 4.0))
m (fix (/ (- (* 5.0 d) 3) 153.0))
d (- (* 5.0 d) 3.0 (* 153.0 m))
d (fix (/ (+ d 5.0) 5.0))
y (+ (* 100.0 y) j))
(if (< m 10.0)
(setq m (+ m 3))
(setq m (- m 9)
y (1+ y)))
(strcat (if (< D 10)
"0"
"")
(itoa (fix D))
" "
(nth (1- (fix m))
(list "Jan" "Feb" "March" "April" "May" "June" "July" "Aug" "Sept" "Oct" "Nov"
"Dec"))
" "
(substr (itoa (fix Y)) 1 4)
;;3 2)
))
Thank you for all of your help. The routine now works as I had hoped. Importing into excel is down the road.
Gary
-
Revised these routines
getblockatts
ARCH:CreateIndex
C:CRX
Replacing them with mine should not affect what you are doing.
It corrects a bug in the layout name.
-
Allen
Here is my new TEST updated version. I created a getfolder function from the getindex main function. This routine now does two passes,
one for the titlblock drawing (only one per directory, that is xrefed into each sheet file) to get the issue date. The second pass is the original
search for attributed blocks for sheet name, number etc.....
Still needs some cleanup.
Gary
-
Allen
oops, here is the file.
Need to simplify the first pass thru the directory, only needs to get one drawing file.
Gary
-
Gary
I changed the way var 'folder' is used so it's not global.
When you call getindex2 it is passed to it so it stays local.
And changed 'getfolder' so it doesn't set a global but returns the needed info.
so this collects it. (setq folder (getfolder))
I put a CAB in most of the lines where I made changes.
-
Allen
Thanks. Works great. Now I'm really behind in my other work. This routine will say me tons of time.
You sir are da man. This has been a fun project. Thanks again to you, Tim Willey and Jeff Mishler.
Gary
-
Glad you and Alan got something you are happy with. I only code on week days, since that is the only place I have CAD and can test if needs be, so sorry I couldn't be any help this weekend. Looks like you two had fun.
-
Tim
You really missed out.
Gary :lmao:
-
Hmm, me too! But the good news is that I'm 1/2 done moving........can't wait to check out what you guys came up with, but no time now.
-
Jeff
You know we could not wait for you to get moved in to finish this up. I worked Allen hard on this little project.
I think I've used up all of his free time. Need to get Tim working on the weekend.
I want to thank you all again for spoon feeding me.
Gary
-
As long as you learn something, then it's all worth it. And unless you pay me big $$$, then I don't think I will be working weekends. :lmao:
Hope move goes better than mine did Jeff.
-
Here is the latest update, added a dcl interface.
Gary
-
Small correction, along with sample drawings for testing.
Later
Gary
-
Allen
This is a similar request. I am using your routine to now search of multiple occurancess of the same attributed block.
And, I am stuck on how to do this. I have it searching for the right block which has three values. My problem is that it only lists
one occurrance of the block, and each drawing has up to fifteen.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;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
;;;
;;;added reconstruct list coding
;;;added open notepad with room finish list
;;;
;;;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 ''Room Files''\n\t\t Creates index of all drawings in folder.\n\t\t By: Jeff Mishler and Allen Butler") 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) ; return the folder ;Allen Butler fix
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun getindex (blkList folder / *acad atts dwgs f layouts masterlist name odbx val1 val2 n)
(if (and (setq *acad (vlax-get-acad-object))
folder ;CAB
(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)(ARCH:WORKING))
;;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
;; check for blocks
(vl-remove
nil
(mapcar
'(lambda (x)
(not (vl-catch-all-error-p
(vl-catch-all-apply
'(lambda () (vla-item (vla-get-blocks odbx) (car x)))))))
blklist))) ; and
(setq masterlist
(cons
(cons
(cons "DWG"
(strcat "" (vl-filename-base dwg) "")) ;.dwg
(GetBlockAtts odbx blkList))
masterlist))))
(mapcar 'vlax-release-object (list odbx *acad))))
(reverse masterlist))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;functions by Allen Butler
(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)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;functions by Allen Butler
(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)
(setq rtnlist
(if rtnlist
(append rtnlist
(list (cons "TAB" (strcat "--- " (vla-get-name lo) " ---"))))
(list (cons "TAB" (strcat "--- " (vla-get-name lo) " ---")))))
(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 (append rtnlist attlist))))))
rtnlist)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;; List of Attributed Blocks Values - change to suite ;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun CRIIT (/ indexlist blkData file x a b c folder got-list op dcl_id)
(defun dcl_error ()
(ARCH:MsgBox
" DCL Error" 16"
File could not be Found.
--------------------------------------------------------------------------------------------
Lisp Routine's DCL File not found. Check and Verify Support Paths."
)
(exit)
)
(defun about_help ()
(ARCH:MsgBox
" Rules of Thumb" 64"
Program Information
--------------------------------------------------------------------------------------------
This routine searches for custom attributed blocks change to meet
your CAD Standards."
)
)
(setq folder (getfolder)) ;CAB
;;functions by Allen Butler
(defun padout (word len / spaces)
(repeat (- len (strlen word)) (setq spaces (cons 32 spaces)))
(strcat word (vl-list->string spaces)))
;--------------------------------------------------------------------------------
;;searchs for these blocks revision "RM-TAG"
(setq blkData '(("RM-TAG" "ROOM" "ROOM-NO" "FINISH")))
;--------------------------------------------------------------------------------
(setq indexlist (getindex blkdata folder)) ;get attributed blocks from all unit file drawings CAB
;--------------------------------------------------------------------------------
(if (member "acetutil.arx" (arx))
(ACET-UI-PROGRESS-DONE))
;;added progress bar finish
(setq file (open "C:\\Temp\\RoomIndex.txt" "w"))
;--------------------------------------------------------------------------------
(foreach
dwg indexlist
;;write to list_box and notepad
(if (assoc "DWG" dwg)(setq x (padout (cdr (assoc "DWG" dwg)) 10)))
(if (assoc (cadar blkdata) dwg)
(setq a (padout (cdr (assoc (cadar blkdata) dwg)) 16))
(setq a (padout "" 16)))
(if (assoc (caddar blkdata) dwg)
(setq b (padout (cdr (assoc (caddar blkdata) dwg)) 5))
(setq b (padout "" 5)))
(if (assoc (car (cdddar blkdata)) dwg)
(setq c (padout (cdr (assoc (car (cdddar blkdata)) dwg)) 10))
(setq c (padout "" 10)))
(write-line (strcat x) file)
(write-line (strcat " " a b c) file)
;;(setq got-list (append (list (strcat a b c)) got-list))
(setq got-list (append (list x) (list (strcat " " a b c)) got-list))
)
(close file)
;;added dialog box interface
(defun do_act (key_pr) (setq op key_pr)(done_dialog)(princ))
(setq ARCH#LOGO " Arch Program©")
(setq ARCH#YEAR (substr (rtos (getvar "CDATE") 2 16) 1 4))
;;(setq dcl_id (load_dialog (strcat "" "ARCH_CreateRoomIndex-CRI.dcl")))
(setq dcl_id (load_dialog (strcat ARCH#CUSF "BLOC/" "ARCH_CreateRoomIndex-CRI.dcl")))
(if (not (new_dialog "ARCH_RoomIndex" DCL_ID "" '(-1 -1))) (dcl_error))
(set_tile "set-title" (strcat ARCH#LOGO " : CRI Create Room Index List"))
(set_tile "set-copyright" (strcat ARCH#LOGO " " ARCH#YEAR " for AutoCAD®"))
(start_list "file-list")
(mapcar 'add_list got-list)
(end_list)
(set_tile "dir" (strcat " Room File Directory is [" folder "]"))
(action_tile "accept" "(do_act $key)")
(action_tile "about" "(about_help)")
(action_tile "cancel" "(princ \"\\n*** ///////// Program CANCELLED ///////// ***\")(done_dialog)")
(start_dialog)
(cond
((= op "accept")(command ".shell" "notepad C:\\Temp\\RoomIndex.txt"))
)
(unload_dialog dcl_id)
(princ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;(prompt "\n* Command name is: \"CRI\" *")
(CRIIT)
(princ)
-
In the getindex routine you will have to use an ssget to collect all the blocks. Then
iterate through collecting the attributes of each block.
After that you will need to alter the write-line code to accommodate the altered list.
If you have trouble with it send me a test drawing & I'll take a look.
Or someone else may jump in.
-
FYI...
You can't use ssget with ObjectDBX. I didn't read the whole code again, I just read Alan's last post. If you want to list all the block occurances in a drawing opened in ObjectDBX, then you have to cycle through all the layouts, and count them as you find them.
-
Thanks
I'm lost on how to do this. I only need to search model space. The unit plan has multiple attributed blocks.
I just need it to get them all per each drawing file. Remember I still don't speak vlisp.
Would I just need to do a foreach search? Here is a typical drawing file.
Gary
-
OK here it is.
I didn't test the dcl.
-
Allen
Thank you, that works perfectly. I modified the code slightly. Now how would I make the list of each unit drawing "list line"
to be iin numerical order based upon the room number?
(foreach dwg indexlist
(foreach itm dwg
;;write to list_box and notepad
(cond
((= "DWG" (car itm))
(setq x (padout (cdr itm) 10))
;(write-line (strcat x) file)
)
((= (nth 1 (car blkdata)) (car itm))
(setq a (padout (cdr itm) 16)))
((= (nth 2 (car blkdata)) (car itm))
(setq b (padout (cdr itm) 5)))
((= (nth 3 (car blkdata)) (car itm))
(setq c (padout (cdr itm) 10)))
)
(if (and a b c)
(progn
(if (not x)(setq x " "))
(write-line (strcat x a b c) file)
(setq got-list (append (list (strcat x a b c)) got-list))
(setq a nil b nil c nil x nil)))
))
(close file)
;;added dialog box interface
(defun do_act (key_pr) (setq op key_pr)(done_dialog)(princ))
(setq ARCH#LOGO " Arch Program©")
(setq ARCH#YEAR (substr (rtos (getvar "CDATE") 2 16) 1 4))
;;(setq dcl_id (load_dialog (strcat "" "ARCH_CreateRoomIndex-CRI.dcl")))
(setq dcl_id (load_dialog (strcat ARCH#CUSF "BLOC/" "ARCH_CreateRoomIndex-CRI.dcl")))
(if (not (new_dialog "ARCH_RoomIndex" DCL_ID "" '(-1 -1))) (dcl_error))
(set_tile "set-title" (strcat ARCH#LOGO " : CRI Create Room Index List"))
(set_tile "set-copyright" (strcat ARCH#LOGO " " ARCH#YEAR " for AutoCAD®"))
(start_list "file-list")
(mapcar 'add_list (reverse got-list))
(end_list)
Thank you, again.
Gary
-
What does the output list look like? Once you have than, then sort it with vl-sort. Post a sample returned list, and someone will be able to help better.
-
Tim
Thanks. Here is a typical output file.
Gary
-
I need to see the list. Is it a list of lists? or does it just write to file from the code? Let me look at the code one minutes.
I can't tell from your last post.
-
This is the output as of what is posted.
(("DWG" . "UTB30930")
("TAB" . "--- Layout1 ---")
("TAB" . "--- Model ---")
("ROOM-NO" . "01")
("FINISH" . "2-1-1-1")
("ROOM" . "Entry")
("ROOM-NO" . "05")
("FINISH" . "2-1-1-1")
("ROOM" . "Utility")
("ROOM-NO" . "04")
("FINISH" . "2-1-1-1")
("ROOM" . "Kitchen")
("ROOM-NO" . "08")
("FINISH" . "2-1(2)-1-1")
("ROOM" . "Bath")
("ROOM-NO" . "06")
("FINISH" . "1-1-1-1")
("ROOM" . "Closet")
("ROOM-NO" . "03")
("FINISH" . "1-1-1-1")
("ROOM" . "Dining")
("ROOM-NO" . "07")
("FINISH" . "1-1-1-1")
("ROOM" . "Bedroom")
("ROOM-NO" . "02")
("FINISH" . "1-1-1-1")
("ROOM" . "Living")
("ROOM-NO" . "12")
("FINISH" . "3-5-4-1")
("ROOM" . "Balcony")
("ROOM-NO" . "11")
("FINISH" . "3-6-4-3")
("ROOM" . "Storage")
("ROOM-NO" . "06")
("FINISH" . "1-1-1-1")
("ROOM" . "Closet")
("ROOM-NO" . "06")
("FINISH" . "1-1-1-1")
("ROOM" . "Closet")
("ROOM-NO" . "08")
("FINISH" . "2-1(2)-1-1")
("ROOM" . "Bath")
("ROOM-NO" . "07")
("FINISH" . "1-1-1-1")
("ROOM" . "Bedroom")
)
I changed the code to get this
(("DWG" . "UTB30930")
("TAB" . "--- Layout1 ---")
("TAB" . "--- Model ---")
(("ROOM-NO" . "01") ("FINISH" . "2-1-1-1") ("ROOM" . "Entry"))
(("ROOM-NO" . "05") ("FINISH" . "2-1-1-1") ("ROOM" . "Utility"))
(("ROOM-NO" . "04") ("FINISH" . "2-1-1-1") ("ROOM" . "Kitchen"))
(("ROOM-NO" . "08") ("FINISH" . "2-1(2)-1-1") ("ROOM" . "Bath"))
(("ROOM-NO" . "06") ("FINISH" . "1-1-1-1") ("ROOM" . "Closet"))
(("ROOM-NO" . "03") ("FINISH" . "1-1-1-1") ("ROOM" . "Dining"))
(("ROOM-NO" . "07") ("FINISH" . "1-1-1-1") ("ROOM" . "Bedroom"))
(("ROOM-NO" . "02") ("FINISH" . "1-1-1-1") ("ROOM" . "Living"))
(("ROOM-NO" . "12") ("FINISH" . "3-5-4-1") ("ROOM" . "Balcony"))
(("ROOM-NO" . "11") ("FINISH" . "3-6-4-3") ("ROOM" . "Storage"))
(("ROOM-NO" . "06") ("FINISH" . "1-1-1-1") ("ROOM" . "Closet"))
(("ROOM-NO" . "06") ("FINISH" . "1-1-1-1") ("ROOM" . "Closet"))
(("ROOM-NO" . "08") ("FINISH" . "2-1(2)-1-1") ("ROOM" . "Bath"))
(("ROOM-NO" . "07") ("FINISH" . "1-1-1-1") ("ROOM" . "Bedroom"))
)
-
Lunch time, but here is code to sort the second list by room numbers.
(vl-sort
(cdddr tmpList)
'(lambda (a b)
(< (atoi (cdar a)) (atoi (cdar b)))
)
)
Where tmpList is the list. Here is the output.
Command: (vl-sort
(_> (cdddr tmpList)
(_> '(lambda (a b)
('(_> (< (atoi (cdar a)) (atoi (cdar b)))
('(_> )
(_> )
((("ROOM-NO" . "01") ("FINISH" . "2-1-1-1") ("ROOM" . "Entry")) (("ROOM-NO" .
"02") ("FINISH" . "1-1-1-1") ("ROOM" . "Living")) (("ROOM-NO" . "03") ("FINISH"
. "1-1-1-1") ("ROOM" . "Dining")) (("ROOM-NO" . "04") ("FINISH" . "2-1-1-1")
("ROOM" . "Kitchen")) (("ROOM-NO" . "05") ("FINISH" . "2-1-1-1") ("ROOM" .
"Utility")) (("ROOM-NO" . "06") ("FINISH" . "1-1-1-1") ("ROOM" . "Closet"))
(("ROOM-NO" . "06") ("FINISH" . "1-1-1-1") ("ROOM" . "Closet")) (("ROOM-NO" .
"06") ("FINISH" . "1-1-1-1") ("ROOM" . "Closet")) (("ROOM-NO" . "07") ("FINISH"
. "1-1-1-1") ("ROOM" . "Bedroom")) (("ROOM-NO" . "07") ("FINISH" . "1-1-1-1")
("ROOM" . "Bedroom")) (("ROOM-NO" . "08") ("FINISH" . "2-1(2)-1-1") ("ROOM" .
"Bath")) (("ROOM-NO" . "08") ("FINISH" . "2-1(2)-1-1") ("ROOM" . "Bath"))
(("ROOM-NO" . "11") ("FINISH" . "3-6-4-3") ("ROOM" . "Storage")) (("ROOM-NO" .
"12") ("FINISH" . "3-5-4-1") ("ROOM" . "Balcony")))
-
Thanks for the input Tim.
-
Allen and Tim
Thanks. Perfect. This will give a good example to learn from....but right now my head hurts.
Gary
-
Thanks for the input Tim.
Sorry didn't have time to make it look purtty. You're welcome.
Allen and Tim
Thanks. Perfect. This will give a good example to learn from....but right now my head hurts.
Gary
You're welcome also, for what little I did.
-
Just a little FYI...
The sorting code I posted may stumble if you have rooms with the same number, but have a letter at the end because I turn them into integers to sort, found out that it works better that way. If you have letter/number combinations you might want to test it out how it is, and without the changing them to integers part.
-
Just a little FYI...
The sorting code I posted may stumble if you have rooms with the same number, but have a letter at the end because I turn them into integers to sort, found out that it works better that way. If you have letter/number combinations you might want to test it out how it is, and without the changing them to integers part.
Tim
So far everything works great. It will always be numbers.
Gary
-
Was playing while you guys were posting and wasn't going to post, but, ...
Tim, I'd expected No's to cause problems too , but seems not .. ..
by It will always be numbers.
do you mean numbers or strings representing numbers ?
(setq dwgData (list "UTB30930"
(list (list "Entry" 01 "2-1-1-1 ")
(list "Utility" 05 "2-1-1-1 ")
(list "Kitchen" 04 "2-1-1-1 ")
(list "Bath" 08 "2-1(2)-1-1")
(list "Closet" 06 "1-1-1-1 ")
(list "Dining" 03 "1-1-1-1 ")
(list "Bedroom" 07 "1-1-1-1 ")
(list "Living" 02 "1-1-1-1 ")
(list "Balcony" 12 "3-5-4-1 ")
(list "Storage" 11 "3-6-4-3 ")
(list "Closet" 06 "1-1-1-1 ")
(list "Closet" 06 "1-1-1-1 ")
(list "Bath" 08 "2-1(2)-1-1")
(list "Bedroom" 07 "1-1-1-1 ")
)
)
)
(setq header (car dwgData)
Data (cadr dwgData)
)
(setq NewData (vl-sort Data '(lambda (a b) (< (cadr a) (cadr b)))))
(setq NewDwgData (list header NewData))
("UTB30930" (("Entry" 1 "2-1-1-1 ")
("Living" 2 "1-1-1-1 ")
("Dining" 3 "1-1-1-1 ")
("Kitchen" 4 "2-1-1-1 ")
("Utility" 5 "2-1-1-1 ")
("Closet" 6 "1-1-1-1 ")
("Closet" 6 "1-1-1-1 ")
("Closet" 6 "1-1-1-1 ")
("Bedroom" 7 "1-1-1-1 ")
("Bedroom" 7 "1-1-1-1 ")
("Bath" 8 "2-1(2)-1-1")
("Bath" 8 "2-1(2)-1-1")
("Storage" 11 "3-6-4-3 ")
("Balcony" 12 "3-5-4-1 ")
)
)
-
Sorry I should have said something sooner. I already had a sort going when Tim posted so I didn't look too hard at it.
If you look at the file you'll see it.
(defun srt (data / e1 e2)
(vl-sort data '(lambda (e1 e2) (< (cdar e1) (cdar e2))))
)
-
<snip>
by It will always be numbers.
do you mean numbers or strings representing numbers ?
< snip >
BTW : String or numbers each work for the sort.
-
do you mean numbers or strings representing numbers ?
It would be strings representing numbers because they are gotten from attributed blocks.
Sorry I should have said something sooner. I already had a sort going when Tim posted so I didn't look too hard at it.
If you look at the file you'll see it.
(defun srt (data / e1 e2)
(vl-sort data '(lambda (e1 e2) (< (cdar e1) (cdar e2))))
)
All good Alan. I just wanted to state that incase someone looks later at it.
FYI...
You don't have to make the variables "e1" & "e2" local to the function because they are already local to the lambda function.
-
Good point. Thanks
-
Hi guys, first post here. Never even seen this place before. I got linked to this thread from discussion forums on autodesk.
From what I see and understand (little) this seems like a very well written and powerful routine. Right now I have a number of processes that happen to do the same thing. It's quiet messy, but automated. I use -attext to get the attributes, and i use a batch software to run through the drawings, then combine the .txt files and get one that gets imported to excel and vba takes care of the rest.
I was looking to do this process with obd, but i know very little about vla stuff and activex stuff.
The original code here, makes some what sense to me, but I would apprecieate it greatly if someone would list some more descriptions of what does what. Aspecially the area where you are going through the drawings and checking for blocks etc.
I thank u all greatly, and very jealous of all of u being so knowledgable in this programming language...
Thanks in advance.
Viktor.
-
Hi Viktor
Welcome to the swamp. This is by far the best way ahead of the rest forum.
I thank u all greatly, and very jealous of all of u being so knowledgable in this programming language...
I am learning to, I got alot of help on this one...maybe someone can chime in on the details.
This particular original routine use AutoCAD's objectdbx to create a text file listing the sheet files within the selected directory.
It gets the value of an attributed block located in each sheet file that has the following data:
sheet number
sheet title
sheet date
...and it searches for any revision/addedum attributed blocks for the date to update
For example, here is a current job <SheetIdex.txt file>
22 July 2005 [2] A0.00 Cover
22 July 2005 [ ] A0.01 Site Plan
22 July 2005 [2] A1.01 Project Data
22 July 2005 [ ] A1.02 Fire Proofing Data
22 July 2005 [ ] A1.03 Fair Housing Data
22 July 2005 [ ] A1.04 ADA Handicap Data
22 July 2005 [ ] A1.05 TAS Handicap Data
22 July 2005 [ ] A2.01a Foundation Plan
22 July 2005 [ ] A2.01b Floor Plan
22 July 2005 [ ] A2.01c Floor Plan
22 July 2005 [ ] A2.01d Floor Plan
22 July 2005 [ ] A2.01e Roof Plan
22 July 2005 [ ] A2.02a Foundation Plan
22 July 2005 [ ] A2.02b Floor Plan
22 July 2005 [ ] A2.02c Floor Plan
22 July 2005 [ ] A2.02d Floor Plan
22 July 2005 [ ] A2.02e Roof Plan
22 July 2005 [ ] A2.03a Foundation Plan
22 July 2005 [ ] A2.03b Floor Plan
22 July 2005 [ ] A2.03c Floor Plan
22 July 2005 [ ] A2.03d Floor Plan
22 July 2005 [ ] A2.03e Roof Plan
22 July 2005 [ ] A3.00 Schedules
22 July 2005 [ ] A3.01 Unit Plan
22 July 2005 [ ] A3.02a Unit Plan
22 July 2005 [ ] A3.02b Unit Plan
22 July 2005 [ ] A3.02c Unit Plan
22 July 2005 [ ] A3.03a Unit Plan
22 July 2005 [ ] A3.03b Unit Plan
22 July 2005 [ ] A3.03c Unit Plan
22 July 2005 [ ] A3.03d Unit Plan
22 July 2005 [ ] A3.03e Unit Plan
22 July 2005 [ ] A3.04 Unit Plan
22 July 2005 [ ] A3.05a Unit Plan
22 July 2005 [ ] A3.05b Unit Plan
22 July 2005 [ ] A3.05c Unit Plan
22 July 2005 [2] A4.01 Building Elevations
22 July 2005 [2] A4.02 Building Elevations
22 July 2005 [2] A4.03 Building Elevations
22 July 2005 [2] A5.01 Wall Sections
22 July 2005 [2] A5.02 Wall Sections
22 July 2005 [2] A5.03 Wall Sections
22 July 2005 [2] A5.04 Wall Sections
22 July 2005 [2] A5.05 Wall Sections
22 July 2005 [2] A6.01 Stairs
22 July 2005 [ ] A6.02 Stairs
02 Feb 2006 [3] A6.03 Stairs
02 Feb 2006 [3] A6.04 Stairs
22 July 2005 [2] A7.01 Details
22 July 2005 [2] A7.02 Details
22 July 2005 [2] A7.03 Details
22 July 2005 [2] A7.04 Details
22 July 2005 [2] A7.05 Details
22 July 2005 [ ] A7.06 Details
22 July 2005 [ ] A7.07 Details
22 July 2005 [ ] A8.00 Schedules
22 July 2005 [ ] A8.01 Foundation Plan
22 July 2005 [ ] A8.02 Leasing Office Plan
22 July 2005 [ ] A8.03 Ceiling Plan
22 July 2005 [ ] A8.04 Roof Plan
22 July 2005 [ ] A8.05 Elevations
22 July 2005 [ ] A8.06 Elevations
22 July 2005 [ ] A8.07 Elevations
22 July 2005 [ ] A8.08 Wall Sections
22 July 2005 [ ] A9.01 Mail Kiosk
22 July 2005 [ ] A9.02 Garage / Maint. Bldg.
22 July 2005 [ ] A9.03 Garage
22 July 2005 [ ] A9.04 Garage
22 July 2005 [ ] A9.05 Sign and Cabana
Gary
-
Thanks Gary, i have no doubt that it's he best forum :) I've been looking around for a few days and my brain hurts lol.
Well, your description makes sense, and that's what I ment by ObjectDBX, i just haven't dealt with it enough to memorize that it's not obd (obdII sensors from the cars that I gets me confused), but ObjectDBX.
The list you posted is also similar to what I get, i do the same operation, but like I said, in a very messy way. I rely on a batch program to shuffle through the drawings, then I use a windows cmd to combine all txt files into one file and open it in excel and go from there.
I guess my question is more for that code in particular. If you have a minute to answer these basic questions, this will be allot more clear for me.
(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)
Code above you first call the "getfolder", which is pretty straight forward (although for some reason when I run it the "folderlist" comes back as nill, that is when i break right at the end of that function.
Then you call "getindex" through the ARCH:*** which is basically sorting of the document that you get.
Am I somewhere ok so far?
Now, this GETINDEX just does not make much sense to me on how it works.
Could you give me a brief description before I make a fool out of myself? Step by step would be asking for too much, but if it won't take long, THANK YOU!
But thanks in either way!
Viktor.
-
Viktor,
Welcome to the swamp.
If you know VBA more than LISP, then you might want to code it in VBA. VBA also has the ability to use ObjectDBX, but I don't know any VBA, but I can't help on the LISP side.
Let us know which way you want to go.
-
Code above you first call the "getfolder", which is pretty straight forward (although for some reason when I run it the "folderlist" comes back as nill, that is when i break right at the end of that function.
The folder selected has to contain your "sheet file" drawing and not in a sub folder, otherwise it will return nil.
As far as the voodoo vla- stuff, it's over my head.
The getindex part is from Jeff Mishler, Tim Willey and Allen Butler. Without help from Allen I would be sinking to the bottom of the swamp.
I better let them explain it. I'm the kind of lisper that just wants to put the key in and go....and try to learn something along the way.
Gary
-
Yea Gary, u and me are on the same page, its just you are more further along the page...
This is the way i learn too, but back to the folder list. I do have drawing files in there. Does it only build a list if the drawings contain a certain block? I figured it only lists all the files in that folder. That's what I had. but still returned nill.
About VBA, i'm very new to cad side of the vba, i can get around but no way efficient at it. excel side is a bit easier, since there recording is allowed which taught me pretty quickly. Anyone know if AutoCad will soon have a record feature for macro's?
Thanks,
Viktor.
-
Yea Gary, u and me are on the same page, its just you are more further along the page...
This is the way i learn too, but back to the folder list. I do have drawing files in there. Does it only build a list if the drawings contain a certain block? I figured it only lists all the files in that folder. That's what I had. but still returned nill.
About VBA, i'm very new to cad side of the vba, i can get around but no way efficient at it. excel side is a bit easier, since there recording is allowed which taught me pretty quickly. Anyone know if AutoCad will soon have a record feature for macro's?
Thanks,
Viktor.
Yes it has to contain the attributed blocks....like the block inclosed.
-
Hi Viktor, I'm glad you found your way over here. People have been asking about macro recording for some time and I have yet to hear anyone from Adesk comment about it.
As for the (getindex), I don't know which one you tried (there are a number of incremental versions here and I didn't check to see what, if anything, changed in that portion of the code) but if you look at the first one I posted in Reply#5 I'll try to walk you through it....
;|function to extract 2 attribute values from a specific block in the drawings of a specified folder
by Jeff Mishler Feb. 9, 2006 Modified for training purposes, 3/30/06 JMM|;
(defun getindex (blkname attname1 attname2 / *acad atts
dwgs f folder layouts masterlist
name odbx val1 val2
)
;;;the next function is derived from a post by Tony Tanzillo to the Adesk NG's
(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
)
)
);;end BrowseForFolder
;; another function, this one gets all of the drawings in the folder
;; and prepends the path to the dwg name, accepts a list of folders
(defun getdwglist (folderlist)
(apply 'append
(mapcar '(lambda (f)
(mapcar '(lambda (name)
(strcat f "\\" name)
)
(vl-directory-files f "*.dwg" 1)
)
)
folderlist
)
)
)
;;;;main body of getindex
;;I placed all of these into an (and) so it will exit if anyone fails before moving on
(if (and (setq *acad (vlax-get-acad-object)) ;;get the acad application
(setq folder (browseforfolder)) ;;select a folder
(setq dwgs (getdwglist (list folder)));;find all dwg's in that folder
)
(progn
;;if we made it this far we have dwg's to work with
;;modified 3/30/06 to allow for future versions
(setq versn (atoi (substr (getvar "acadver") 1 2))
odbx (if (< versn 16)
(vla-GetInterfaceObject *acad "ObjectDBX.AxDbDocument")
(vla-GetInterfaceObject
*acad
(strcat "ObjectDBX.AxDbDocument." (itoa versn))
)
)
)
(foreach dwg dwgs ;;loop through each drawing in the list
(if
(and
;;try to open it, it will exit if there is an error
(not (vl-catch-all-error-p
(vl-catch-all-apply
'(lambda ()
(vla-open odbx dwg)
)
)
)
)
;;see if the block is even in the drawing, again it will exit on error
(not
(vl-catch-all-error-p
(vl-catch-all-apply
'(lambda ()
(setq blk (vla-item (vla-get-blocks odbx) blkname))
)
)
)
)
)
(progn
;;no errors...carry on
(setq layouts (vla-get-layouts odbx))
(vlax-for layout layouts ;;cycle through each layout Tab
(if (not (eq "MODEL" (strcase (vla-get-name layout)))) ;;exclude Model space
(progn
(vlax-for ent (vla-get-block layout) ;;look for Inserts....BlockReference in ActiveX terms
(if (and (eq (vla-get-objectname ent)
"AcDbBlockReference"
)
(eq (strcase (vla-get-name ent)) ;;check the name
(strcase blkname)
)
)
(progn
;;the name matches, get the attributes
(setq atts (vlax-invoke ent 'getattributes))
;;now cycle through the attributes and collect the values of the desired atts
(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))
)
)
;;add them to the master list
(setq masterlist
(cons (cons val1 val2) masterlist)
;(cons (list (vla-get-name odbx) (cons val1 val2)) masterlist);for testing
)
)
)
)
)
)
)
)
)
)
;;we're done with ODBX, release it
(mapcar 'vlax-release-object (list odbx *acad))
)
)
;;put the list into the order of the drawings
(reverse masterlist)
)
;;;Test with my title block having a name of TDG and get the 2 attributes NO & SHEET_NAME
(defun c:createindex ()
(setq indexlist (getindex "TDG" "NO" "SHEET_NAME"))
)
-
I AM LIKING THIS!!! Good job Jeff!
It is starting to make more sense to me.
Here's a question, in this part:
(not
(vl-catch-all-error-p
(vl-catch-all-apply
'(lambda ()
(setq blk (vla-item (vla-get-blocks odbx) blkname))
)
)
)
)
)
(progn
;;no errors...carry on
(setq layouts (vla-get-layouts odbx))
(vlax-for layout layouts ;;cycle through each layout Tab
(if (not (eq "MODEL" (strcase (vla-get-name layout)))) ;;exclude Model space
(progn
(vlax-for ent (vla-get-block layout) ;;look for Inserts....BlockReference in ActiveX terms
(if (and (eq (vla-get-objectname ent)
"AcDbBlockReference"
)
(eq (strcase (vla-get-name ent)) ;;check the name
(strcase blkname)
)
)
How and where did you set the blkname to be block name???? i'm a bit lost in this section all together.
Thanks for your reply.
Viktor.
-
Do you know how to write your own lisp routines?
How and where did you set the blkname to be block name???? i'm a bit lost in this section all together.
Thanks for your reply.
Viktor.
This is where Jeff knows what the block name is going to be, along with the attribute tag names.
(defun getindex (blkname attname1 attname2 / *acad atts
dwgs f folder layouts masterlist
name odbx val1 val2
)
He is saying when you call this (sub) routine, you need three arguements. The first is the block name (blkname) the second two are the tag names (attname1 attname2). The when he calls the routine in the main routine, he supplies the arguements.
(defun c:createindex ()
(setq indexlist (getindex "TDG" "NO" "SHEET_NAME"))
)
-
Well, like i said, i'm new to this part of lisping. my history is very short with lisp, all my personal lisp routines are very messy, for example, i didn't even know how to call different functions within lisp, all my routines would start with (defun c:test (/ a b c) and end with a ) that's basic, but because i don't get much opportunity to train myself with this, i waist allot of my personal time making some simple routine in the only way i know how to.
this is excellent because it pushes me to learn all these new things, but at least they are making sense to me :)
Thanks to all for your input.
Viktor.
-
i'm one of those people that can walk into a room filled with the most intelligent people on a planet, and still be able to ask the most simple question without being offended :-)
-
ok here's one more easy question to u all.
(setq masterlist
(cons (cons val1 val2) masterlist)
In this code, val1 and val2 are combined into a masterlist by using cons????
well, my question is this, is there a way to just write the val1 and val2 to a text file instead?
can someone explain to me the importance of combining the values into one list?
what if you have just one attribute?
Thanks ahead.
Viktor.
-
Hi Viktor,
Yes, (cons (cons ...)) is creating a master list of lists.
You could write these to a text file, but, IMHO, it is much more efficient to do that once, and not by this routine. By doing it this way, this routine can be used for more than one specific thing. I don't recall the 'official' term for this, but I like to refer to it as 'compartmental' coding so that code snippets cn be re-used for other programs.
If I had just one attribute then I'd just do this:
(setq masterlist (cons att1 masterlist))
See Gary's progressions for how how he handled exporting the results to a text file.
-
This is great. How would I modify this to search for a list of specific text instead of blocks with attributes. We are sometimes given a list of items( instruments which are just text comprised of hundreds of items spread across multiple drawings in a folder ) we need to locate in drawings.
Allen
Thank you, that works perfectly. I modified the code slightly. Now how would I make the list of each unit drawing "list line"
to be iin numerical order based upon the room number?
(foreach dwg indexlist
(foreach itm dwg
;;write to list_box and notepad
(cond
((= "DWG" (car itm))
(setq x (padout (cdr itm) 10))
;(write-line (strcat x) file)
)
((= (nth 1 (car blkdata)) (car itm))
(setq a (padout (cdr itm) 16)))
((= (nth 2 (car blkdata)) (car itm))
(setq b (padout (cdr itm) 5)))
((= (nth 3 (car blkdata)) (car itm))
(setq c (padout (cdr itm) 10)))
)
(if (and a b c)
(progn
(if (not x)(setq x " "))
(write-line (strcat x a b c) file)
(setq got-list (append (list (strcat x a b c)) got-list))
(setq a nil b nil c nil x nil)))
))
(close file)
;;added dialog box interface
(defun do_act (key_pr) (setq op key_pr)(done_dialog)(princ))
(setq ARCH#LOGO " Arch Program©")
(setq ARCH#YEAR (substr (rtos (getvar "CDATE") 2 16) 1 4))
;;(setq dcl_id (load_dialog (strcat "" "ARCH_CreateRoomIndex-CRI.dcl")))
(setq dcl_id (load_dialog (strcat ARCH#CUSF "BLOC/" "ARCH_CreateRoomIndex-CRI.dcl")))
(if (not (new_dialog "ARCH_RoomIndex" DCL_ID "" '(-1 -1))) (dcl_error))
(set_tile "set-title" (strcat ARCH#LOGO " : CRI Create Room Index List"))
(set_tile "set-copyright" (strcat ARCH#LOGO " " ARCH#YEAR " for AutoCAD®"))
(start_list "file-list")
(mapcar 'add_list (reverse got-list))
(end_list)
Thank you, again.
Gary
-
bp welcome to the swamp.
I hope someone has time to help you with this but at the moment I am swamped 8-)
I'll check back later.
-
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.
(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
)
-
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.
;|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
-
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.
-
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
-
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
-
See how this works. Changed the red parts. Pink parts are parts I removed. I can't test, but you can.
;|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")
;;; )
;;;)
-
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.
(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.
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
-
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.
-
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.
;|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:
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
-
You're welcome John.
-
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
-
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.
(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
(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.
-
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.
(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)
)
)
-
OK for my use I did this:
(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)
)
)
-
One note, it will not process any open drawings!
-
One note, it will not process any open drawings!
I haven't followed this thread completely, but I had to also get around the problem of processing open drawings in the Attribute Extractor, you may want to refer to the code if it helps :wink:
http://www.theswamp.org/index.php?topic=29124.0 (http://www.theswamp.org/index.php?topic=29124.0)
-
I must be too tired but I didn't see where you opened a DWG file as read only.
Off to hunt for some dinner. 8-)
-
I must be too tired but I didn't see where you opened a DWG file as read only.
Off to hunt for some dinner. 8-)
I make a list of the open documents in the session, and check against this list before Opening an ODBX Document. The open document object can then be used in place of the dbx document object.
I tried using vla-open/close on the open document to open it as read-only, but found that this was unnecessary.
Hope this helps! :-)
Lee
-
(http://www.theswamp.org/screens/index.php?dir=cab/&file=HomerDOH.jpg)
-
OK for my use I did this:
(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)
)
)
When I try to use this I get a "Too Few Arguments" error..........what am I doing wrong....??
Regards,
Vince
-
That was for MY block
(setq indexlist (getindex "Aproved Title Block D- Attr" '("SheetNo" "TITLE1" "TITLE2")))
Change for YOUR block:
(setq indexlist (getindex "Drawing-Title" '("NUM" "Title-1" "Title-2" "Title-3")))
-
That was for MY block
(setq indexlist (getindex "Aproved Title Block D- Attr" '("SheetNo" "TITLE1" "TITLE2")))
Change for YOUR block:
(setq indexlist (getindex "Drawing-Title" '("NUM" "Title-1" "Title-2" "Title-3")))
CAB,
I updated the code for my block name but I am still getting the "too few arguments" error.....!
Thanks,
Vince
-
Run from VLIDE. At the command line enter VLIDE
From the pull down menus at the top select File/Open
Navigate to this new lisp & load it.
Left click in that window with the new lisp to make sure it is active.
From the pull down menus at the top select Debug & make sure the "Break on Error" is checked.
From the pull down menus at the top select Tools/Enviornmental Options/General
Activate the Diagnostic Tab
Check Report statistics...
Check Print notification ...
Check Echo PRINx ....
Check Inspect drawings....
From the pull down menus at the top select Tools/Load Text in Editor
In the Visual Lisp Console window you should see something liske this:
; 2 forms loaded from #<editor "C:/Program Files/ACAD2000/LISP Routines/Title Block Index CAB.LSP">
_$
It will reflect your path, not the one shown here.
Activate ACAD & run the routine again.
Please post the output at the command line.
If you are taken back to VLIDE Press [Ctrl+F9] and tell me the line that is highlighted.
-
Run from VLIDE. At the command line enter VLIDE
From the pull down menus at the top select File/Open
Navigate to this new lisp & load it.
Left click in that window with the new lisp to make sure it is active.
From the pull down menus at the top select Debug & make sure the "Break on Error" is checked.
From the pull down menus at the top select Tools/Enviornmental Options/General
Activate the Diagnostic Tab
Check Report statistics...
Check Print notification ...
Check Echo PRINx ....
Check Inspect drawings....
From the pull down menus at the top select Tools/Load Text in Editor
In the Visual Lisp Console window you should see something liske this:
; 2 forms loaded from #<editor "C:/Program Files/ACAD2000/LISP Routines/Title Block Index CAB.LSP">
_$
It will reflect your path, not the one shown here.
Activate ACAD & run the routine again.
Please post the output at the command line.
If you are taken back to VLIDE Press [Ctrl+F9] and tell me the line that is highlighted.
CAB,
I followed your instructions and on the command line I received....too few arguments......then I hit [Ctrl+F9] and the lines below were highlighted......I hope this was helpful....!
;|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)
)
Thanks, Vince
-
I see the problem.
I'll get back to you soon.
-
You are using the wrong version of the routine.
Use this:
;|
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 any number of 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 folder "C:\\Program Files\\ACAD2000\\=Active Projects\\Steve Carter\\Russell")
(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)
)
-
I hope you don't mind me sticking my nose in, but hopefully this will process open drawings:
;|
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 any number of attributes
Modified by Lee Mac to process open drawings
|;
(defun getindex (blkname attList / *acad atts dwgs err f flag folder layouts masterlist name odbx odbxdoc)
(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 folder "C:\\Program Files\\ACAD2000\\=Active Projects\\Steve Carter\\Russell")
(setq dwgs (getdwglist (list folder)))
)
(progn
(setq
odbxdoc (if (< (atoi (substr (getvar "acadver") 1 2)) 16)
(vla-GetInterfaceObject *acad "ObjectDBX.AxDbDocument")
(vla-GetInterfaceObject *acad "ObjectDBX.AxDbDocument.17")
)
)
(vlax-for doc (vla-get-Documents *acad)
(setq DocLst (cons (cons (strcase (vla-get-FullName doc)) doc) DocLst)))
(foreach dwg dwgs
(setq flag (and (setq odbx (cdr (assoc (strcase dwg) DocLst)))))
(or odbx
(and (setq Err (vl-catch-all-apply
(function vla-open) (list odbxdoc dwg)) odbx odbxdoc)))
(if
(and
(or flag
(not (vl-catch-all-error-p err)))
;; 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
(function
(lambda (x) (and x (not (vlax-object-released-p x))
(vlax-release-object x))))
(list odbxdoc odbx *acad))
)
)
(reverse masterlist)
)
PS> Haven't tested it, but are you sure that you can use the same ODBX document instance for each drawing? I tried that logic on my program and I can't seem to get it to function without creating a new ODBX doc for each drawing that is opened.
-
PS> Haven't tested it, but are you sure that you can use the same ODBX document instance for each drawing? I tried that logic on my program and I can't seem to get it to function without creating a new ODBX doc for each drawing that is opened.
Yes. Once you open the document with ODBX, it is that new document, and the old one is closed.
The process I use is:
Get the interface object for ODBX
Use that interface to open each drawing
Do what I need to said drawing
Save if I want
After all drawings have been processed, release the ONE odbx interface object referenced.
-
Lee, your nose is welcome around here. 8-)
BTW I got a missing ) in your post.
-
Lee, your nose is welcome around here. 8-)
Thanks CAB
BTW I got a missing ) in your post.
Oops! Code updated :-)
-
One more got ya 8-)
Command: createindex
; error: bad argument type: VLA-OBJECT nil
; reset after error
(mapcar 'vlax-release-object (list odbx *acad))
odbx is nil in my test, it is processing the Open DWG.
Off to dinner, see ya later.
-
One more got ya 8-)
Command: createindex
; error: bad argument type: VLA-OBJECT nil
; reset after error
(mapcar 'vlax-release-object (list odbx *acad))
odbx is nil in my test, it is processing the Open DWG.
Off to dinner, see ya later.
:oops: I really should test these things before posting - but not being a draftsman myself, I don't exactly have a set of drawings that I can readily test it on... so most of my code is 'theoretical'... :wink: Anyway, code updated, hopefully it is OK now...
Thanks CAB, enjoy your meal :-)
-
Well you nailed that time. 8-)
Command: createindex
Russell-3 2 FLOOR PLAN
Russell-4 1 FLOOR PLAN
Russell-4 2 ELEVATIONS PLAN
Russell-4 3 ELEVATIONS PLAN
Russell-4 4 ELECTRICAL PLAN
Russell-4 5 FOUNDATION PLAN
Russell-4 6 FRAMING PLAN
Russell-5 1 FLOOR PLAN
Russell-5 2 ELEVATIONS PLAN
Russell-5 3 ELEVATIONS PLAN
Russell-5 4 ELECTRICAL PLAN
Russell-5 5 FOUNDATION PLAN
Russell-5 6 FRAMING PLAN
Russell-6 1 FLOOR PLAN
Russell-6 2 ELEVATIONS PLAN
Russell-6 3 ELEVATIONS PLAN
Russell-6 4 ELECTRICAL PLAN
Russell-6 5 FOUNDATION PLAN
Russell-6 6 FRAMING PLAN
-
Excellent :-) Thanks
-
I would use this to handle other versions:
(setq odbxdoc
(if (< (atoi (setq oVer (substr (getvar "acadver") 1 2))) 16)
(vla-GetInterfaceObject (vlax-get-acad-object) "ObjectDBX.AxDbDocument")
(vla-GetInterfaceObject
(vlax-get-acad-object)
(strcat "ObjectDBX.AxDbDocument." oVer))))
-
You are using the wrong version of the routine.
Use this:
;|
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 any number of 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 folder "C:\\Program Files\\ACAD2000\\=Active Projects\\Steve Carter\\Russell")
(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)
)
CAB,
Thank you for your assistance......the code ran successfully this time however, In the "indexlist" section I specified the block name and 4 attributes and the index that was created had the file name and only 1 attribute.....plus the index that was created contained some duplicates. The directory had only 16 drawing files and the created index contained 20 lines.
Any thoughts on what I might be doing incorrectly....??
Regards,
Vince
-
Please post the index list that was created.
My first thought is that the block in some drawings does not have a matching attribute or the attribute is blank.
If it is blank it should still print a line with the DWG name.
-
Please post the index list that was created.
My first thought is that the block in some drawings does not have a matching attribute or the attribute is blank.
If it is blank it should still print a line with the DWG name.
CAB,
Here is a copy of the index list that was created.....!
Command: createindex
P0001-S-001 S-001
P0001-S-101 S-101
P0001-S-102 S-102
P0001-S-201 S-201
P0001-S-301 S-301
P0001-S-302 S-302
P0001-S-302 S-302C
P0001-S-302 S-302P
P0001-S-303 S-303
P0001-S-304 S-304
P0001-S-305 S-305
P0001-S-306 S-306
P0001-S-307 S-307
P0001-S-308 S-308
P0001-S-309 S-302C
P0001-S-309 S-302P
P0001-S-309 S-309
P0001-S-310 S-310
P0001-S-401 S-401
P0001-S-402 S-402
I checked the block in all of the drawing files and it is the correct block however, on all of the drawings there are 3 attributes for the title of the sheet and the first attribute (in this test case) is always blank. But I thought the routine would pickup the second or third attributes.....??
I hope this is helpful.....??
Regards,
Vince
-
Give this one a try.
The attribute tags supplied needed to be forced Tags strings to all upper case.
;; http://www.theswamp.org/index.php?topic=8661.msg351362#msg351362
;; Note it will not process any open drawings
;|
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 any number of attributes
Modified by Lee Mac to process open drawings
Modified by CAB forced Tags to match to Tags strings in all upper case
|;
(defun getindex (blkname attList / *acad atts dwgs err f flag folder layouts masterlist name odbx odbxdoc)
(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 (strcase x) "")) attList)) ; CAB forced to upper case
(if (and (setq *acad (vlax-get-acad-object))
;(setq folder (browseforfolder))
(setq folder "C:\\Program Files\\ACAD2000\\=Active Projects\\Steve Carter\\Russell")
;(setq folder "C:\\Program Files\\ACAD2000\\Working")
(setq dwgs (getdwglist (list folder)))
)
(progn
(setq odbxdoc
(if (< (atoi (setq oVer (substr (getvar "acadver") 1 2))) 16)
(vla-GetInterfaceObject (vlax-get-acad-object) "ObjectDBX.AxDbDocument")
(vla-GetInterfaceObject (vlax-get-acad-object) (strcat "ObjectDBX.AxDbDocument." oVer))))
(vlax-for doc (vla-get-Documents *acad)
(setq DocLst (cons (cons (strcase (vla-get-FullName doc)) doc) DocLst)))
(foreach dwg dwgs
(setq flag (and (setq odbx (cdr (assoc (strcase dwg) DocLst)))))
(or odbx
(and (setq Err (vl-catch-all-apply
(function vla-open) (list odbxdoc dwg)) odbx odbxdoc)))
(if
(and
(or flag
(not (vl-catch-all-error-p err)))
;; 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 (strcase(vla-get-TagString att)) attList)) ; CAB force CAPS
(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
(function
(lambda (x) (and x (not (vlax-object-released-p x))
(vlax-release-object x))))
(list odbxdoc odbx *acad))
)
)
(reverse masterlist)
)
-
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 any number of attributes
Modified by Lee Mac to process open drawings
Modified by CAB forced Tags to match to Tags strings in all upper case
Hi.
I love this getindex routine using odbx
Is anyone able help to mod the (getindex) routine above to just read and process the current drawing folder WITHOUT having to open the browser window.
I tried to mod this part of codes and rem out (browseforfolder) subfunction, but it wouldn't read open drawings, which i like to keep Modified by Lee Mac to process open drawings
We have a very deep cad folder tree, 8 level deep and what i find most efficient is open a drawing and make index of the same folder.
Thankyou
(if (and (setq *acad (vlax-get-acad-object))
;(setq folder (browseforfolder))
(setq folder (getvar "dwgprefix"))
(setq dwgs (getdwglist (list folder)))
)
[/code
-
Here is a completely rewritten version:
Supply it with the directory to process, block name and attribute tag list.
;|
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 any number of attributes
Modified by Lee Mac to process open drawings
Modified by CAB forced Tags to match to Tags strings in all upper case
Rewritten by Lee Mac 14.11.2011 to process a directory supplied as an argument.
|;
(defun getindex ( directory blknme attlst / acapp acdocs dbx doc lst pair result tmp x )
(setq attlst (mapcar '(lambda ( x ) (cons (strcase x) "")) attlst)
blknme (strcase blknme)
)
(if
(and
(vl-file-directory-p
(setq directory
(vl-string-right-trim "\\" (vl-string-translate "/" "\\" directory))
)
)
(setq lst
(mapcar
(function
(lambda ( x ) (strcat directory "\\" x))
)
(vl-directory-files directory "*.dwg" 1)
)
)
)
(progn
(setq acapp (vlax-get-acad-object))
(vlax-for doc (vla-get-documents acapp)
(setq acdocs (cons (cons (strcase (vla-get-fullname doc)) doc) acdocs))
)
(setq dbx (LM:ObjectDBXDocument acapp))
(foreach dwg lst
(if
(and
(setq doc
(cond
( (cdr (assoc (strcase dwg) acdocs)))
( (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-open (list dbx dwg)))) dbx)
)
)
(not
(vl-catch-all-error-p
(vl-catch-all-apply 'vla-item (list (vla-get-blocks doc) blknme))
)
)
)
(vlax-for layout (vla-get-layouts doc)
(if (not (eq "MODEL" (strcase (vla-get-name layout))))
(vlax-for obj (vla-get-block layout)
(if
(and
(eq "AcDbBlockReference" (vla-get-objectname obj))
(eq blknme
(if (vlax-property-available-p obj 'effectivename)
(strcase (vla-get-effectivename obj))
(strcase (vla-get-name obj))
)
)
(eq :vlax-true (vla-get-hasattributes obj))
)
(progn
(setq tmp attlst)
(foreach att (vlax-invoke obj 'getattributes)
(if (setq pair (assoc (strcase (vla-get-tagstring att)) tmp))
(setq tmp (subst (cons (car pair) (vla-get-textstring att)) pair tmp))
)
)
(setq result (cons (cons (vl-filename-base dwg) tmp) result))
)
)
)
)
)
)
)
(foreach obj (list doc dbx acapp)
(if (and obj (eq 'VLA-OBJECT (type obj)) (not (vlax-object-released-p obj)))
(vlax-release-object obj)
)
)
)
)
(reverse result)
)
(defun LM:ObjectDBXDocument ( acapp / acver )
(vla-GetInterfaceObject acapp
(if (< (setq acver (atoi (getvar "ACADVER"))) 16)
"ObjectDBX.AxDbDocument"
(strcat "ObjectDBX.AxDbDocument." (itoa acver))
)
)
)
Untested, so I hope I haven't missed anything...
-
Nice thread.
I'm coming at this from just about exactly the opposite direction. We create a table with a list of drawing numbers (which match the filename). I then have a routine that will read this table, go out and find all of the drawings in the list, read their title blocks and bring the contents back into the original table. I have the routine reading about 3 drawings per second.
Once I got the routine for reading the data from the drawings it opened up several possibilities. For example, I built a routine that would read the drawing index and create a dsd file (for loading into the publish dialog) and automatically publish all of the drawings.
I like objectdbx:-)
-
I like objectdbx:-)
Me too :lol:
-
I like objectdbx:-)
Me too :lol:
I like tacos.
-
I like ODBX ...TACOS !!
-
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 any number of attributes
Modified by Lee Mac to process open drawings
Modified by CAB forced Tags to match to Tags strings in all upper case
Rewritten by Lee Mac 14.11.2011 to process a directory supplied as an argument.
Thankyou verymuch Lee
It works wonder, But i stumble across one minor issue that i would like to overcome.
which is the coversheet which have different block name to the normal border sheet title but still have attributes info.
(defun c:test (/ title ss)
(setq Title "*[AB][01234]*")
(if (setq ss (ssget "_X" (list (cons 0 "insert") (cons 2 Title) (cons 66 1))))
(progn
(setq titlename (cdr (assoc 2 (entget (ssname ss 0)))))
(getindex (getvar "dwgprefix") titlename)
(write2csv)
)
)
My question is, instead of providing blockname as an argument to GetIndex function.
Is it possible for ODBX to determine the block name based on a existing "TAGname"
say if a unigue tag name is found ie. attr tag is "DRAWING_NUMBER", then get the the block name if it contain this tag?
Because the block name is a big variable, name varies from project to project and based on sheet size.
I throught it would more user friendly if the program could self determine the block name if a particular attribute tag name is found.. This also allow to produce the sheet index if a project contain multiple sheet names but with similar attribute definitions.
This link http://www.theswamp.org/index.php?topic=32633.msg381796#msg381796 (http://www.theswamp.org/index.php?topic=32633.msg381796#msg381796)is also from yourself Lee is the closest to what i think might be able to assist to providing blockname.
Thankyou
-
Here is a completely rewritten version:
Supply it with the directory to process, block name and attribute tag list.
;|
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 any number of attributes
Modified by Lee Mac to process open drawings
Modified by CAB forced Tags to match to Tags strings in all upper case
Rewritten by Lee Mac 14.11.2011 to process a directory supplied as an argument.
|;
(defun getindex ( directory blknme attlst / acapp acdocs dbx doc lst pair result tmp x )
(setq attlst (mapcar '(lambda ( x ) (cons (strcase x) "")) attlst)
blknme (strcase blknme)
)
(if
(and
(vl-file-directory-p
(setq directory
(vl-string-right-trim "\\" (vl-string-translate "/" "\\" directory))
)
)
(setq lst
(mapcar
(function
(lambda ( x ) (strcat directory "\\" x))
)
(vl-directory-files directory "*.dwg" 1)
)
)
)
(progn
(setq acapp (vlax-get-acad-object))
(vlax-for doc (vla-get-documents acapp)
(setq acdocs (cons (cons (strcase (vla-get-fullname doc)) doc) acdocs))
)
(setq dbx (LM:ObjectDBXDocument acapp))
(foreach dwg lst
(if
(and
(setq doc
(cond
( (cdr (assoc (strcase dwg) acdocs)))
( (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-open (list dbx dwg)))) dbx)
)
)
(not
(vl-catch-all-error-p
(vl-catch-all-apply 'vla-item (list (vla-get-blocks doc) blknme))
)
)
)
(vlax-for layout (vla-get-layouts doc)
(if (not (eq "MODEL" (strcase (vla-get-name layout))))
(vlax-for obj (vla-get-block layout)
(if
(and
(eq "AcDbBlockReference" (vla-get-objectname obj))
(eq blknme
(if (vlax-property-available-p obj 'effectivename)
(strcase (vla-get-effectivename obj))
(strcase (vla-get-name obj))
)
)
(eq :vlax-true (vla-get-hasattributes obj))
)
(progn
(setq tmp attlst)
(foreach att (vlax-invoke obj 'getattributes)
(if (setq pair (assoc (strcase (vla-get-tagstring att)) tmp))
(setq tmp (subst (cons (car pair) (vla-get-textstring att)) pair tmp))
)
)
(setq result (cons (cons (vl-filename-base dwg) tmp) result))
)
)
)
)
)
)
)
(foreach obj (list doc dbx acapp)
(if (and obj (eq 'VLA-OBJECT (type obj)) (not (vlax-object-released-p obj)))
(vlax-release-object obj)
)
)
)
)
(reverse result)
)
(defun LM:ObjectDBXDocument ( acapp / acver )
(vla-GetInterfaceObject acapp
(if (< (setq acver (atoi (getvar "ACADVER"))) 16)
"ObjectDBX.AxDbDocument"
(strcat "ObjectDBX.AxDbDocument." (itoa acver))
)
)
)
Untested, so I hope I haven't missed anything...
LEE,
I enter the following at the command line:
(getindex ("c:\\b2\\" '("KEY-ITEM" "ITEM" "QUANTITY"))
where b2 is the dir of dwgs to be processed
KEY-ITEM is the block and ITEM and QUANTITY are the attributes
result.... nothing
what am I doing wrong at the command line?
tia, Steve
-
LEE,
I enter the following at the command line:
(getindex ("c:\\b2\\" '("KEY-ITEM" "ITEM" "QUANTITY"))
where b2 is the dir of dwgs to be processed
KEY-ITEM is the block and ITEM and QUANTITY are the attributes
result.... nothing
what am I doing wrong at the command line?
Steve,
The result you receive should be an error since you are passing an unquoted list which will interpret "c:\\b2\\" as a function, and you have only passed the getindex function one argument, with a missing ")" from the end.
Try this instead:
(getindex "c:\\b2" "KEY-ITEM" '("ITEM" "QUANTITY"))
Lee
-
There are so many variations of the program in this topic, its difficult which one yields the "sheet index".
can someone provide a "score card" of which entry is latest and greatest. Too bad the phoney ones can't be deleted, as they are certainly confusing to me !
tia
Steve
-
Hi.
Refer to my post Reply #151 above
How to odbx to get the Block Name with a given attribute tag name?
sort of step thru all insert/block in paper space layout, find the tagname "DRAWING_NUMBER" if found then extract the block name.
This code is from Lee http://www.theswamp.org/index.php?topic=38014.0 (http://www.theswamp.org/index.php?topic=38014.0)
whick i would like doing via ObjectDbx
(defun GetBlocksWithTag ( / ss i e )
(if (setq ss (ssget "_X" '((0 . "INSERT") (66 . 1))))
(repeat (setq i (sslength ss)) (setq e (ssname ss (setq i (1- i))))
(if
(not
(vl-some '(lambda ( a ) (eq "DRAWING_NUMBER" (vla-get-tagstring a)))
(vlax-invoke (vlax-ename->vla-object e) 'getattributes)
)
)
(ssdel e ss)
)
)
)
(setq blknme (cdr (assoc 2 (entget (ssname ss 0)))))
)
Thankyou