lisp for getting field formulas

[JamesMaeding]

I had a routine that extracted field values from text and atts, but noticed this morning it did not work on fields from sheets sets.

I looked at the code and realized if a field formula is beyond 256 chars, the dxf codes store it in multiple groups.

Here is the revised code that deals with thos multiple groups (3 and then 2):

;GET LIST OF TEXT AND FIELDS FOR A GIVEN TEXT
;RETURNS ("PLOTTED BY " "%<\\AcVar Login \\f \"%tc4\">%" " DATE" ...)
;FIELDS START AND END WITH WITH %< >%
;(TXT-FIELDS-SEPARATED (car (Nentsel "\nSelect Text, MText or Attribute: ")))
(DEFUN TXT-FIELDS-SEPARATED (ENAME
                             / DICT ELIST ENDINDEX FIELDS FLDDICT FLST FORMULA INDEX
                             OBJ SPLIT-FLDS TRIMMED-LIST TXT-LIST TXTAFTER DENT FLDVAL FLST-TR)
  (SETQ ELIST (ENTGET ENAME))
  (COND
    ((OR (= (CDR (ASSOC 0 ELIST)) "TEXT")
         (= (CDR (ASSOC 0 ELIST)) "MTEXT")
         (= (CDR (ASSOC 0 ELIST)) "ATTRIB")
      )
      (SETQ OBJ (VLAX-ENAME->VLA-OBJECT ENAME)
            DICT (VLAX-VLA-OBJECT->ENAME (VLA-GETEXTENSIONDICTIONARY OBJ))
            ;CODE (VLA-FIELDCODE OBJ)
      )
     ;FLDDICT will have multiple 360 items for multiple fields
      (IF (SETQ DENT (DICTNEXT DICT "ACAD_FIELD"))
        (PROGN
          ;formula has placeholders like %<\\_FldIdx 0>%, %<\\_FldIdx 1>%..for each field
          (SETQ  FLDDICT (ENTGET (CDR (LAST DENT)))
                FORMULA (CDR (ASSOC 2 FLDDICT))
                ;VALUE (CDR (ASSOC 1 FLDDICT))
                TRIMMED-LIST (MEMBER (ASSOC 360 FLDDICT) FLDDICT)
          )
          ;LOOP THROUGH 360 GROUPS OF FLDDICT
          (WHILE (= (CAR (CAR TRIMMED-LIST)) 360)
            (SETQ FLST (ENTGET (CDR (CAR TRIMMED-LIST))))
            ;CAREFUL HERE, FORMULAS LONGER THAN 256 CHARS GET STORED BY MULTIPLE 3 GROUPS,
            ;THEN A 2 GROUP
            ;TRIM FLST TO FIRST 2 GROUP
            (SETQ FLST-TR (CDR (MEMBER (ASSOC 1 FLST) FLST))
                  FLDVAL ""
            )
            ;WHILE NEXT ITEM IS A 3 GROUP, GRAB ITS VALUE
            (WHILE (= (CAR (CAR FLST-TR)) 3)
              (SETQ FLDVAL (STRCAT FLDVAL (CDR (CAR FLST-TR)))
                    FLST-TR (CDR FLST-TR)
              )
            )
            (IF (= (CAR (CAR FLST-TR)) 2)
              (SETQ FLDVAL (STRCAT FLDVAL (CDR (CAR FLST-TR))))
            )
            (SETQ FIELDS (CONS FLDVAL FIELDS)
                  TRIMMED-LIST (CDR TRIMMED-LIST)
            )
          )
         (SETQ FIELDS (REVERSE FIELDS))
         ;PARSE FORMULA TO SEPARATE THE TEXT FROM FILEDS
         (SETQ SPLIT-FLDS (STR-TOKENS FORMULA (LIST "%<"))
               INDEX 0
         )
         (FOREACH ITEM SPLIT-FLDS
           (IF (SETQ ENDINDEX (VL-STRING-SEARCH ">%" ITEM))
             (PROGN
               (SETQ TXTAFTER (SUBSTR ITEM (+ 3 ENDINDEX))
                     TXT-LIST (CONS (STRCAT "%<" (NTH INDEX FIELDS) ">%") TXT-LIST)
                     INDEX (+ 1 INDEX)
               )
               (IF (/= TXTAFTER "") ;AT THE END
                 (SETQ TXT-LIST (CONS TXTAFTER TXT-LIST))
               )
             )
             ;ELSE ADD TO LIST
             (SETQ TXT-LIST (CONS ITEM TXT-LIST))
            )
          )
        )
        ;ELSE RETURN TEXT
        (SETQ TXT-LIST (LIST (VLA-GET-TEXTSTRING OBJ)))
      )
    )
  )
  (REVERSE TXT-LIST)
)

(DEFUN STR-TOKENS (STR-IN DELIM-LST
                   / CHAR-POS DELIM E1 E2 INDEX LAST-POS POS POS-LIST RET-LIST STR-LEFT)
  (FOREACH DELIM DELIM-LST
    (SETQ STR-LEFT STR-IN
          CHAR-POS 0
    )
    (WHILE (SETQ POS (vl-string-search DELIM STR-LEFT))
      (SETQ POS-LIST (CONS (LIST (+ CHAR-POS POS) (STRLEN DELIM)) POS-LIST)
            STR-LEFT (SUBSTR STR-LEFT (+ POS 1 (STRLEN DELIM)))
            CHAR-POS (+ CHAR-POS (+ POS (STRLEN DELIM)))
      )
    )
  )
  (SETQ POS-LIST (vl-sort POS-LIST (function (lambda (e1 e2)(< (car e1) (car e2))))))
  ;NOW USE POS-LIST TO CREATE LIST OF STRINGS
  (SETQ INDEX 1
        LAST-POS 1
  )
  (FOREACH POS POS-LIST
    (SETQ RET-LIST (CONS (SUBSTR STR-IN LAST-POS (+ 1 (- (CAR POS) LAST-POS))) RET-LIST))
    (SETQ LAST-POS (+ 1 (CAR POS)(CADR POS))
          INDEX (+ 1 INDEX)
    )
    ;IF ON LAST ITEM, DO TIL END
    (IF (AND (> INDEX (LENGTH POS-LIST))
             (< (- LAST-POS 1) (STRLEN STR-IN))
        )
      (SETQ RET-LIST (CONS (SUBSTR STR-IN LAST-POS) RET-LIST))
    )
  )
  (IF RET-LIST
    (REVERSE RET-LIST)
    (LIST STR-IN)
  )
)

I wonder if this kind of splitting of string is done for other dictionaries, I would guess it is. Not well documented though...

Once you have the field formulas, you can construct a string for text. Be sure to run the updatefield command on the entity or you get ####.

[mid-awe]

Just my 2¢ on your updatefield comment.

rather than all the entdata handling, I prefer to simply:

(DEFUN UPD8-FLDS NIL (VL-CMDF "UPDATEFIELD" "ALL" ""))

for more than a thousand fields I notice no difference in the time for it to run. I did notice however that only fields in the current space are selected, but that can be easily remedied.

[JamesMaeding]

interesting, I could just put that at the end of any tools dealing with fields.

I guess the per entity approach also allows me to not run it if there were no fields.

That is how my attribute update function is written currently.

Of more interest to me is the use of VL-CMDF.

I never use that. I need to look into the advantages.

thx for your comment and kudos also!

[mid-awe]

Lord knows you helped me plenty, back in the day.

I'm glad I could be helpful too.