Hi Dommy,
Perhaps this will make your life easier:
(defun c:Att2Field ( / *error* doc spc tables att atts undo pt str )
(vl-load-com)
;; © Lee Mac 2010
(defun *error* ( msg )
(and undo (vla-EndUndoMark doc))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ)
)
(LM:ActiveSpace 'doc 'spc)
(setq tables (LM:ss->vla (ssget "_X" '((0 . "ACAD_TABLE")))))
(if (setq att
(LM:SelectifFoo
(lambda ( x )
(and (eq "INSERT" (cdr (assoc 0 (entget x))))
(= 1 (cdr (assoc 66 (entget x))))
)
)
"\nSelect Block to Retrieve Attribute Data: "
)
)
(progn
(setq atts (vlax-invoke (vlax-ename->vla-object att) 'GetAttributes))
(setq undo (not (vla-StartUndoMark doc)))
(while (and (setq att (car atts))
(setq pt (getpoint (strcat "\nPlace " (vla-get-TextString att) " : "))))
(setq str (strcat "%<\\AcObjProp Object(%<\\_ObjId " (LM:GetObjectID att doc) ">%).TextString>%")
atts (cdr atts))
(cond ( (LM:TextinCell tables pt str) )
( (vla-AddMText spc (vlax-3D-point pt) 0 str) ))
)
(setq undo (vla-EndUndoMark doc))
)
)
(princ)
)
;;-------------------=={ Text in Cell }==---------------------;;
;; ;;
;; If specified point lies inside a table cell, cell text is ;;
;; set to the specified string. ;;
;;------------------------------------------------------------;;
;; Author: Lee McDonnell, 2010 ;;
;; ;;
;; Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;; Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; tables - a list of VLA Table Objects to be checked ;;
;; pt - a 3D Point ;;
;; str - a string to populate the cell ;;
;;------------------------------------------------------------;;
;; Returns: T if text is allocated into a cell, else nil ;;
;;------------------------------------------------------------;;
(defun LM:TextinCell ( tables pt str / data )
;; © Lee Mac 2010
(if
(setq data
(vl-some
(function
(lambda ( table )
(if
(eq :vlax-true
(vla-hittest table (vlax-3D-point (trans pt 1 0))
(vlax-3D-point (trans (getvar 'VIEWDIR) 1 0)) 'row 'col
)
)
(list table row col)
)
)
)
tables
)
)
(not
(apply (function vla-setText)
(append data (list str))
)
)
)
)
;;-----------------=={ SelectionSet -> VLA }==----------------;;
;; ;;
;; Converts a SelectionSet to a list of VLA Objects ;;
;;------------------------------------------------------------;;
;; Author: Lee McDonnell, 2010 ;;
;; ;;
;; Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;; Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; ss - Valid SelectionSet (Pickset) ;;
;;------------------------------------------------------------;;
;; Returns: List of VLA Objects ;;
;;------------------------------------------------------------;;
(defun LM:ss->vla ( ss )
;; © Lee Mac 2010
(if ss
(
(lambda ( i / e l )
(while (setq e (ssname ss (setq i (1+ i))))
(setq l (cons (vlax-ename->vla-object e) l))
)
l
)
-1
)
)
)
;;-------------------=={ Select if Foo }==--------------------;;
;; ;;
;; Continuous selection prompts until the predicate function ;;
;; foo is validated ;;
;;------------------------------------------------------------;;
;; Author: Lee McDonnell, 2010 ;;
;; ;;
;; Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;; Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; foo - predicate function taking ename argument ;;
;; str - prompt string ;;
;;------------------------------------------------------------;;
;; Returns: selected entity ename if successful, else nil ;;
;;------------------------------------------------------------;;
(defun LM:SelectifFoo ( foo str / sel ent )
;; © Lee Mac 2010
(while
(progn
(setq sel (entsel str))
(cond
(
(vl-consp sel)
(if (not (foo (setq ent (car sel))))
(princ "\n** Invalid Object Selected **")
)
)
)
)
)
ent
)
;;--------------------=={ Get ObjectID }==--------------------;;
;; ;;
;; Returns the ObjectID string for the specified VLA Object ;;
;;------------------------------------------------------------;;
;; Author: Lee McDonnell, 2010 ;;
;; ;;
;; Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;; Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; obj - VLA Object to process ;;
;; doc - VLA Document Object ;;
;;------------------------------------------------------------;;
;; Returns: ObjectID String, else nil ;;
;;------------------------------------------------------------;;
(defun LM:GetObjectID ( obj doc )
;; © Lee Mac 2010
(if (eq "X64" (strcase (getenv "PROCESSOR_ARCHITECTURE")))
(vlax-invoke-method (vla-get-Utility doc) 'GetObjectIdString obj :vlax-false)
(itoa (vla-get-Objectid obj))
)
)
;;--------------------=={ ActiveSpace }==---------------------;;
;; ;;
;; Retrieves pointers to the Active Document and Space ;;
;;------------------------------------------------------------;;
;; Author: Lee McDonnell, 2010 ;;
;; ;;
;; Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;; Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; *doc - quoted symbol other than *doc ;;
;; *spc - quoted symbol other than *spc ;;
;;------------------------------------------------------------;;
(defun LM:ActiveSpace ( *doc *spc )
;; © Lee Mac 2010
(set *spc
(if
(or
(eq AcModelSpace
(vla-get-ActiveSpace
(set *doc
(vla-get-ActiveDocument
(vlax-get-acad-object)
)
)
)
)
(eq :vlax-true (vla-get-MSpace (eval *doc)))
)
(vla-get-ModelSpace (eval *doc))
(vla-get-PaperSpace (eval *doc))
)
)
)
It will prompt for a selection of a block and gather all attribute data from within that block. It will then prompt you to place fields for each attribute either as MText or within a Table Cell.
Let me know how you get on,
Lee
