Jump to content

Field Edit or Field Input Automation


KAPC

Recommended Posts

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!

Link to comment
Share on other sites

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))

Link to comment
Share on other sites

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?

Link to comment
Share on other sites

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".

Link to comment
Share on other sites

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...

TableEx.jpg

Link to comment
Share on other sites

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))

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

  • 2 weeks later...

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

Link to comment
Share on other sites

  • 3 years later...

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 by ibach
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...