Looking for 3rd party utility to extract attributes
I am looking for a 3rd party utility to help extract attributes from a drawing.I've read the on-line help about the built-in method, but find it cumbersome. Also, even if I set up the correct template file, it may not fit each drawing because the blocks in question may have been modified by various users.Ideally, such a 3rd part utility would present the user with a dialog box that lists the blocks in the drawing and allows them to choose which block they want to extract the info from. Then it would simply write out a cdf file with all the attributes (the first field having the names of the attributes).I realize it could be programmed with LISP or VBA, but my programming skills have faded with time, so I am looking for an easy out.Joe Dunfee
Comments
-
You could try mine, to me it's gold, to you maybe rubbish, quick dirty but cheap. It's limited to blocks with 2 or less attribs... maybe 3. Prints them as text in the drawing. See if it's any use, I have another for counting/sorting the results.(DEFUN c:CAT ()(SETVAR "CMDECHO" 0)(if (/= 0 (cdr (assoc 40 (tblsearch "style" (getvar "textstyle"))))) (progn (princ "\nTextsize must be 0 ")(terpri))(progn(setq oldl (getvar "clayer"))(COMMAND "LAYER" "M" "DEFPOINTS" "")(SETQ OLDP (GETVAR "LUPREC"))(SETVAR "LUPREC" 0)(setq ss (ssget "x" '((0 . "INSERT")(66 . 1))) n 0 p1 nil p1 (getpoint "\nStart Point: "))(while (/= n (sslength ss))(setq a (ssname ss n) b (entnext a) c (entnext (entnext a)) d (entnext (entnext (entnext a))) p (cdr (assoc 2 (entget b))) q (cdr (assoc 1 (entget b))) p2 (polar p1 0 (* (getvar "textsize") 12)) p3 (polar p1 0 (* (getvar "textsize") 24)) p4 (polar p1 0 (* (getvar "textsize") 36))) (if (= "ATTRIB" (cdr (assoc 0 (entget b)))) (progn (setq p (cdr (assoc 2 (entget a)))) (command "text" p1 "" "" p))) (if (= "ATTRIB" (cdr (assoc 0 (entget b)))) (progn (setq q (cdr (assoc 1 (entget b)))) (command "text" p2 "" "" q))) (if (= "ATTRIB" (cdr (assoc 0 (entget c)))) (progn (setq r (cdr (assoc 1 (entget c)))) (command "text" p3 "" "" r))) (if (= "ATTRIB" (cdr (assoc 0 (entget d)))) (progn (setq s (cdr (assoc 1 (entget d)))) (command "text" p4 "" "" s)))(setq n (1+ n) p1 (polar p1 (* 1.5 pi)(* (getvar "LTSCALE") 0.4))))(SETVAR "LUPREC" OLDP)(command "layer" "S" oldl ""))))
0 -
John Gaunt said;> I have another for counting/sorting the results. Thank you very much. I have just ordered a LISP programming book, figguring I was going to have to re-learn it. It would be doubtful they would have a tutorial on just what I want, and your program really gives me a head start ( I need to modify it a bit to allow it to extract a few more attributes.)Of course, I would love the count/sort version as well.I promise to post any modifications or improvements I make to the program.Joe Dunfee
0 -
Yeah it makes a few assumptions which would not fit nicely in everyone's setup, but glad it might be some use. Count bombs out if you select anything but text.... you know what it's like when you're only trying to impress yourself.(DEFUN C:COUNT ()(if (/= 0 (cdr (assoc 40 (tblsearch "style" (getvar "textstyle"))))) (progn (princ "\nTextsize must be 0 ")(terpri))(progn(setq oldl (getvar "clayer"))(COMMAND "LAYER" "M" "DEFPOINTS" "")(SETQ OLDP (GETVAR "LUPREC"))(SETVAR "LUPREC" 0)(Defun act1 ()(while (/= num (sslength ss)) (setq b (ssname ss num)) (if (= (cdr (assoc 1 (entget a))) (cdr (assoc 1 (entget b)))) (progn (setq n (+ 1 n)) (ssdel b ss)(setq num (- num 1)))) (setq num (1+ num))))(defun act2 () (setq upd (STRCAT (cdr (assoc 1 (entget a))) " " (rtos n)))(SETQ LST (APPEND LST (LIST UPD))) (ssdel a ss)(setq a (ssname ss 0)) (setq num 1)(setq n 1))(SETQ LST NIL) (setq ss (ssget)) (setq a (ssname ss 0)) (setq num 1) (setq n 1)(while (/= 0 (sslength ss))(act1)(act2))(SETQ LST (ACAD_STRLSORT LST))(SETQ P1 (GETPOINT "\nStart Point For Text: "))(setq n 0)(while (/= n (length lst))(setq exp (nth n lst))(command "text" p1 "" "" exp)(setq n (1+ n) p1 (polar p1 (* 1.5 pi)(* 0.4 (getvar "LTSCALE")))))(SETVAR "LUPREC" OLDP)(command "layer" "m" oldl ""))))
0 -
I see, "act 1" and "act 2" in the program... do you have a theatrical background?Joe Dunfee
0 -
Ha ha, no. So many are as good or better at engineering, my next best chance to impress is to try and be a little broader
0 -
One way to do this is with a VBA macro in Excel or Access.Something like:Set Icad = CreateObject (Icad or IntelliCAD Application)Open the dwg..For each Ent in Dwg.Modelspace If Ent.EntityName = "BlocInsert" Set Blk=Ent If Blk.HasAttributes.... get the attributes, write them to a table... end if end ifNext
0 -
I am trying the VBA approach now. However, I'm running into some difficulty.I've tried the following '---First the declarations---Dim PickObj As IntelliCAD.EntityDim Pt1 As IntelliCAD.PointDim Ename As StringDim Blk As BlockInsertDim Attribs As VariantDim Attrib As Attributes'---now the code---Doc.Utility.GetEntity PickObj, Pt1, "pick an object"Ename = PickObj.EntityNameAttribs = PickObj.GetAttributesBut I get the following error message on the "Attribs = PickObj.GetAttributes" line;"Object doesn't support this property or method"What am I doing wrong?Joe Dunfee
0 -
I am still trying to figgure out how to do this with VBA.I am stuck at this point and can't get around it.I have created a program that has the user select a block with attributes, and then it display the attributes in a text box. (It was based on a tutorial example which would display the layer which the object was on.) However, in my version I always get the following error message after selecting the object I want to list;--------------------Run-time error '438";Object doesn't support this property or method--------------------Then after choosing debug, the following line of code is highlighted;Attribs = PickObj.GetAttributesNote that earlier in the program, the variable Attribs is set as a Variant.Below is the full extent of the program. Note that I've rem-ed out several lines to try to make it as simple as possible.Private Sub CommandButton1_Click()'---------------'get object to display layer name of'---------------Dim PickObj As IntelliCAD.EntityDim Pt1 As IntelliCAD.PointDim Ename As String'Dim Blk As BlockInsertDim Attribs As Variant'Dim Attrib As Attributes UserForm1.Hide'---next line is a rem-ed out version that also failed---'Doc.Utility.GetEntity PickObj, Pt1, "pick an object"ActiveDocument.Utility.GetEntity PickObj, Pt1, "pick an object"Ename = PickObj.EntityNameAttribs = PickObj.GetAttributesTextBox1.Text = "Name: " & Ename & vbCrLf & "Layer: " & PickObj.LayerUserForm1.ShowEnd SubPrivate Sub ExitButton_Click()EndEnd Sub'----------------------------------------------------------' Set up drawing document'----------------------------------------------------------Private Sub UserForm_Initialize() Set Doc = IntelliCAD.ActiveDocumentEnd Sub'-----------------------------------Joe Dunfee
0 -
Something like this????This is only for one blockinsert, but it can easily be changed to every block in the drawing. If this is needed, please let me know. I can rewrite it.Paste in a module for easy reading (comments etc)__________________________________________________Sub main()Dim MyDoc As IntelliCAD.DocumentDim MyBlockInsert As IntelliCAD.BlockInsertDim MyPt As IntelliCAD.PointDim Myatt As IntelliCAD.AttributesSet MyDoc = IntelliCAD.ActiveDocumentSet MyBlocks = MyDoc.BlocksRetry:On Error Resume Next 'Catch error when user selects nothing or an item other then a blockMyDoc.Utility.GetEntity MyBlockInsert, MyPt, "Select block to extract attibuted: " 'Let the user select a block INSERTION and asign to MyBlockinsertIf MyBlockInsert = "" Then 'No block picked, then prompt to retry MsgBox "Please select a block" GoTo Retry 'Go to line Retry to pick a block againEnd IfIf MyBlockInsert.HasAttributes = False Then 'Check if the block has attributes MsgBox "Block does not have any attibutes", , "Sorry." Exit SubEnd IfSet Myatt = MyBlockInsert.GetAttributes 'assign attibutes to Myattprintstring = "Name" + vbTab + "Value" + vbLfFor n = 1 To Myatt.Count 'for each attibute in the block, print name and value. printstring = printstring + Myatt(n).TagString + vbTab + Myatt(n).TextString + vbLfNext'You need a userform with the title "UserForm_Print"'In this userform you need to add a Textbox "Textbox_Foroutput"'The rest is initialized from here.With UserForm_Print.TextBox_ForOutput .MultiLine = True .ScrollBars = fmScrollBarsBoth .TabStop = True .Value = printstringEnd WithUserForm_Print.Caption = "Block Attibutes: Copy Paste in Excel or OpenOffice.Calc for better presentation!"UserForm_Print.ShowEnd Sub
0 -
Thank you for the additional info. Though it was a relatively old post, it is still an issue for me.I have only dabbled a bit in LISP and VBA, but all my books are for AutoCAD. I bump into the incompatabilities often enough that I was not able to progress much. The lack of good documentation for the IntelliCAD versions is a significant barrier for the novice.To add one more thing to the issue, there is supposed to be an upcomming version of IntelliCAD's VBA, which is comptable with AutoCAD's VBA. But we don't know when it will be available.My programming efforts have been on hold for quite a while now, and are still in limbo.Joe Dunfee
0 -
Bricscad V8 indeed will have an AutoCad compatible COM API. It is scheduled to be released this summer.Hans De BackerBricscad development
0