extract objects containing a specific field

[robert06]

While trying to modify lisp by Ian_Bryant http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/convert-field-to-text/td-p/1722015/pa...

I need to select objects containing fields %<\AcVar SaveDate \f "dd.MM.yyyy">%.

If the fields are in single line text, i can get them adding (cons 1 "*SaveDate*"), for MText it won't work..

    (setq ss1
      (ssget "X"
        (list
          (cons 0 "TEXT,MTEXT") (cons 1 "*SaveDate*")
        )
      )
    )

thank you

[chaitanya.chikkala]

TRY THIS FUNCTION....WHICH GIVES LIST OF ENTITIES(TEXT AND MTEXT ONLY) CONTAINING SPECIFIC TYPE OF FIELD

EXAMPLE OF USAGE: (GETFIELDENTITIES "%<\\AcVar SaveDate \\f \"dd.MM.yyyy\">%")

(DEFUN GETFIELDENTITIES (FIELD_STRING / ss1 LIST1 TEMP_ELE I)
(setq ss1
      (ssget "X"
        (list
          (cons 0 "TEXT,MTEXT")
        )
      )
    )
(SETQ LIST1 NIL TEMP_ELE NIL I 0)
(WHILE (< I (SSLENGTH SS1))
  (SETQ TEMP_ELE (VLAX-ENAME->VLA-OBJECT (SSNAME SS1 I)))
  (IF (/= (VLAX-METHOD-APPLICABLE-P TEMP_ELE "FIELDCODE") NIL)
    (PROGN
      (IF (= (VLAX-INVOKE-METHOD TEMP_ELE "FIELDCODE") FIELD_STRING)
      (SETQ LIST1 (CONS (SSNAME SS1 I) LIST1)))
    )
  )(SETQ I (+ I 1)))
  (REVERSE LIST1)

)

[robert06]

thank you, i'll try to figure out how to use this, i'm not that much a lisp person..

[hmsilva]

---

@robert06 wrote:

thank you, i'll try to figure out how to use this, i'm not that much a lisp person..

---

Hi Robert,

the code  supplied by chaitanya.chikkala, will select all text/mtext entities, test if there is a field, test if the field have the provided 'entire field code', if so, add the entity ename to a list, and the final result will be a list with those enames...

To process those enames you'll have to use a foreach or nth or car,....

I would suggest that insted testing 'entire field code' just test a portion of the field code, changing

(= (VLAX-INVOKE-METHOD TEMP_ELE "FIELDCODE") FIELD_STRING)

to

(wcmatch (vlax-invoke-method TEMP_ELE 'FIELDCODE) (strcat "*" FIELD_STRING "*"))

and use with

(setq MyList (GETFIELDENTITIES "SaveDate"))

the return from GETFIELDENTITIES function will set the variable MyList with a list with the entity enames.

If you need a selection set to work with, I would suggest something like this

(defun ssfield (str / hnd i obj ss ss1)
  (if (setq ss (ssget "_X" '((0 . "TEXT,MTEXT"))))
    (progn
      (setq ss1 (ssadd))
      (repeat (setq i (sslength ss))
            (setq hnd (ssname ss (setq i (1- i)))
                  obj  (vlax-ename->vla-object hnd))
        (if (and (vlax-method-applicable-p obj 'FIELDCODE)
                 (wcmatch (vlax-invoke-method obj 'FIELDCODE) (strcat "*" str "*"))
                 )
          (ssadd hnd ss1)
          )
        )
      )
    )
  )

 usage:

(setq MySS (ssfield "SaveDate"))

the return from ssfield function will set the variable MySS with a selection set with those entities.

Hope that helps

Henrique

[robert06]

Thank you for instructions, Henrique. I still don't see it through, further basic study on setting up conditions and subfunctioning is essential for me.. I need to change the selection set conditions here, I'll get back to this topic, thank you. The source code of following is from the link above by Ian_Bryant.

(defun c:csft ( / del-field ss1 index item)
  (vl-load-com)
  (defun del-field (ent / edic elist etype obj val)
   (if
     (and
      (setq edic (cdr (assoc 360 (setq elist (entget ent)))))
      (dictsearch edic "ACAD_FIELD")
     )
     (progn
       (setq obj (vlax-ename->vla-object ent)
             etype (cdr (assoc 0 elist))
      )
      (cond
        ((= etype "MTEXT")
         (setq val (vla-get-textstring obj))
         (dictremove edic "ACAD_FIELD")
         (vla-put-textstring obj val)
        )
        (T (dictremove edic "ACAD_FIELD"))
      )
    )
   )
  )
  (if
    (setq ss1
      (ssget "X"
        (list
          (cons 0 "TEXT,MTEXT") (cons 1 "*SaveDate*")
        )
      )
    )
    (progn
     (setq index 0)
     (repeat (sslength ss1)
       (setq item (ssname ss1 index))
       (if (del-field item) (entupd item))
       (setq index (+ 1 index))
     )
    )
  )
  (princ)
)

[hmsilva]

Robert, try

(vl-load-com)
(defun c:demo (/ del-field ssfield hnd i ss)

  ;; http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/convert-field-to-text/td-p/1722015/pa...
  ;; by Ian_Bryant
  (defun del-field (ent / edic elist etype obj val)
    (if
      (and
        (setq edic (cdr (assoc 360 (setq elist (entget ent)))))
        (dictsearch edic "ACAD_FIELD")
      )
       (progn
         (setq obj   (vlax-ename->vla-object ent)
               etype (cdr (assoc 0 elist))
         )
         (cond
           ((= etype "MTEXT")
            (setq val (vla-get-textstring obj))
            (dictremove edic "ACAD_FIELD")
            (vla-put-textstring obj val)
           )
           (T (dictremove edic "ACAD_FIELD"))
         )
       )
    )
  )

  ;; by me
  (defun ssfield (str / hnd i obj ss ss1)
    (if (setq ss (ssget "_X" '((0 . "TEXT,MTEXT"))))
      (progn
        (setq ss1 (ssadd))
        (repeat (setq i (sslength ss))
          (setq hnd (ssname ss (setq i (1- i)))
                obj (vlax-ename->vla-object hnd)
          )
          (if (and (vlax-method-applicable-p obj 'FIELDCODE)
                   (wcmatch (vlax-invoke-method obj 'FIELDCODE) (strcat "*" str "*"))
              )
            (ssadd hnd ss1)
          )
        )
      )
    )
  )

  (if (setq ss (ssfield "SaveDate"))
    (repeat (setq i (sslength ss))
      (setq hnd (ssname ss (setq i (1- i))))
      (del-field hnd)
    )
  )
  (vla-regen (vla-get-activedocument (vlax-get-acad-object)) acallviewports)
  (princ)
)

Henrique

[robert06]

Very kind of you, many thanks!

Still there seems to be a problem running the lisp in files which have more than one layout, in that case no del field action is taken.

[hmsilva]

You're welcome, Robert.

Should work in all layouts, I did test with various layouts...

Post a sample dwg, if possible.

Henrique

[robert06]

Yes, my conclusion was too early, in some drawings it worked, if only one layout was left, some objects seem to prevent the lisp from working.

a sample dwg

https://www.dropbox.com/s/u4ckn4va6z08sml/xsite.dwg?dl=0

[robert06]

If to create a new text or mtext object with savedate field on the layout in the sample drawing, the lisp will recognize all the SaveDate fields then, and deletes the fields also in model space after that. Only a new field on layout will result this..

[robert06]

The link to drawing works now, in case download failed before.

[hmsilva]

Robert,

I did reproduced such behavior, later I'll see what I can do...

Henrique

[hmsilva · Accepted solution]

Sorry Robert, my bad...

Try the revised code

(vl-load-com)
(defun c:demo (/ del-field ssfield hnd i ss)

  ;; http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/convert-field-to-text/td-p/1722015/pa...
  ;; by Ian_Bryant
  (defun del-field (ent / edic elist etype obj val)
    (if
      (and
        (setq edic (cdr (assoc 360 (setq elist (entget ent)))))
        (dictsearch edic "ACAD_FIELD")
      )
       (progn
         (setq obj   (vlax-ename->vla-object ent)
               etype (cdr (assoc 0 elist))
         )
         (cond
           ((= etype "MTEXT")
            (setq val (vla-get-textstring obj))
            (dictremove edic "ACAD_FIELD")
            (vla-put-textstring obj val)
           )
           (T (dictremove edic "ACAD_FIELD"))
         )
       )
    )
  )

  ;; by me
  (defun ssfield (str / hnd i obj ss ss1)
    (if (setq ss (ssget "_X" '((0 . "TEXT,MTEXT"))))
      (progn
        (setq ss1 (ssadd))
        (repeat (setq i (sslength ss))
          (setq hnd (ssname ss (setq i (1- i)))
                obj (vlax-ename->vla-object hnd)
          )
          (if (and (vlax-method-applicable-p obj 'FIELDCODE)
                   (wcmatch (vlax-invoke-method obj 'FIELDCODE) (strcat "*" str "*"))
              )
            (ssadd hnd ss1)
          )
        )
        ss1
      )
    )
  )

  (if (setq ss (ssfield "SaveDate"))
    (repeat (setq i (sslength ss))
      (setq hnd (ssname ss (setq i (1- i))))
      (del-field hnd)
    )
  )
  (vla-regen (vla-get-activedocument (vlax-get-acad-object)) acallviewports)
  (princ)
)

Henrique

[robert06]

Works perfectly, thank you, Sir!

Robret

[hmsilva]

You're welcome, Robert
Glad I could help

Henrique