Jump to content

Extracting certain attributes from a block in multiple dwgs.


chauncy274

Recommended Posts

Hey guys,

 

Where I work we transfer dwgs. with our client for every job so when we get the dwgs. in we have to manually log each and every one in and record various info.

 

I was wondering if it were possible to create an application, either visual lisp or vba, that could go into the group of dwgs., get me the file name, and three attributes (DWGNO, Disc1, and REVISION) from the block 'TITLE' and then place them into an excel sheet for me. Really I just need the code to get into a group of dwgs. (never done code that could work on multiple dwgs. at the same time) and the code needed to extract that data. I think if I knew how to do that I could piece it together quite nicely.

 

Thanks in advance for any and all help!:)

Link to comment
Share on other sites

Excuse my ignorance, I'm nowhere near as good as most of the people on this forum.

 

How would a script be useful here? It's my understanding that you can't read information with a script, and that you can't run a script in multiple dwgs. unless you open each one and run it manually?

 

Right now I have a rough sketch of how I think the program should operate in VBA (very little experience in VBA) with little to no actual code as of right now.

 

I'm thinking that I'll start off with a dialog box containing the directory of my computer, so that I can select the dwg files I need (is this possible), then it should open them in order, get the file name, the attribute info from the title block, all of which is in model space, and print them to line 1 of an excel sheet, then cycle through the dwgs. going down one row on the excel sheet for every dwg.

Link to comment
Share on other sites

You can use a script to open as many drawings as you like and then carry out multiple functions within that script. I can assure you I opened around 120 dwgs in one session and you would be amazed how quick it does it.

 

eg

checkexcelrunning (check for excel is running)

Open dwg1 myprog1 close N

Open dwg2 myprog1 close N

Open dwg3 myprog1 close N

Open dwg4 myprog1 close N

 

(check for excel is running) is a program that does just that and there are many examples here using VBA to check to see if excel is open.

 

Myprog1 is a little program that writes out the attributes to the excel sheet.

 

There are a lot of examples here that allow you to write myprog1. because you know which block contains dwgno disc1 revision it would be easy. It does not matter model space paper space where the drawing is saved as you are looking at the database it will find the block. A word though of caution we have multiple layouts in most of our dwgs the revision No can change between layouts. But you could export every sheets details which is probably best anyway.

Link to comment
Share on other sites

Further to above here is the code to update the block called "titleblock" and I have noted the point where you export the attribs to excel. Its a start.

 

Public Sub issued_for_construction()
' This Updates the Issued for construction and sets rev 0

Dim SS As AcadSelectionSet
Dim Count As Integer
Dim FilterDXFCode(1) As Integer
Dim FilterDXFVal(1) As Variant
Dim attribs As Variant
Dim BLOCK_NAME As String
On Error Resume Next
FilterDXFCode(0) = 0
FilterDXFVal(0) = "INSERT"
FilterDXFCode(1) = 2
FilterDXFVal(1) = "titleblock"
BLOCK_NAME = "titleblock"
Set SS = ThisDrawing.SelectionSets.Add("issued")
SS.Select acSelectionSetAll, , , FilterDXFCode, FilterDXFVal

For Cntr = 0 To SS.Count - 1
  attribs = SS.Item(Cntr).GetAttributes
      
'   take these next 4 lines out and add your export to excel here !

       attribs(0).TextString = "ISSUED FOR CONSTRUCTION"
       attribs(3).TextString = "0"
       
       attribs(0).Update
       attribs(3).Update
       
Next Cntr
ThisDrawing.SelectionSets.Item("issued").Delete
'DO AGAIN FOR REVTABLE
'DATE
'Dim MyDate
'MyDate = Date
Call DashDate
FilterDXFCode(1) = 2
FilterDXFVal(1) = "REVTABLE"
BLOCK_NAME = "REVTABLE"
Set SS = ThisDrawing.SelectionSets.Add("revs")
SS.Select acSelectionSetAll, , , FilterDXFCode, FilterDXFVal

For Cntr = 0 To SS.Count - 1
  attribs = SS.Item(Cntr).GetAttributes
       
       
       attribs(0).TextString = "0"
       attribs(1).TextString = DashDate
       attribs(2).TextString = "ISSUED FOR CONSTRUCTION"
       
       
       
       attribs(0).Update
       attribs(1).Update
       attribs(2).Update
       
Next Cntr
ThisDrawing.SelectionSets.Item("revs").Delete
MsgBox "Drawing now changed to Issued for Construction"
End Sub
Public Function DashDate() As String
   Dim strDate As String
   Dim intMonth As Integer
   Dim intDay As Integer
   strDate = Str(Date)
   intMonth = InStr(1, strDate, "/", vbTextCompare)
   intDay = InStr(intMonth, strDate, "/", vbTextCompare)
   strDate = Left(strDate, intMonth - 1) & "." _
           & Mid(strDate, intMonth + 1, intDay - 1) & "." & Right(strDate, 2)
   DashDate = strDate
End Function

Link to comment
Share on other sites

Further to above here is the code to update the block called "titleblock" and I have noted the point where you export the attribs to excel. Its a start.

 

Public Sub issued_for_construction()
' This Updates the Issued for construction and sets rev 0

Dim SS As AcadSelectionSet
Dim Count As Integer
Dim FilterDXFCode(1) As Integer
Dim FilterDXFVal(1) As Variant
Dim attribs As Variant
Dim BLOCK_NAME As String
On Error Resume Next
FilterDXFCode(0) = 0
FilterDXFVal(0) = "INSERT"
FilterDXFCode(1) = 2
FilterDXFVal(1) = "titleblock"
BLOCK_NAME = "titleblock"
Set SS = ThisDrawing.SelectionSets.Add("issued")
SS.Select acSelectionSetAll, , , FilterDXFCode, FilterDXFVal

For Cntr = 0 To SS.Count - 1
  attribs = SS.Item(Cntr).GetAttributes
      
'   take these next 4 lines out and add your export to excel here !

       attribs(0).TextString = "ISSUED FOR CONSTRUCTION"
       attribs(3).TextString = "0"
       
       attribs(0).Update
       attribs(3).Update
       
Next Cntr
ThisDrawing.SelectionSets.Item("issued").Delete
'DO AGAIN FOR REVTABLE
'DATE
'Dim MyDate
'MyDate = Date
Call DashDate
FilterDXFCode(1) = 2
FilterDXFVal(1) = "REVTABLE"
BLOCK_NAME = "REVTABLE"
Set SS = ThisDrawing.SelectionSets.Add("revs")
SS.Select acSelectionSetAll, , , FilterDXFCode, FilterDXFVal

For Cntr = 0 To SS.Count - 1
  attribs = SS.Item(Cntr).GetAttributes
       
       
       attribs(0).TextString = "0"
       attribs(1).TextString = DashDate
       attribs(2).TextString = "ISSUED FOR CONSTRUCTION"
       
       
       
       attribs(0).Update
       attribs(1).Update
       attribs(2).Update
       
Next Cntr
ThisDrawing.SelectionSets.Item("revs").Delete
MsgBox "Drawing now changed to Issued for Construction"
End Sub
Public Function DashDate() As String
   Dim strDate As String
   Dim intMonth As Integer
   Dim intDay As Integer
   strDate = Str(Date)
   intMonth = InStr(1, strDate, "/", vbTextCompare)
   intDay = InStr(intMonth, strDate, "/", vbTextCompare)
   strDate = Left(strDate, intMonth - 1) & "." _
           & Mid(strDate, intMonth + 1, intDay - 1) & "." & Right(strDate, 2)
   DashDate = strDate
End Function

 

Thanks, I'm gonna work on this code tomorrow at work and see how it comes out. Might meed a little bit more help cause I'd like to open a dialog box in vba at the beginning where I can select the directory that the dwgs. are in and it does all of them but when i tried to add a Microsoft common dialog box (which I was told is what I need) it says I don't have permission. I'm going to have to work on that tomorrow too. Thanks everybody!

Link to comment
Share on other sites

Fuccaro,

 

Thanks a load man, this code works great. I plan on changing it around to the format on the excel sheet that I need as soon as I get the chance. There is only one problem I am having, and it's not your programs fault. For some reason, when I use this on one of my companies title blocks, it returns more than one line in the excel sheet. Sometimes 5, sometimes 17! When I use it on another type of block (I tried it on quite few others that i placed into the dwg myself), it worked just fine and only printed out one line. I'm trying to figure out why it's picking up our title block so many times when I can only find 1 instance of it on the dwg. I'm enclosing a copy of the title block that it's having a problem with. If anyone can give me an idea of how to fix this or tell me what's wrong with my companies title blocks, I'd be forever grateful!

 

The Block is titled "DTITLE" and I'm trying to get the attributes "REVNO." and "DWGNO.".

 

*** I'm going to enclose the dwg. file and code of yours that I am talking about in the next post cause it won't let me post them until my 9nth post :(

Link to comment
Share on other sites

42-07-05-020841-RSS#420-2450 Conductivity Analyzer on Aniline Day Tank (MQP).dwg

; Global ATTribute EXtractor 
; by Miklos Fuccaro mfuccaro@hotmail.com 
;-------------------------November 2004 ------- 
;;Edited March 2006 by C. Bassler to allow specification of block and tage names to extract
(defun gattex() 
  (setq Blocklist '("DTITLE"));; ** edit to include block names to select
  (setq TagList '("DWGNO." "REVNO."));; ** edit to include tag names to extract
  ;;create block names separated by columns, for selection filter
  (setq Blocknames (List2String BlockList))
  (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 BlockNames))))
  (if (not ss) (quit))
  (setq Root (getvar "DWGPREFIX"))
  (setq file (open (strcat Root "attributes.CSV") "a") i -1) 
  (write-line (strcat Root (getvar "DWGNAME") 
               " -found " (itoa (sslength ss)) 
               " block(s) with attributes") file) 
  (repeat (sslength ss)
      (setq TagRow nil ValRow nil) 
      (setq Edata (entget (setq e (ssname ss (setq i (1+ i))))))
      (write-line "" file) 
      (write-line (strcat "block name:" "," (Dxf 2 Edata)) file) 
      (while (/= (Dxf 0 Edata) "SEQEND") 
         (if
             (and
                 (= (Dxf 0 Edata) "ATTRIB") 
                 (member (dxf 2 Edata) TagList);;if tag is on list
             );and
             (progn
                 (setq TagRow (cons (Dxf 2 Edata) TagRow))
                 (setq valRow (cons (Dxf 1 Edata) ValRow))
             );progn
         )
         (setq Edata (entget (setq e (entnext e))))
      );while
      (write-line (List2String (reverse TagRow)) file)
      (write-line (List2String (reverse ValRow)) file)
  );repeat 
  (close file)
  (princ (strcat "\nDone writing file " Root "attributes.csv"))
  (princ) 
);defun
;;-------------------------------
(defun List2String (Alist)
  (setq NumStr (length Alist))
     (foreach Item AList
        (if (= Item (car AList));;first item
           (setq LongString (car AList))
           (setq LongString (strcat LongString "," Item))
         )
     )
  LongString
);defun
;;--------------------------------
(defun Dxf (code pairs)
  (cdr (assoc code pairs))
)
(gattex)

Link to comment
Share on other sites

Chauncy

I tested yhe drawing you posted -you are right, it appears more times listed in the CSV file. Sorry, I have no advice for you. From a while I only occasionally work with lisp. Maybe somebody else will jump-in to rescue.

And congrats for your 10th post!

Link to comment
Share on other sites

  • 2 weeks later...

Alright Guys,

 

I've got a program semi-made to do exactly what I want. It works in conjunction with some functions that I found that help place information into an excel file. (I highly recommend it). The functions that I found to help me are normally posted right after my function in my program so that I can call them but they are too long to post in here and I know they aren't the problem so I'm leaving them out. Anyone that wants to use/look at them goto http://web2.airmail.net/terrycad and download getexcel.lsp.

 

I designed it based off of Fuccarro's program but I made it sort through the three TitleBlocks that my company uses and then extracts the attributes from them (they are tagged differently in some dwgs. so I had to have many if statements in case they mislabeled or tagged differently, hence the rather large COND statement.) The problem I'm having with this program is that I get an error about having too many arguments and I believe it has to do with the COND statement that I have inside an if statement. Is there a fix to this? I used to have many if statements inside the first if statement but I thought this would fix the error and it still gives me the same error.

 

The OpenExcel, PutCell, & CloseExcel functions are from the functions that I described above. The PutCell function needs the cell number and then a list or string of info to place in that cell. A list will place each item in the cell to the right of the previous cell and a string will place the info just in the designated cell.

 

Thanks in advance guys.

 

;-------------------------------------------------------------------------------
; DwgLogin - Records Data to Excel Sheet for Later Use
;-------------------------------------------------------------------------------
(defun c:DwgLogin()
(vl-load-com)
(setq CurrentRow 1)
(setq root (getvar "DWGPREFIX"))
(setq filenamesDWG (vl-directory-files root "*.dwg"))
(OpenExcel (setq xlFile (strcat root "DrawingLogin.xls")) "Sheet1" nil)
(PutCell "A1" (list "Dwg. Number" "Sheet" "File #" "Desc." "Rev."))
(foreach DWGitem filenamesDWG
 (open (strcat root DWGitem) "r")
 (setq CurrentRow (1+ CurrentRow))
 (If	(/= nil (ssget "_X" (list '(0 . "INSERT") (cons 2 "S-TITLE"))))
       (setq TitleBlock "S-TITLE")
 ); **END IF**
 (if	(/= nil (ssget "_X" (list '(0 . "INSERT") (cons 2 "DTITLE"))))
       (setq TitleBlock "DTITLE")
 ); **END IF**
 (if	(/= nil (ssget "_X" (list '(0 . "INSERT") (cons 2 "TITLE"))))
       (setq TitleBlock "TITLE")
 ); **END IF**
(setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 TitleBlock)))) ; RETURNS SS CODE
(if (not ss) (quit))
(setq Edata (entget (setq e (ssname ss 0)))) ; GETS DXF SET FOR SS CODE
(while (/= (cdr (assoc 0 Edata) "SEQEND"))
(if (= (cdr (assoc 0 Edata)) "ATTRIB")
   (cond ((= (cdr (assoc 2 Edata)) "DwgNo.") (PutCell (strcat "A" (ITOA CurrentRow)) (cdr (assoc 1 Edata)))) ; COND TO PICK ATTRIBUTES
        ((= (cdr (assoc 2 Edata)) "DwgNo") (PutCell (strcat "A" (ITOA CurrentRow)) (cdr (assoc 1 Edata))))
	((= (cdr (assoc 2 Edata)) "wgNo.") (PutCell (strcat "A" (ITOA CurrentRow)) (cdr (assoc 1 Edata))))
	((= (cdr (assoc 2 Edata)) "WGNO") (PutCell (strcat "A" (ITOA CurrentRow)) (cdr (assoc 1 Edata))))
	((= (cdr (assoc 2 Edata)) "LINE2") (PutCell (strcat "D" (ITOA CurrentRow)) (cdr (assoc 1 Edata))))
	((= (cdr (assoc 2 Edata)) "LINE3") (PutCell (strcat "E" (ITOA CurrentRow)) (cdr (assoc 1 Edata))))
	((= (cdr (assoc 2 Edata)) "REVNO.") (PutCell (strcat "F" (ITOA CurrentRow)) (cdr (assoc 1 Edata))))
	((= (cdr (assoc 2 Edata)) "REVNO") (PutCell (strcat "F" (ITOA CurrentRow)) (cdr (assoc 1 Edata))))
	((= (cdr (assoc 2 Edata)) "REV") (PutCell (strcat "F" (ITOA CurrentRow)) (cdr (assoc 1 Edata))))
    )
)
(setq Edata (entget (setq e (entnext e))))
) ;WHILE
(close (strcat root DWGitem))
);ForEach
(CloseExcel xlFile)
)

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...