[编程交流] 将choose选项添加到lisp

(defun increment (str / )
(if (= mynumber nil) (setq mynumber 0))
 (setq mynumber (+ mynumber 1))
(princ "\Current Number :<")(princ mynumber)
        (setq askw (getint "> : "))
        (if (/= askw nil)(setq mynumber askw))
        (vl-string-subst (itoa mynumber) "*" str)
)
;;-------------------------=={ Length Field }==-------------------------;;
;;                                                                      ;;
;;  This program allows a user to generate a field expression           ;;
;;  referencing the length/perimeter/circumference of one or more       ;;
;;  selected objects. In the case of selecting multiple objects, the    ;;
;;  field expression will reference the sum of the lengths of all       ;;
;;  objects in the selection.                                           ;;
;;                                                                      ;;
;;  The user may opt to specify a point at which to create a new        ;;
;;  multiline text object housing the field expression, pick a table    ;;
;;  cell in which the field should be inserted, or select an existing   ;;
;;  single-line text, multiline text, multileader, or attribute to      ;;
;;  be populated with the field expression.                             ;;
;;                                                                      ;;
;;  Upon issuing the command syntax 'LF' (Length Field) at the AutoCAD  ;;
;;  command-line, the program first prompts the user to make a          ;;
;;  selection of objects for which to return the length summation.      ;;
;;                                                                      ;;
;;  At this prompt, the user may select any number of Arcs, Circles,    ;;
;;  Lines, 2D Polylines (light or heavy), or 3D Polylines.              ;;
;;                                                                      ;;
;;  The user is then prompted to specify a point or table cell to       ;;
;;  insert a field expression referencing the summation of the lengths  ;;
;;  of the selected objects.                                            ;;
;;                                                                      ;;
;;  At this prompt, the user may also choose the 'Object' option in     ;;
;;  order to populate the content of an existing annotation object      ;;
;;  with the field expression.                                          ;;
;;                                                                      ;;
;;  Upon choosing this option, the user may select any single-line      ;;
;;  text (DText), multiline text (MText), single-line or multiline      ;;
;;  attribute, attributed block, or multileader (MLeader) with either   ;;
;;  multiline text or attributed block content.                         ;;
;;                                                                      ;;
;;  If the user selects an attributed block or attributed multileader   ;;
;;  with more than one attribute, the user is presented with a dialog   ;;
;;  interface listing the available attributes, and is prompted to      ;;
;;  select a destination for the field expression.                      ;;
;;                                                                      ;;
;;  The user may optionally predefine the target block/multileader      ;;
;;  attribute by specifying the attribute tag where noted at the top    ;;
;;  of the program source code.                                         ;;
;;                                                                      ;;
;;  The resulting field expression will display the sum of the lengths  ;;
;;  of the selected objects, formatted using the field formatting code  ;;
;;  specified at the top of the program.                                ;;
;;                                                                      ;;
;;----------------------------------------------------------------------;;
;;  Author:  Lee Mac, Copyright © 2017  -  www.lee-mac.com              ;;
;;----------------------------------------------------------------------;;
;;  Version 1.0    -    2017-08-06                                      ;;
;;                                                                      ;;
;;  - First release.                                                    ;;
;;----------------------------------------------------------------------;;
;;  Version 1.1    -    2017-08-06                                      ;;
;;                                                                      ;;
;;  - Program modified to account for selection of existing annotation  ;;
;;    objects which already contain a field expression.                 ;;
;;----------------------------------------------------------------------;;
(defun c:lf ( / *error* ent enx flg fmt idx lst obj oid prp sel str tab tag tmp typ )
    (setq fmt "L*=%lu6%pr2 cm") ;; Field Formatting
    (setq 
          fmt (increment fmt)
          tag nil    ;; Optional predefined attribute tag
    )
    
    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )
    (LM:startundo (LM:acdoc))
    (setq prp
       '(
            ("AcDbArc"        . "ArcLength")
            ("AcDbCircle"     . "Circumference")
            ("AcDbLine"       . "Length")
            ("AcDbPolyline"   . "Length")
            ("AcDb2dPolyline" . "Length")
            ("AcDb3dPolyline" . "Length")
        )
    )
    (if
        (setq sel
            (LM:ssget "\nSelect objects to obtain total length <exit>: "
                (list
                    (list
                       '(000 . "ARC,CIRCLE,LINE,*POLYLINE")
                       '(-04 . "<NOT")
                           '(-04 . "<AND")
                               '(000 . "POLYLINE") '(-04 . "&") '(070 . 80)
                           '(-04 . "AND>")
                       '(-04 . "NOT>")
                        (if (= 1 (getvar 'cvport))
                            (cons 410 (getvar 'ctab))
                           '(410 . "Model")
                        )
                    )
                )
            )
        )
        (progn
            (if (= 1 (sslength sel))
                (setq obj (vlax-ename->vla-object (ssname sel 0))
                      str 
                    (strcat
                        "%<\\AcObjProp Object(%<\\_ObjId "
                        (LM:objectid obj)
                        ">%)." (cdr (assoc (vla-get-objectname obj) prp)) " \\f "" fmt "">%"
                    )
                )
                (progn
                    (repeat (setq idx (sslength sel))
                        (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx))))
                              lst
                            (vl-list*
                                "%<\\AcObjProp Object(%<\\_ObjId "
                                (LM:objectid obj)
                                ">%)." (cdr (assoc (vla-get-objectname obj) prp)) ">%" " + "
                                lst
                            )
                        )
                    )
                    (setq str
                        (strcat
                            "%<\\AcExpr "
                            (apply 'strcat (reverse (cdr (reverse lst))))
                            " \\f "" fmt "">%"
                        )
                    )
                )
            )
            (if
                (setq tmp
                    (ssget "_X"
                        (list '(0 . "ACAD_TABLE")
                            (if (= 1 (getvar 'cvport))
                                (cons 410 (getvar 'ctab))
                               '(410 . "Model")
                            )
                        )
                    )
                )
                (repeat (setq idx (sslength tmp))
                    (setq tab (cons (vlax-ename->vla-object (ssname tmp (setq idx (1- idx)))) tab))
                )
            )
            (while
                (not
                    (progn
                        (if flg
                            (progn
                                (setvar 'errno 0)
                                (initget "Point eXit")
                                (setq sel (nentsel "\nSelect text, mtext, mleader, attribute or attributed block [Point/eXit] <eXit>: "))
                            )
                            (progn
                                (initget "Object eXit")
                                (setq sel (getpoint "\nSpecify point or cell for field [Object/eXit] <eXit>: "))
                            )
                        )
                        (cond
                            (   (= 7 (getvar 'errno))
                                (prompt "\nMissed, try again.")
                            )
                            (   (or (null sel) (= "eXit" sel)))
                            (   (= "Point" sel)
                                (setq flg nil)
                            )
                            (   (= "Object" sel)
                                (not (setq flg t))
                            )
                            (   flg
                                (setq ent (car sel)
                                      enx (entget ent)
                                      typ (cdr (assoc 0 enx))
                                      obj (vlax-ename->vla-object ent)
                                )
                                (cond
                                    (   (and (= 2 (length sel)) (wcmatch typ "TEXT,MTEXT"))
                                        (if (vlax-write-enabled-p obj)
                                            (LF:puttextstring obj str)
                                            (prompt "\nThe selected text object is on a locked layer.")
                                        )
                                    )
                                    (   (and (= "ATTRIB" typ)
                                             (/= 'str (type tag))
                                        )
                                        (if (vlax-write-enabled-p obj)
                                            (progn
                                                (LF:puttextstring obj str)
                                                (LF:updatefield ent)
                                            )
                                            (prompt "\nThe selected attribute is on a locked layer.")
                                        )
                                    )
                                    (   (and
                                            (or
                                                (and (= "ATTRIB" typ)
                                                     (setq tmp (cdr (assoc 330 enx)))
                                                )
                                                (and (setq tmp (last (cadddr sel)))
                                                     (= "INSERT" (cdr (assoc 0 (entget tmp))))
                                                )
                                            )
                                            (setq tmp (vlax-invoke (vlax-ename->vla-object tmp) 'getattributes))
                                            (or
                                                (and (= 'str (type tag))
                                                     (setq idx (vl-position (strcase tag) (mapcar 'vla-get-tagstring tmp)))
                                                     (setq obj (nth idx tmp))
                                                )
                                                (and (not (cdr tmp))
                                                     (setq obj (car tmp))
                                                )
                                                (and (setq idx (LM:listbox "Choose Attribute" (mapcar 'vla-get-tagstring tmp) 2))
                                                     (setq obj (nth (car idx) tmp))
                                                )
                                            )
                                        )
                                        (if (vlax-write-enabled-p obj)
                                            (progn
                                                (LF:puttextstring obj str)
                                                (LF:updatefield (vlax-vla-object->ename obj))
                                            )
                                            (prompt "\nThe selected attribute is on a locked layer.")
                                        )
                                    )
                                    (   (and (= 2 (length sel)) (= "MULTILEADER" typ))
                                        (setq typ (cdr (assoc 172 (reverse enx))))
                                        (cond
                                            (   (and (<= acblockcontent typ acmtextcontent) (not (vlax-write-enabled-p obj)))
                                                (prompt "\nThe selected multileader is on a locked layer.")
                                            )
                                            (   (= acmtextcontent typ)
                                                (LF:puttextstring obj str)
                                                (vla-regen (LM:acdoc) acactiveviewport)
                                                t
                                            )
                                            (   (and
                                                    (= acblockcontent typ)
                                                    (setq tmp (LM:getmleaderattributes obj))
                                                    (or
                                                        (and (= 'str (type tag))
                                                             (setq oid (cdr (assoc (strcase tag) tmp)))
                                                        )
                                                        (and (not (cdr tmp))
                                                             (setq oid (cdar tmp))
                                                        )
                                                        (and (setq idx (LM:listbox "Choose Attribute" (mapcar 'car tmp) 2))
                                                             (setq oid (cdr (nth (car idx) tmp)))
                                                        )
                                                    )
                                                )
                                                (LM:setmleaderattributevalue obj oid str)
                                                (vla-regen (LM:acdoc) acactiveviewport)
                                                t
                                            )
                                            (   (prompt "\nThe select multileader has no editable content."))
                                        )
                                    )
                                    (   (prompt "\nThe selected object is not text, mtext, multileader, attribute or attributed block."))
                                )
                            )
                            (   (setq tmp (LM:getcell tab (trans sel 1 0)))
                                (if (vlax-write-enabled-p (car tmp))
                                    (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-settext (append tmp (list str)))))
                                    (prompt "\nThe selected table cell belongs to a table on a locked layer.")
                                )
                            )
                            (   (vla-addmtext
                                    (vlax-get-property (LM:acdoc) (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
                                    (vlax-3D-point (trans sel 1 0))
                                    0.0
                                    str
                                )
                            )
                        )
                    )
                )
            )
        )
    )
    (*error* nil) (princ)
)
(defun LF:puttextstring ( obj str )
    (vla-put-textstring obj "") ;; To clear any existing field
    (vla-put-textstring obj str)
    t
)
(defun LF:updatefield ( ent / cmd rtn )
    (setq cmd (getvar 'cmdecho))
    (setvar 'cmdecho 0)
    (setq rtn (vl-cmdf "_.updatefield" ent ""))
    (setvar 'cmdecho cmd)
    rtn
)
;; ssget  -  Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - [str] selection prompt
;; arg - [lst] list of ssget arguments
(defun LM:ssget ( msg arg / sel )
    (princ msg)
    (setvar 'nomutt 1)
    (setq sel (vl-catch-all-apply 'ssget arg))
    (setvar 'nomutt 0)
    (if (not (vl-catch-all-error-p sel)) sel)
)
;; Get MLeader Attributes  -  Lee Mac
;; Returns an association list of attribute tags & object IDs for all attributes held by an mleader block
;; mld - [vla] MLeader vla-object
;; Returns: [lst] List of ((<Attribute Tag> . <Object ID>) ... )
(defun LM:getmleaderattributes ( mld / rtn )
    (vlax-for obj (vla-item (vla-get-blocks (vla-get-document mld)) (vla-get-contentblockname mld))
        (if
            (and
                (= "AcDbAttributeDefinition" (vla-get-objectname obj))
                (= :vlax-false (vla-get-constant obj))
            )
            (setq rtn (cons (cons (strcase (vla-get-tagstring obj)) (LM:intobjectid obj)) rtn))
        )
    )
    (reverse rtn)
)
;; Object ID (integer)  -  Lee Mac
;; Returns an integer representing the ObjectID of a supplied VLA-Object
;; Compatible with 32-bit & 64-bit systems
(defun LM:intobjectid ( obj )
    (if (vlax-property-available-p obj 'objectid32)
        (defun LM:intobjectid ( obj ) (vla-get-objectid32 obj))
        (defun LM:intobjectid ( obj ) (vla-get-objectid   obj))
    )
    (LM:intobjectid obj)
)
;; Set MLeader Attribute Value  -  Lee Mac
;; obj - [vla] MLeader vla-object
;; idx - [int] Attribute Definition Object ID
;; str - [str] Attribute value
(defun LM:setmleaderattributevalue ( obj idx str )
    (if (vlax-method-applicable-p obj 'setblockattributevalue32)
        (defun LM:setmleaderattributevalue ( obj idx str ) (vla-setblockattributevalue32 obj idx str))
        (defun LM:setmleaderattributevalue ( obj idx str ) (vla-setblockattributevalue   obj idx str))
    )
    (LM:setmleaderattributevalue obj idx str)
)
;; List Box  -  Lee Mac
;; Displays a DCL list box allowing the user to make a selection from the supplied data.
;; msg - [str] Dialog label
;; lst - [lst] List of strings to display
;; bit - [int] 1=allow multiple; 2=return indexes
;; Returns: [lst] List of selected items/indexes, else nil
 
(defun LM:listbox ( msg lst bit / dch des tmp rtn )
    (cond
        (   (not
                (and
                    (setq tmp (vl-filename-mktemp nil nil ".dcl"))
                    (setq des (open tmp "w"))
                    (write-line
                        (strcat "listbox:dialog{label="" msg "";spacer;:list_box{key="list";multiple_select="
                            (if (= 1 (logand 1 bit)) "true" "false") ";width=50;height=15;}spacer;ok_cancel;}"
                        )
                        des
                    )
                    (not (close des))
                    (< 0 (setq dch (load_dialog tmp)))
                    (new_dialog "listbox" dch)
                )
            )
            (prompt "\nError Loading List Box Dialog.")
        )
        (   t     
            (start_list "list")
            (foreach itm lst (add_list itm))
            (end_list)
            (setq rtn (set_tile "list" "0"))
            (action_tile "list" "(setq rtn $value)")
            (setq rtn
                (if (= 1 (start_dialog))
                    (if (= 2 (logand 2 bit))
                        (read (strcat "(" rtn ")"))
                        (mapcar '(lambda ( x ) (nth x lst)) (read (strcat "(" rtn ")")))
                    )
                )
            )
        )
    )
    (if (< 0 dch)
        (unload_dialog dch)
    )
    (if (and tmp (setq tmp (findfile tmp)))
        (vl-file-delete tmp)
    )
    rtn
)
;; Get Cell  -  Lee Mac
;; If the supplied point lies within a cell boundary,
;; returns a list of: (<VLA Table Object> <Row> <Col>)
 
(defun LM:getcell ( lst pnt / dir )
    (setq dir (vlax-3D-point (trans (getvar 'viewdir) 1 0))
          pnt (vlax-3D-point pnt)
    )
    (vl-some
       '(lambda ( tab / row col )
            (if (= :vlax-true (vla-hittest tab pnt dir 'row 'col))
                (list tab row col)
            )
        )
        lst
    )
)
;; 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 (wcmatch (getenv "PROCESSOR_ARCHITECTURE") "*64*")
                (if (vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
                    (list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
                   '(LM:ename->objectid (vlax-vla-object->ename obj))
                )
               '(itoa (vla-get-objectid obj))
            )
        )
    )
    (LM:objectid obj)
)
;; Entity Name to ObjectID  -  Lee Mac
;; Returns the 32-bit or 64-bit ObjectID for a supplied entity name
(defun LM:ename->objectid ( ent )
    (LM:hex->decstr
        (setq ent (vl-string-right-trim ">" (vl-prin1-to-string ent))
              ent (substr ent (+ (vl-string-position 58 ent) 3))
        )
    )
)
;; Hex to Decimal String  -  Lee Mac
;; Returns the decimal representation of a supplied hexadecimal string
(defun LM:hex->decstr ( hex / foo bar )
    (defun foo ( lst rtn )
        (if lst
            (foo (cdr lst) (bar (- (car lst) (if (< 57 (car lst)) 55 48)) rtn))
            (apply 'strcat (mapcar 'itoa (reverse rtn)))
        )
    )
    (defun bar ( int lst )
        (if lst
            (if (or (< 0 (setq int (+ (* 16 (car lst)) int))) (cdr lst))
                (cons (rem int 10) (bar (/ int 10) (cdr lst)))
            )
            (bar int '(0))
        )
    )
    (foo (vl-string->list (strcase hex)) nil)
)
;; 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:: LengthField.lsp | Version 1.0 | \\U+00A9 Lee Mac "
        (menucmd "m=$(edtime,0,yyyy)")
        " www.lee-mac.com ::"
        "\n:: Type "LF" to Invoke ::"
    )
)
(princ)
;;----------------------------------------------------------------------;;
;;                             End of File                              ;;
;;----------------------------------------------------------------------;;

    (setq fmt "%lu6" ;; Field Formatting
          tag nil    ;; Optional predefined attribute tag
    )

    (
        (lambda ( / tmp )
            (if (null lf:inc) (setq lf:inc 1) (setq lf:inc (1+ lf:inc)))
            (if (null lf:unt) (setq lf:unt "Meters"))
            (initget 6)
            (if (setq tmp (getint (strcat "\nSpecify length ID <" (itoa lf:inc) ">: ")))
                (setq lf:inc tmp)
            )
            (initget "Meters Centimeters")
            (if (setq tmp (getkword (strcat "\nSpecify units [Meters/Centimeters] <" lf:unt ">: ")))
                (setq lf:unt tmp)
            )
            (setq fmt (strcat "%lu6%ps[L" (itoa lf:inc) "=," (if (= lf:unt "Meters") "m]%ct8[0.01]" "cm]")))
        )
    )

(defun increment (str / )
(if (= mynumber nil) (setq mynumber 0))
 (setq mynumber (+ mynumber 1))
(princ "\Current Number :<")(princ mynumber)
        (setq askw (getint "> : "))
        (if (/= askw nil)(setq mynumber askw))
        (vl-string-subst (itoa mynumber) "*" str)
)
;;-------------------------=={ Length Field }==-------------------------;;
;;                                                                      ;;
;;  This program allows a user to generate a field expression           ;;
;;  referencing the length/perimeter/circumference of one or more       ;;
;;  selected objects. In the case of selecting multiple objects, the    ;;
;;  field expression will reference the sum of the lengths of all       ;;
;;  objects in the selection.                                           ;;
;;                                                                      ;;
;;  The user may opt to specify a point at which to create a new        ;;
;;  multiline text object housing the field expression, pick a table    ;;
;;  cell in which the field should be inserted, or select an existing   ;;
;;  single-line text, multiline text, multileader, or attribute to      ;;
;;  be populated with the field expression.                             ;;
;;                                                                      ;;
;;  Upon issuing the command syntax 'LF' (Length Field) at the AutoCAD  ;;
;;  command-line, the program first prompts the user to make a          ;;
;;  selection of objects for which to return the length summation.      ;;
;;                                                                      ;;
;;  At this prompt, the user may select any number of Arcs, Circles,    ;;
;;  Lines, 2D Polylines (light or heavy), or 3D Polylines.              ;;
;;                                                                      ;;
;;  The user is then prompted to specify a point or table cell to       ;;
;;  insert a field expression referencing the summation of the lengths  ;;
;;  of the selected objects.                                            ;;
;;                                                                      ;;
;;  At this prompt, the user may also choose the 'Object' option in     ;;
;;  order to populate the content of an existing annotation object      ;;
;;  with the field expression.                                          ;;
;;                                                                      ;;
;;  Upon choosing this option, the user may select any single-line      ;;
;;  text (DText), multiline text (MText), single-line or multiline      ;;
;;  attribute, attributed block, or multileader (MLeader) with either   ;;
;;  multiline text or attributed block content.                         ;;
;;                                                                      ;;
;;  If the user selects an attributed block or attributed multileader   ;;
;;  with more than one attribute, the user is presented with a dialog   ;;
;;  interface listing the available attributes, and is prompted to      ;;
;;  select a destination for the field expression.                      ;;
;;                                                                      ;;
;;  The user may optionally predefine the target block/multileader      ;;
;;  attribute by specifying the attribute tag where noted at the top    ;;
;;  of the program source code.                                         ;;
;;                                                                      ;;
;;  The resulting field expression will display the sum of the lengths  ;;
;;  of the selected objects, formatted using the field formatting code  ;;
;;  specified at the top of the program.                                ;;
;;                                                                      ;;
;;----------------------------------------------------------------------;;
;;  Author:  Lee Mac, Copyright © 2017  -  www.lee-mac.com              ;;
;;----------------------------------------------------------------------;;
;;  Version 1.0    -    2017-08-06                                      ;;
;;                                                                      ;;
;;  - First release.                                                    ;;
;;----------------------------------------------------------------------;;
;;  Version 1.1    -    2017-08-06                                      ;;
;;                                                                      ;;
;;  - Program modified to account for selection of existing annotation  ;;
;;    objects which already contain a field expression.                 ;;
;;----------------------------------------------------------------------;;
(defun c:lf ( / *error* ent enx flg fmt idx lst obj oid prp sel str tab tag tmp typ )
;if
 (princ "\nEnter an option [Meter/Cm] <Unit>: ")
    (setq fmt "%lu6?") ;; Field Formatting
    (setq 
          fmt (increment fmt)
          tag nil    ;; Optional predefined attribute tag
    )
    
;;************************************************************************;;
(
        (lambda ( / tmp )
            (if (null lf:inc) (setq lf:inc 1) (setq lf:inc (1+ lf:inc)))
            (if (null lf:unt) (setq lf:unt "Meters"))
            (initget 6)
            (if (setq tmp (getint (strcat "\nSpecify length ID <" (itoa lf:inc) ">: ")))
                (setq lf:inc tmp)
            )
            (initget "Meters Centimeters")
            (if (setq tmp (getkword (strcat "\nSpecify units [Meters/Centimeters] <" lf:unt ">: ")))
                (setq lf:unt tmp)
            )
            (setq fmt (strcat "%lu6%ps[L" (itoa lf:inc) "=," (if (= lf:unt "Meters") "m]%ct8[0.01]" "cm]")))
        )
    )
;;***************************************************************************;;
    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )
    (LM:startundo (LM:acdoc))
    (setq prp
       '(
            ("AcDbArc"        . "ArcLength")
            ("AcDbCircle"     . "Circumference")
            ("AcDbLine"       . "Length")
            ("AcDbPolyline"   . "Length")
            ("AcDb2dPolyline" . "Length")
            ("AcDb3dPolyline" . "Length")
        )
    )
    (if
        (setq sel
            (LM:ssget "\nSelect objects to obtain total length <exit>: "
                (list
                    (list
                       '(000 . "ARC,CIRCLE,LINE,*POLYLINE")
                       '(-04 . "<NOT")
                           '(-04 . "<AND")
                               '(000 . "POLYLINE") '(-04 . "&") '(070 . 80)
                           '(-04 . "AND>")
                       '(-04 . "NOT>")
                        (if (= 1 (getvar 'cvport))
                            (cons 410 (getvar 'ctab))
                           '(410 . "Model")
                        )
                    )
                )
            )
        )
        (progn
            (if (= 1 (sslength sel))
                (setq obj (vlax-ename->vla-object (ssname sel 0))
                      str 
                    (strcat
                        "%<\\AcObjProp Object(%<\\_ObjId "
                        (LM:objectid obj)
                        ">%)." (cdr (assoc (vla-get-objectname obj) prp)) " \\f "" fmt "">%"
                    )
                )
                (progn
                    (repeat (setq idx (sslength sel))
                        (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx))))
                              lst
                            (vl-list*
                                "%<\\AcObjProp Object(%<\\_ObjId "
                                (LM:objectid obj)
                                ">%)." (cdr (assoc (vla-get-objectname obj) prp)) ">%" " + "
                                lst
                            )
                        )
                    )
                    (setq str
                        (strcat
                            "%<\\AcExpr "
                            (apply 'strcat (reverse (cdr (reverse lst))))
                            " \\f "" fmt "">%"
                        )
                    )
                )
            )
            (if
                (setq tmp
                    (ssget "_X"
                        (list '(0 . "ACAD_TABLE")
                            (if (= 1 (getvar 'cvport))
                                (cons 410 (getvar 'ctab))
                               '(410 . "Model")
                            )
                        )
                    )
                )
                (repeat (setq idx (sslength tmp))
                    (setq tab (cons (vlax-ename->vla-object (ssname tmp (setq idx (1- idx)))) tab))
                )
            )
            (while
                (not
                    (progn
                        (if flg
                            (progn
                                (setvar 'errno 0)
                                (initget "Point eXit")
                                (setq sel (nentsel "\nSelect text, mtext, mleader, attribute or attributed block [Point/eXit] <eXit>: "))
                            )
                            (progn
                                (initget "Object eXit")
                                (setq sel (getpoint "\nSpecify point or cell for field [Object/eXit] <eXit>: "))
                            )
                        )
                        (cond
                            (   (= 7 (getvar 'errno))
                                (prompt "\nMissed, try again.")
                            )
                            (   (or (null sel) (= "eXit" sel)))
                            (   (= "Point" sel)
                                (setq flg nil)
                            )
                            (   (= "Object" sel)
                                (not (setq flg t))
                            )
                            (   flg
                                (setq ent (car sel)
                                      enx (entget ent)
                                      typ (cdr (assoc 0 enx))
                                      obj (vlax-ename->vla-object ent)
                                )
                                (cond
                                    (   (and (= 2 (length sel)) (wcmatch typ "TEXT,MTEXT"))
                                        (if (vlax-write-enabled-p obj)
                                            (LF:puttextstring obj str)
                                            (prompt "\nThe selected text object is on a locked layer.")
                                        )
                                    )
                                    (   (and (= "ATTRIB" typ)
                                             (/= 'str (type tag))
                                        )
                                        (if (vlax-write-enabled-p obj)
                                            (progn
                                                (LF:puttextstring obj str)
                                                (LF:updatefield ent)
                                            )
                                            (prompt "\nThe selected attribute is on a locked layer.")
                                        )
                                    )
                                    (   (and
                                            (or
                                                (and (= "ATTRIB" typ)
                                                     (setq tmp (cdr (assoc 330 enx)))
                                                )
                                                (and (setq tmp (last (cadddr sel)))
                                                     (= "INSERT" (cdr (assoc 0 (entget tmp))))
                                                )
                                            )
                                            (setq tmp (vlax-invoke (vlax-ename->vla-object tmp) 'getattributes))
                                            (or
                                                (and (= 'str (type tag))
                                                     (setq idx (vl-position (strcase tag) (mapcar 'vla-get-tagstring tmp)))
                                                     (setq obj (nth idx tmp))
                                                )
                                                (and (not (cdr tmp))
                                                     (setq obj (car tmp))
                                                )
                                                (and (setq idx (LM:listbox "Choose Attribute" (mapcar 'vla-get-tagstring tmp) 2))
                                                     (setq obj (nth (car idx) tmp))
                                                )
                                            )
                                        )
                                        (if (vlax-write-enabled-p obj)
                                            (progn
                                                (LF:puttextstring obj str)
                                                (LF:updatefield (vlax-vla-object->ename obj))
                                            )
                                            (prompt "\nThe selected attribute is on a locked layer.")
                                        )
                                    )
                                    (   (and (= 2 (length sel)) (= "MULTILEADER" typ))
                                        (setq typ (cdr (assoc 172 (reverse enx))))
                                        (cond
                                            (   (and (<= acblockcontent typ acmtextcontent) (not (vlax-write-enabled-p obj)))
                                                (prompt "\nThe selected multileader is on a locked layer.")
                                            )
                                            (   (= acmtextcontent typ)
                                                (LF:puttextstring obj str)
                                                (vla-regen (LM:acdoc) acactiveviewport)
                                                t
                                            )
                                            (   (and
                                                    (= acblockcontent typ)
                                                    (setq tmp (LM:getmleaderattributes obj))
                                                    (or
                                                        (and (= 'str (type tag))
                                                             (setq oid (cdr (assoc (strcase tag) tmp)))
                                                        )
                                                        (and (not (cdr tmp))
                                                             (setq oid (cdar tmp))
                                                        )
                                                        (and (setq idx (LM:listbox "Choose Attribute" (mapcar 'car tmp) 2))
                                                             (setq oid (cdr (nth (car idx) tmp)))
                                                        )
                                                    )
                                                )
                                                (LM:setmleaderattributevalue obj oid str)
                                                (vla-regen (LM:acdoc) acactiveviewport)
                                                t
                                            )
                                            (   (prompt "\nThe select multileader has no editable content."))
                                        )
                                    )
                                    (   (prompt "\nThe selected object is not text, mtext, multileader, attribute or attributed block."))
                                )
                            )
                            (   (setq tmp (LM:getcell tab (trans sel 1 0)))
                                (if (vlax-write-enabled-p (car tmp))
                                    (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-settext (append tmp (list str)))))
                                    (prompt "\nThe selected table cell belongs to a table on a locked layer.")
                                )
                            )
                            (   (vla-addmtext
                                    (vlax-get-property (LM:acdoc) (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
                                    (vlax-3D-point (trans sel 1 0))
                                    0.0
                                    str
                                )
                            )
                        )
                    )
                )
            )
        )
    )
    (*error* nil) (princ)
)
(defun LF:puttextstring ( obj str )
    (vla-put-textstring obj "") ;; To clear any existing field
    (vla-put-textstring obj str)
    t
)
(defun LF:updatefield ( ent / cmd rtn )
    (setq cmd (getvar 'cmdecho))
    (setvar 'cmdecho 0)
    (setq rtn (vl-cmdf "_.updatefield" ent ""))
    (setvar 'cmdecho cmd)
    rtn
)
;; ssget  -  Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - [str] selection prompt
;; arg - [lst] list of ssget arguments
(defun LM:ssget ( msg arg / sel )
    (princ msg)
    (setvar 'nomutt 1)
    (setq sel (vl-catch-all-apply 'ssget arg))
    (setvar 'nomutt 0)
    (if (not (vl-catch-all-error-p sel)) sel)
)
;; Get MLeader Attributes  -  Lee Mac
;; Returns an association list of attribute tags & object IDs for all attributes held by an mleader block
;; mld - [vla] MLeader vla-object
;; Returns: [lst] List of ((<Attribute Tag> . <Object ID>) ... )
(defun LM:getmleaderattributes ( mld / rtn )
    (vlax-for obj (vla-item (vla-get-blocks (vla-get-document mld)) (vla-get-contentblockname mld))
        (if
            (and
                (= "AcDbAttributeDefinition" (vla-get-objectname obj))
                (= :vlax-false (vla-get-constant obj))
            )
            (setq rtn (cons (cons (strcase (vla-get-tagstring obj)) (LM:intobjectid obj)) rtn))
        )
    )
    (reverse rtn)
)
;; Object ID (integer)  -  Lee Mac
;; Returns an integer representing the ObjectID of a supplied VLA-Object
;; Compatible with 32-bit & 64-bit systems
(defun LM:intobjectid ( obj )
    (if (vlax-property-available-p obj 'objectid32)
        (defun LM:intobjectid ( obj ) (vla-get-objectid32 obj))
        (defun LM:intobjectid ( obj ) (vla-get-objectid   obj))
    )
    (LM:intobjectid obj)
)
;; Set MLeader Attribute Value  -  Lee Mac
;; obj - [vla] MLeader vla-object
;; idx - [int] Attribute Definition Object ID
;; str - [str] Attribute value
(defun LM:setmleaderattributevalue ( obj idx str )
    (if (vlax-method-applicable-p obj 'setblockattributevalue32)
        (defun LM:setmleaderattributevalue ( obj idx str ) (vla-setblockattributevalue32 obj idx str))
        (defun LM:setmleaderattributevalue ( obj idx str ) (vla-setblockattributevalue   obj idx str))
    )
    (LM:setmleaderattributevalue obj idx str)
)
;; List Box  -  Lee Mac
;; Displays a DCL list box allowing the user to make a selection from the supplied data.
;; msg - [str] Dialog label
;; lst - [lst] List of strings to display
;; bit - [int] 1=allow multiple; 2=return indexes
;; Returns: [lst] List of selected items/indexes, else nil
 
(defun LM:listbox ( msg lst bit / dch des tmp rtn )
    (cond
        (   (not
                (and
                    (setq tmp (vl-filename-mktemp nil nil ".dcl"))
                    (setq des (open tmp "w"))
                    (write-line
                        (strcat "listbox:dialog{label="" msg "";spacer;:list_box{key="list";multiple_select="
                            (if (= 1 (logand 1 bit)) "true" "false") ";width=50;height=15;}spacer;ok_cancel;}"
                        )
                        des
                    )
                    (not (close des))
                    (< 0 (setq dch (load_dialog tmp)))
                    (new_dialog "listbox" dch)
                )
            )
            (prompt "\nError Loading List Box Dialog.")
        )
        (   t     
            (start_list "list")
            (foreach itm lst (add_list itm))
            (end_list)
            (setq rtn (set_tile "list" "0"))
            (action_tile "list" "(setq rtn $value)")
            (setq rtn
                (if (= 1 (start_dialog))
                    (if (= 2 (logand 2 bit))
                        (read (strcat "(" rtn ")"))
                        (mapcar '(lambda ( x ) (nth x lst)) (read (strcat "(" rtn ")")))
                    )
                )
            )
        )
    )
    (if (< 0 dch)
        (unload_dialog dch)
    )
    (if (and tmp (setq tmp (findfile tmp)))
        (vl-file-delete tmp)
    )
    rtn
)
;; Get Cell  -  Lee Mac
;; If the supplied point lies within a cell boundary,
;; returns a list of: (<VLA Table Object> <Row> <Col>)
 
(defun LM:getcell ( lst pnt / dir )
    (setq dir (vlax-3D-point (trans (getvar 'viewdir) 1 0))
          pnt (vlax-3D-point pnt)
    )
    (vl-some
       '(lambda ( tab / row col )
            (if (= :vlax-true (vla-hittest tab pnt dir 'row 'col))
                (list tab row col)
            )
        )
        lst
    )
)
;; 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 (wcmatch (getenv "PROCESSOR_ARCHITECTURE") "*64*")
                (if (vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
                    (list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
                   '(LM:ename->objectid (vlax-vla-object->ename obj))
                )
               '(itoa (vla-get-objectid obj))
            )
        )
    )
    (LM:objectid obj)
)
;; Entity Name to ObjectID  -  Lee Mac
;; Returns the 32-bit or 64-bit ObjectID for a supplied entity name
(defun LM:ename->objectid ( ent )
    (LM:hex->decstr
        (setq ent (vl-string-right-trim ">" (vl-prin1-to-string ent))
              ent (substr ent (+ (vl-string-position 58 ent) 3))
        )
    )
)
;; Hex to Decimal String  -  Lee Mac
;; Returns the decimal representation of a supplied hexadecimal string
(defun LM:hex->decstr ( hex / foo bar )
    (defun foo ( lst rtn )
        (if lst
            (foo (cdr lst) (bar (- (car lst) (if (< 57 (car lst)) 55 48)) rtn))
            (apply 'strcat (mapcar 'itoa (reverse rtn)))
        )
    )
    (defun bar ( int lst )
        (if lst
            (if (or (< 0 (setq int (+ (* 16 (car lst)) int))) (cdr lst))
                (cons (rem int 10) (bar (/ int 10) (cdr lst)))
            )
            (bar int '(0))
        )
    )
    (foo (vl-string->list (strcase hex)) nil)
)
;; 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:: LengthField.lsp | Version 1.0 | \\U+00A9 Lee Mac "
        (menucmd "m=$(edtime,0,yyyy)")
        " www.lee-mac.com ::"
        "\n:: Type "LF" to Invoke ::"
    )
)
(princ)
;;----------------------------------------------------------------------;;
;;                             End of File                              ;;
;;----------------------------------------------------------------------;;