Block Field Lisp Routine

[jtwright4216]

Hey guys,

 

I was wondering if you someone could help me out with a LISP routine. I'm new to writing LISP for the most part. I use a lot of field commands to reference detail cuts to there corresponding detail title block. That way if I re-number the actual detail or move sheets then a quick regen is done and the plan detail cuts update accordingly. Both the cuts and titles are dynamic blocks. I do have some starting code that is similar, written by LeeMac, but only copies the field command attribute and applies it to another attribute, text or whatever. It's unable to copy an actual 'text' attribute and convert it to a field command. The picture attached shows what I'm talking about. I want to create a field 'text link' LISP routine for the referencing 6 of the detail. That way I don't have to tediously link them all manually. This would save me a ton of time if you guys could help me out. Script below.

 

 

;;--------------------------=={ Copy Field }==--------------------------;;
;;                                                                      ;;
;;  This program enables the user to copy a field expression from a     ;;
;;  selected source object to multiple destination objects in a         ;;
;;  drawing.                                                            ;;
;;                                                                      ;;
;;  Upon issuing the command syntax 'copyfield' at the AutoCAD          ;;
;;  command-line, the user is prompted to select an annotation object   ;;
;;  (Text, MText, Attribute, Multileader, Dimension) containing a       ;;
;;  field expression to be copied.                                      ;;
;;                                                                      ;;
;;  Following a valid response, the user may then copy the field to     ;;
;;  multiple selected destination objects in the drawing.               ;;
;;----------------------------------------------------------------------;;
;;  Author:  Lee Mac, Copyright © 2013  -  www.lee-mac.com              ;;
;;----------------------------------------------------------------------;;
;;  Version 1.0    -    2013-07-14                                      ;;
;;                                                                      ;;
;;  - First release.                                                    ;;
;;----------------------------------------------------------------------;;
;;  Version 1.1    -    2017-06-13                                      ;;
;;                                                                      ;;
;;  - Updated LM:fieldcode function to account for field expressions    ;;
;;    greater than 250 characters in length.                            ;;
;;----------------------------------------------------------------------;;

(defun c:copyfield ( / *error* select src )

   (defun *error* ( msg )
       (LM:endundo (LM:acdoc))
       (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
           (princ (strcat "\nError: " msg))
       )
       (princ)
   )

   (defun select ( msg fun / ent rtn )
       (while
           (progn (setvar 'errno 0) (setq ent (nentsel msg))
               (cond
                   (   (= 7 (getvar 'errno))
                       (princ "\nMissed, try again.")
                   )
                   (   (= 'list (type ent))
                       (cond
                           (   (progn
                                   (if (= 4 (length ent))
                                       (setq ent (last (last ent)))
                                       (setq ent (car ent))
                                   )
                                   (not (wcmatch (cdr (assoc 0 (entget ent))) "TEXT,MTEXT,ATTRIB,MULTILEADER,*DIMENSION"))
                               )
                               (princ "\nInvalid object selected.")
                           )
                           (   (not (setq rtn ((eval fun) ent))))
                       )
                   )
               )
           )
       )
       rtn
   )

   (if
       (setq src
           (select "\nSelect source field: "
               (function
                   (lambda ( ent )
                       (cond ((LM:fieldcode ent)) ((not (princ "\nSelected object does not contain a field."))))
                   )
               )
           )
       )
       (progn
           (LM:startundo (LM:acdoc))
           (select "\nSelect destination object <Exit>: "
               (function
                   (lambda ( ent / obj )
                       (cond
                           (   (null (vlax-write-enabled-p (setq obj (vlax-ename->vla-object ent))))
                               (princ "\nSelected object is on a locked layer.")
                           )
                           (   (vlax-property-available-p obj 'textoverride t)
                               (vla-put-textoverride obj src)
                               (command "_.updatefield" ent "")
                           )
                           (   (vlax-property-available-p obj 'textstring t)
                               (vla-put-textstring obj src)
                               (command "_.updatefield" ent "")
                           )
                       )
                       nil
                   )
               )
           )
           (LM:endundo (LM:acdoc))
       )
   )
   (princ)
)

;; Field Code  -  Lee Mac
;; Returns the field expression associated with an entity

(defun LM:fieldcode ( ent / replacefield replaceobject fieldstring enx )

   (defun replacefield ( str enx / ent fld pos )
       (if (setq pos (vl-string-search "\\_FldIdx" (setq str (replaceobject str enx))))
           (progn
               (setq ent (assoc 360 enx)
                     fld (entget (cdr ent))
               )
               (strcat
                   (substr str 1 pos)
                   (replacefield (fieldstring fld) fld)
                   (replacefield (substr str (1+ (vl-string-search ">%" str pos))) (cdr (member ent enx)))
               )
           )
           str
       )
   )

   (defun replaceobject ( str enx / ent pos )
       (if (setq pos (vl-string-search "ObjIdx" str))
           (strcat
               (substr str 1 (+ pos 5)) " "
               (LM:ObjectID (vlax-ename->vla-object (cdr (setq ent (assoc 331 enx)))))
               (replaceobject (substr str (1+ (vl-string-search ">%" str pos))) (cdr (member ent enx)))
           )
           str
       )
   )

   (defun fieldstring ( enx / itm )
       (if (setq itm (assoc 3 enx))
           (strcat (cdr itm) (fieldstring (cdr (member itm enx))))
           (cond ((cdr (assoc 2 enx))) (""))
       )
   )
   
   (if (and (wcmatch  (cdr (assoc 0 (setq enx (entget ent)))) "TEXT,MTEXT,ATTRIB,MULTILEADER,*DIMENSION")
            (setq enx (cdr (assoc 360 enx)))
            (setq enx (dictsearch enx "ACAD_FIELD"))
            (setq enx (dictsearch (cdr (assoc -1 enx)) "TEXT"))
       )
       (replacefield (fieldstring enx) enx)
   )
)

;; ObjectID  -  Lee Mac
;; Returns a string containing the ObjectID of a supplied VLA-Object
;; Compatible with 32-bit & 64-bit systems

(defun LM:ObjectID ( obj )
   (eval
       (list 'defun 'LM:ObjectID '( obj )
           (if
               (and
                   (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
                   (vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
               )
               (list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
              '(itoa (vla-get-objectid obj))
           )
       )
   )
   (LM:ObjectID obj)
)

;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
   (LM:endundo doc)
   (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
   (while (= 8 (logand 8 (getvar 'undoctl)))
       (vla-endundomark doc)
   )
)

;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
   (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
   (LM:acdoc)
)

;;----------------------------------------------------------------------;;

(vl-load-com)
(princ
   (strcat
       "\n:: CopyField.lsp | Version 1.1 | \\U+00A9 Lee Mac "
       (menucmd "m=$(edtime,0,yyyy)")
       " www.lee-mac.com ::"
       "\n:: Type \"copyfield\" to Invoke ::"
   )
)
(princ)

;;----------------------------------------------------------------------;;
;;                             End of File                              ;;
;;----------------------------------------------------------------------;;