KAPC Posted February 8, 2010 Posted February 8, 2010 I have several long tables with fields for which I would like to automate data input so that I don't have to select the field type/ property/format each time. Can anyone help me with a command/lisp routine that would "edit field" (a repeated field in a table) and change said field to an: (1) object measurement data* or (2) object area data* only by having to select the object and bypassing the selection of the type, property, format, etc. (*=maybe 2 distinct routines are actually necessary) Alternatively, a simpler command/lisp routine would insert a field on the drawing with the above data (measurement/area), that I could then copy and paste into the table cell. Many thanks! Quote
Lee Mac Posted February 8, 2010 Posted February 8, 2010 This thread may help http://www.cadtutor.net/forum/showthread.php?t=38009 If you don't find what you are looking for there, I would be happy to help some more Quote
Lee Mac Posted February 8, 2010 Posted February 8, 2010 Try this: ;; Put Field in Cell, by Lee McDonnell 11.07.2009 (defun c:putfld (/ *error* doc spc chx ent Obj tStr flag grdat gr dat osPt tss lst row col) (vl-load-com) (defun *error* (msg) (and tObj (not (vlax-erased-p tObj)) (vla-delete tObj)) (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")) (princ (strcat "\n<< Error: " msg " >>")) (princ "\n*Cancel*")) (princ)) (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object)) spc (if (zerop (vla-get-activespace doc)) (if (= (vla-get-mspace doc) :vlax-true) (vla-get-modelspace doc) ; Vport (vla-get-paperspace doc)) (vla-get-modelspace doc))) (or *mac (setq *mac "Select")) (while (progn (initget "Select Polyline Quit") (setq chx (getkword (strcat "\nSelect Object or Draw Polyline [sel/Poly/Quit] <" *mac "> : "))) (or (not chx) (setq *mac chx)) (setq flag nil) (cond ((eq "Quit" chx) nil) (t (cond ((eq "Select" *mac) (while (progn (setq ent (car (entsel "\nSelect Object: "))) (cond ((eq 'ENAME (type ent)) (if (not (and (vlax-property-available-p (setq Obj (vlax-ename->vla-object ent)) 'Area) (vlax-property-available-p Obj 'Length))) (princ "\n** Invalid Object Selected **"))) (t (princ "\n** Nothing Selected **")))))) ((eq "Polyline" *mac) (command "_.pline") (while (eq 1 (logand 1 (getvar 'CMDACTIVE))) (command pause)) (setq Obj (vlax-ename->vla-object (entlast))))) (if Obj (progn (repeat 2 (setq tStr (strcat "%<\\AcObjProp.16.2 Object(%<\\_ObjId " (vl-princ-to-string (vla-get-Objectid Obj)) ">%)." (if flag "Length" "Area") " \\f \"%lu2%pr2\">%")) (setq tObj (vla-addMText spc (vlax-3D-point '(0 0 0)) 0 tStr)) (vla-put-visible tObj :vlax-false) (princ (strcat "\nPlace " (if flag "Length" "Area") " Field...")) (while (progn (setq grdat (grread t 15 0) gr (car grdat) dat (cadr grdat)) (cond ((and (eq 5 gr) (listp dat)) (redraw) (vla-put-visible tObj :vlax-true) (vla-move tObj (vla-get-InsertionPoint tObj) (vlax-3D-point dat)) t) ((eq 2 gr) (cond ((vl-position dat '(32 13)) nil) (t t))) ((eq 25 gr) (and tObj (not (vlax-erased-p tObj)) (vla-delete tObj)) nil) ((eq 3 gr) (if (and (setq tss (ssget "_X" '((0 . "ACAD_TABLE")))) (setq lst (car (vl-remove-if 'null (mapcar (function (lambda (tab) (if (eq :vlax-true (vla-HitTest tab (vlax-3D-point (trans dat 1 0)) (vlax-3D-point (trans (getvar 'VIEWDIR) 1 0)) 'row 'col)) (list tab row col)))) (mapcar 'vlax-ename->vla-object (mapcar 'cadr (ssnamex tss)))))))) (and (not (apply 'vla-SetText (append lst (list tStr)))) tObj (not (vlax-erased-p tObj)) (vla-delete tObj))) nil) (t t)))) (setq flag T)))))))) (princ)) Quote
KAPC Posted February 8, 2010 Author Posted February 8, 2010 Thanks, this seems to work except for the property "Measurement". How do I add it to the routine? Quote
Lee Mac Posted February 8, 2010 Posted February 8, 2010 Thanks, this seems to work except for the property "Measurement". How do I add it to the routine? 'Measurement'? As for dimensions? Do you still need Perimeter? Quote
KAPC Posted February 8, 2010 Author Posted February 8, 2010 I don't need the length/perimeter. The "area" field is related to a physical object which works well, but I need a "measurement" field when I pick the dimensions associated with the object. My table basically consists of showing how the area is calculated so I need to input(link) the dimensions into the "equation side" of the table, and the area to the "total side". Quote
KAPC Posted February 9, 2010 Author Posted February 9, 2010 I thought the area numbers had to be accurate but instead they have to match the calculation exactly (precision-sensible). To that regard, I have to actually let Autocad calculate the formula and only input the fields connected to the measurements. See attached table example. I like how this routine works, can you help simplifying the routine by just asking for 'Measurement' property, in other words select dimension, place in table/cell? ps. I've tried to change the routine myself but I keep on getting invalid object or error... Quote
Lee Mac Posted February 9, 2010 Posted February 9, 2010 Try this: (defun c:dval (/ COL ENT I LST OBJ OBJLST PT ROW SS) ;; Place Dimension Value in Cell ~ Lee Mac 03.01.10 (vl-load-com) (if (setq i -1 ss (ssget "_X" '((0 . "ACAD_TABLE")))) (progn (while (setq ent (ssname ss (setq i (1+ i)))) (setq objLst (cons (vlax-ename->vla-object ent) objLst))) (while (progn (setq ent (car (entsel "\nSelect Dimension or Text <Exit> : "))) (cond ( (eq 'ENAME (type ent)) (if (not (wcmatch (vla-get-ObjectName (setq obj (vlax-ename->vla-object ent))) "*Dimension,*Text")) (princ "\n** Object Must be a Dimension or Text **") (while (progn (setq pt (getpoint "\nPick inside Cell to Place Text: ")) (cond ( (not pt)) ( (setq lst (car (vl-remove-if (function null) (mapcar (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)))) ObjLst)))) (apply (function vla-SetText) (append lst (list (cond ( (wcmatch (vla-get-Objectname obj) "*Dimension") (strcat (vla-get-TextPrefix obj) (rtos (vla-get-Measurement obj) (vla-get-UnitsFormat obj) (vla-get-PrimaryUnitsPrecision obj)) (vla-get-TextSuffix obj))) ( (vla-get-TextString obj)))))) nil) (t (princ "\n** Point must be inside Cell **")))))) t))))) (princ "\n** No Tables Found in Drawing **")) (princ)) Quote
KAPC Posted February 9, 2010 Author Posted February 9, 2010 It's not really working. For some reason it's inserting the dimension value followed by "\ X". Anyway, the input value is text and really needs to be a field, much like your earlier routine for the area, length fields. Quote
Lee Mac Posted February 17, 2010 Posted February 17, 2010 Hi KAPC, Finally got a chance to look at this, give this a go: (defun c:Dim2Cell (/ *error* CODE COL DATA ENT GR I LST OBJ ROW SPC TLST TOBJ TSS TSTR UFLAG) (vl-load-com) ;; Lee Mac ~ 17.02.10 (defun *error* (msg) (and uFlag (vla-EndUndoMark *doc)) (and tObj (not (vlax-erased-p tObj)) (vla-delete tObj)) (or (not msg) (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ)) (setq *doc (cond (*doc) ((vla-get-ActiveDocument (vlax-get-acad-object)))) spc (if (zerop (vla-get-activespace *doc)) (if (= (vla-get-mspace *doc) :vlax-true) (vla-get-modelspace *doc) (vla-get-paperspace *doc)) (vla-get-modelspace *doc))) (if (setq i -1 tss (ssget "_X" '((0 . "ACAD_TABLE")))) (while (setq ent (ssname tss (setq i (1+ i)))) (setq tLst (cons (vlax-ename->vla-object ent) tLst)))) (while (progn (setq ent (car (entsel "\nSelect Dimension to Retrieve Measurement: "))) (cond ( (eq 'ENAME (type ent)) (if (vlax-property-available-p (setq obj (vlax-ename->vla-object ent)) 'Measurement) (progn (setq uFlag (not (vla-StartUndoMark *doc))) (setq tStr (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-ObjectId Obj)) ">%).Measurement \\f \"%lu6\">%")) (vla-put-AttachmentPoint (setq tObj (vla-AddMText spc (vlax-3D-point '(0 0 0)) 0 tStr)) acAttachmentPointMiddleCenter) (while (progn (setq gr (grread 't 13 0) code (car gr) data (cadr gr)) (cond ( (and (= 5 code) (listp data)) (vla-put-InsertionPoint tObj (vlax-3D-point data)) t) ( (= 25 code) (and tObj (not (vlax-erased-p tObj)) (vla-delete tObj)) nil) ( (and (= 3 code) (listp data)) (cond ( (setq lst (car (vl-remove-if 'null (mapcar (function (lambda (table) (if (eq :vlax-true (vla-hittest table (vlax-3D-point (trans data 1 0)) (vlax-3D-point (trans (getvar 'VIEWDIR) 1 0)) 'row 'col)) (list table row col)))) tLst)))) (apply (function vla-SetText) (append lst (list tStr))) (and tObj (not (vlax-erased-p tObj)) (vla-delete tObj)))) nil) (t )))) (setq uFlag (vla-EndUndoMark *doc))) (princ "\n** Object Does not Have Measurement Property **")))))) (princ)) Lee Quote
ibach Posted June 11, 2013 Posted June 11, 2013 (edited) Cool! This does work. Is there a way to automate creating fields in a sense of remembering previous settings? For example: I create field that is linked to an object, objects property, than I set precision and additional parameters. Than I want to use all the same except for an other object.... update: .... I'm a donkey... Of course Lee Mac solved it long time ago writing Areas2AttributeV1-1.lsp that is easily modified to all of my needs. Thanks Lee, once again. Edited June 17, 2013 by ibach Quote
Recommended Posts
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.