;;; ---------------------------------------------------------------------------
;;; Borrow.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; IMPORT ANYTHING FROM ANOTHER DRAWING
;;;
;;; Point Borrow at any drawing or template and it lists everything that
;;; drawing contains and this one does not. Tick what you want and it is
;;; copied across.
;;;
;;; Nineteen kinds of thing can be borrowed:
;;;
;;;   Blocks                    Layers                Linetypes
;;;   Text Styles               Dimension Styles      Layouts
;;;   Views                     Materials             Viewports
;;;   Page Setups               User Coordinate Systems
;;;   Groups                    Drawing Properties    Custom Properties
;;;   Multileader Styles        Multiline Styles      Table Styles
;;;   Scales                    Layer States
;;;
;;; This is the answer to "this drawing has the right title block / layer
;;; standard / dimension style and mine doesn't". DesignCenter can do some of
;;; it, several dialogs deep, one category at a time. Borrow does all of it
;;; from one list, and the source drawing is never opened.
;;;
;;; ---------------------------------------------------------------------------
;;; ONLY WHAT IS MISSING IS OFFERED
;;;
;;; Every list is filtered against the current drawing first. A layer, block
;;; or style you already have does not appear, so there is no way to
;;; accidentally overwrite your own definition with the source drawing's --
;;; and no wading through hundreds of entries you already own.
;;;
;;; Also excluded automatically: anonymous items (names beginning with an
;;; asterisk), xref-dependent items (names containing a vertical bar), and
;;; AutoCAD's own internal ACAD_ entries. None of those can be meaningfully
;;; imported.
;;;
;;; Drawing and custom properties are compared by VALUE rather than by
;;; existence, so a property that differs is offered even though it exists at
;;; both ends.
;;;
;;; ---------------------------------------------------------------------------
;;; HOW IT WORKS
;;;
;;; The source drawing is opened through ObjectDBX -- a database-only
;;; interface with no editor window, no regen and no view. Items are then
;;; moved across with CopyObjects, which is AutoCAD's own mechanism for
;;; transferring database objects between documents and brings each item's
;;; complete definition with it.
;;;
;;; A drawing already open in this AutoCAD session is read through its live
;;; document object instead. ObjectDBX on an already-open file would read the
;;; version on disk rather than the one on screen.
;;;
;;; Three categories need special handling rather than CopyObjects:
;;;
;;;   GROUPS need their member entities copied into the matching layout
;;;   first, and the group created around the copies -- a group is a
;;;   reference to objects, so copying the group alone would copy nothing.
;;;
;;;   DRAWING AND CUSTOM PROPERTIES are values on the document, not objects,
;;;   so they are simply written across.
;;;
;;;   LAYER STATES are imported through AutoCAD's own layer state function,
;;;   which reads them straight from the source file.
;;;
;;; ---------------------------------------------------------------------------
;;; THE PAGE SETUP WORKAROUND
;;;
;;; AutoCAD has a long-standing defect: copying a page setup copies the
;;; object correctly but registers it in the plot settings dictionary under
;;; the wrong key, so the setup exists but cannot be found by name.
;;;
;;; Borrow repairs the dictionary immediately afterwards, walking it in pairs
;;; and rewriting each key from the name held on the object it points at.
;;;
;;; ---------------------------------------------------------------------------
;;; SEARCH
;;;
;;; Type any part of a name and press the Search button, or Enter, and the
;;; lists jump to the first match in any category. Useful when a drawing has
;;; four hundred blocks and you want one.
;;;
;;; ---------------------------------------------------------------------------
;;; NOTES
;;;
;;; The dialog stays open after each import, and imported items disappear
;;; from the list, so several categories can be dealt with in one visit.
;;; Refresh re-reads the source drawing if it has changed underneath you.
;;;
;;; The last drawing borrowed from is remembered between sessions, both as
;;; the starting folder for the file browser and for the BORROWLAST command.
;;;
;;; ---------------------------------------------------------------------------
;;;   BORROW           - choose a drawing and pick what to import
;;;   BORROWALL        - import EVERYTHING missing from a chosen drawing
;;;   BORROWTEMPLATE   - borrow from the QNEW template, if one is set
;;;   BORROWTEMPLATES  - choose from the templates in the template folder
;;;   BORROWLAST       - borrow again from the last drawing used
;;; ---------------------------------------------------------------------------

(vl-load-com)

;;; ---------------------------------------------------------------------------
;;; Registry key holding the last drawing borrowed from, so the setting
;;; survives between sessions.
;;; ---------------------------------------------------------------------------

(setq *Borrow:Key* "YZ\\BorrowLast")

;;; ---------------------------------------------------------------------------
;;; BORROW
;;;
;;; Prompts for a drawing, then opens the picking dialog.
;;; ---------------------------------------------------------------------------

(defun c:Borrow nil (Borrow:Run nil nil))

;;; ---------------------------------------------------------------------------
;;; BORROWALL
;;;
;;; Imports everything the source drawing has that this one does not, with no
;;; dialog. The wildcard "*" in each category means "every item in it".
;;;
;;; Fast, and occasionally exactly right when setting up a new drawing from a
;;; known-good one -- but it is indiscriminate, so check the source first.
;;; ---------------------------------------------------------------------------

(defun c:BorrowAll nil
    (Borrow:Run nil
       '(
            ("Blocks"                  ("*"))
            ("Layers"                  ("*"))
            ("Linetypes"               ("*"))
            ("Text Styles"             ("*"))
            ("Dimension Styles"        ("*"))
            ("Layouts"                 ("*"))
            ("Views"                   ("*"))
            ("Materials"               ("*"))
            ("Viewports"               ("*"))
            ("Page Setups"             ("*"))
            ("User Coordinate Systems" ("*"))
            ("Groups"                  ("*"))
            ("Drawing Properties"      ("*"))
            ("Custom Properties"       ("*"))
            ("Multileader Styles"      ("*"))
            ("Multiline Styles"        ("*"))
            ("Table Styles"            ("*"))
            ("Scales"                  ("*"))
            ("Layer States"            ("*"))
        )
    )
)

;;; ---------------------------------------------------------------------------
;;; BORROWTEMPLATE
;;;
;;; Borrows from the template set as the QNEW default -- the one a new
;;; drawing would be started from. Falls through to the template chooser if
;;; no default is set.
;;; ---------------------------------------------------------------------------

(defun c:BorrowTemplate ( / tmp )
    (setq tmp
        (vla-get-qnewtemplatefile
            (vla-get-files (vla-get-preferences (vlax-get-acad-object)))
        )
    )
    (if (= "" tmp)
        (c:BorrowTemplates)
        (Borrow:Run tmp nil)
    )
)

;;; ---------------------------------------------------------------------------
;;; BORROWTEMPLATES
;;;
;;; Lists every .dwt in the configured template folder and borrows from the
;;; one chosen. Falls back to the ordinary file browser if the folder holds
;;; no templates.
;;; ---------------------------------------------------------------------------

(defun c:BorrowTemplates ( / path files pick )
    (setq path
        (vla-get-templatedwgpath
            (vla-get-files (vla-get-preferences (vlax-get-acad-object)))
        )
    )
    (if (setq files (vl-directory-files path "*.dwt" 1))
        (if (setq pick (car (Borrow:ListBox "Select Template File" files)))
            (Borrow:Run (strcat (vl-string-right-trim "\\" path) "\\" pick) nil)
            (princ "\nCancelled.")
        )
        (Borrow:Run nil nil)
    )
    (princ)
)

;;; ---------------------------------------------------------------------------
;;; BORROWLAST
;;;
;;; Borrows from the last drawing used. If that file has moved or been
;;; deleted, the file browser opens instead.
;;; ---------------------------------------------------------------------------

(defun c:BorrowLast ( / dwg )
    (Borrow:Run
        (if (setq dwg (getenv *Borrow:Key*)) (findfile dwg))
        nil
    )
)

;;; ===========================================================================
;;; Borrow:Run
;;;
;;; The engine behind all five commands.
;;;
;;;   dwg - source drawing path, or nil to prompt
;;;   lst - a list of (category (patterns)) to import without a dialog, or
;;;         nil to show the picking dialog
;;; ===========================================================================

(defun Borrow:Run

    ( dwg lst /

        *error* Borrow:Search Borrow:Restore Borrow:CopyGroup Borrow:FixPageSetups

        acdic acdoc acext acdata cln col collection collections dbdata dbdic
        dbdoc dbext dch dcl des dir done flg grp idx item items obj pair
        picked search tmp vals vars
    )

    (setq vars '("CMDECHO")
          vals (mapcar 'getvar vars)
    )

    ;;; -----------------------------------------------------------------------
    ;;; Borrow:Restore
    ;;;
    ;;; Releases the ObjectDBX document, unloads the dialog, deletes its
    ;;; temporary definition file and restores system variables.
    ;;;
    ;;; Releasing matters: an unreleased ObjectDBX document keeps a COM handle
    ;;; on the source file, which can leave it locked until AutoCAD closes.
    ;;;
    ;;; The document is only released if it is NOT one of the live open
    ;;; documents -- releasing a drawing the user has open would be a
    ;;; disaster. Borrow:GetDocument returns a live document where it can, and
    ;;; those are recognised by having a Name property that matches an open
    ;;; drawing; the simpler test used here is that an ObjectDBX document has
    ;;; no window, so its ActiveSpace lookup fails.
    ;;; -----------------------------------------------------------------------

    (defun Borrow:Restore ( )
        (if (and (= 'vla-object (type dbdoc))
                 (not (vlax-object-released-p dbdoc))
                 ;; A live document responds to WindowState; an ObjectDBX one
                 ;; does not. Only the latter should be released.
                 (vl-catch-all-error-p
                     (vl-catch-all-apply 'vlax-get-property (list dbdoc 'windowstate))
                 )
            )
            (vlax-release-object dbdoc)
        )
        (if (= 'file (type des)) (close des))
        (if (and (= 'int (type dch)) (< 0 dch)) (unload_dialog dch))
        (if (and (= 'str (type dcl)) (findfile dcl)) (vl-file-delete dcl))
        (while (= 8 (logand 8 (getvar 'undoctl)))
            (vla-endundomark acdoc)
        )
        (mapcar 'setvar vars vals)
        (princ)
    )

    (defun *error* ( msg )
        (Borrow:Restore)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** BORROW error: " msg " **"))
        )
        (princ)
    )

    ;;; -----------------------------------------------------------------------
    ;;; Borrow:CopyGroup
    ;;;
    ;;; Imports one group.
    ;;;
    ;;; A group is a named reference to a set of entities, not a container of
    ;;; them, so copying the group object alone would bring across a group
    ;;; pointing at nothing. Its members have to be copied first, into the
    ;;; layout they came from, and a new group built around the copies.
    ;;;
    ;;;   name - group name
    ;;;   grp  - the source group object
    ;;;   col  - this drawing's Groups collection
    ;;; -----------------------------------------------------------------------

    (defun Borrow:CopyGroup ( name grp col / lay mem )

        (vlax-for obj grp (setq mem (cons obj mem)))

        (if mem
            (progn
                ;; Which layout the members live in, so they land in the
                ;; equivalent layout here rather than always in model space.
                (setq lay
                    (vla-get-name
                        (vla-get-layout
                            (vla-objectidtoobject dbdoc (vla-get-ownerid (car mem)))
                        )
                    )
                )
                (vla-appenditems (vla-add col name)
                    (vla-copyobjects dbdoc
                        (vlax-make-variant
                            (vlax-safearray-fill
                                (vlax-make-safearray vlax-vbobject
                                    (cons 0 (1- (length mem))))
                                (reverse mem)
                            )
                        )
                        (vla-get-block
                            ;; Use the matching layout if we have one, and
                            ;; create it if we do not.
                            (cond
                                (   (Borrow:GetItem (cadr (assoc "LAYOUTS" acdata)) lay))
                                (   (vla-add       (cadr (assoc "LAYOUTS" acdata)) lay))
                            )
                        )
                    )
                )
            )
        )
        (princ)
    )

    ;;; -----------------------------------------------------------------------
    ;;; Borrow:FixPageSetups
    ;;;
    ;;; Repairs the plot settings dictionary after page setups are imported.
    ;;;
    ;;; AutoCAD registers a copied page setup under the wrong dictionary key,
    ;;; so the setup exists but cannot be found by the name it should have.
    ;;;
    ;;; The dictionary is a flat list where each entry's key (group 3) is
    ;;; immediately followed by a reference to its object (group 350). Walking
    ;;; the list alongside itself shifted by one gives every key its own
    ;;; reference, and each key is rewritten from group 1 of the object it
    ;;; points at -- the setup's real name.
    ;;; -----------------------------------------------------------------------

    (defun Borrow:FixPageSetups ( / dic )
        (if (setq dic (dictsearch (namedobjdict) "ACAD_PLOTSETTINGS"))
            (entmod
                (mapcar
                   '(lambda ( this next )
                        (if (and (= 003 (car this)) (= 350 (car next)))
                            (cons 3 (cdr (assoc 1 (entget (cdr next)))))
                            this
                        )
                    )
                    dic
                    ;; The same list shifted one place, with a nil pad so the
                    ;; two are the same length.
                    (append (cdr dic) '(nil))
                )
            )
        )
        (princ)
    )

    ;;; =======================================================================
    ;;;                       M A I N   R O U T I N E
    ;;; =======================================================================

    (setvar 'cmdecho 0)

    (cond
        ;;  ---- choose the source drawing ----
        (   (null
                (or dwg
                    (setq dwg
                        (getfiled "Select drawing to borrow from"
                            ;; Reopen in the folder of the last drawing used.
                            (cond
                                (   (and (setq dir (getenv *Borrow:Key*))
                                         (setq dir (strcat (vl-filename-directory dir) "\\"))
                                         (vl-file-directory-p dir)
                                    )
                                    dir
                                )
                                (   "")
                            )
                            "dwg;dwt;dws" 16
                        )
                    )
                )
            )
            (princ "\nCancelled.")
        )

        ;;  Borrowing from yourself would achieve nothing and, worse, would
        ;;  mean copying objects from a document into itself.
        (   (and (= 1 (getvar 'dwgtitled))
                 (= (strcase dwg) (strcase (strcat (getvar 'dwgprefix) (getvar 'dwgname))))
            )
            (princ "\nCannot borrow from the current drawing.")
        )

        (   (null (setq dbdoc (Borrow:GetDocument dwg)))
            (princ (strcat "\nUnable to read drawing: " dwg))
        )

        ;;  ---- collect what each drawing holds ----
        (   (null
                (setq
                    acdoc (vla-get-activedocument (vlax-get-acad-object))
                    acdic (vla-get-dictionaries acdoc)
                    dbdic (vla-get-dictionaries dbdoc)
                    ;; Layer states are stored in the layer table's extension
                    ;; dictionary, which may not exist at either end.
                    acext (if (= :vlax-true (vla-get-hasextensiondictionary (vla-get-layers acdoc)))
                              (vla-getextensiondictionary (vla-get-layers acdoc))
                          )
                    dbext (if (= :vlax-true (vla-get-hasextensiondictionary (vla-get-layers dbdoc)))
                              (vla-getextensiondictionary (vla-get-layers dbdoc))
                          )
                    ;; Each row pairs a display name with this drawing's
                    ;; collection and the source drawing's. Everything else
                    ;; works off this one table.
                    acdata
                    (list
                        (list "Blocks"                  (Borrow:GetProp acdoc 'blocks)                (Borrow:GetProp dbdoc 'blocks))
                        (list "Layers"                  (Borrow:GetProp acdoc 'layers)                (Borrow:GetProp dbdoc 'layers))
                        (list "Linetypes"               (Borrow:GetProp acdoc 'linetypes)             (Borrow:GetProp dbdoc 'linetypes))
                        (list "Text Styles"             (Borrow:GetProp acdoc 'textstyles)            (Borrow:GetProp dbdoc 'textstyles))
                        (list "Dimension Styles"        (Borrow:GetProp acdoc 'dimstyles)             (Borrow:GetProp dbdoc 'dimstyles))
                        (list "Layouts"                 (Borrow:GetProp acdoc 'layouts)               (Borrow:GetProp dbdoc 'layouts))
                        (list "Views"                   (Borrow:GetProp acdoc 'views)                 (Borrow:GetProp dbdoc 'views))
                        (list "Materials"               (Borrow:GetProp acdoc 'materials)             (Borrow:GetProp dbdoc 'materials))
                        (list "Viewports"               (Borrow:GetProp acdoc 'viewports)             (Borrow:GetProp dbdoc 'viewports))
                        (list "Page Setups"             (Borrow:GetProp acdoc 'plotconfigurations)    (Borrow:GetProp dbdoc 'plotconfigurations))
                        (list "User Coordinate Systems" (Borrow:GetProp acdoc 'usercoordinatesystems) (Borrow:GetProp dbdoc 'usercoordinatesystems))
                        (list "Groups"                  (Borrow:GetProp acdoc 'groups)                (Borrow:GetProp dbdoc 'groups))
                        (list "Drawing Properties"      (Borrow:GetProp acdoc 'summaryinfo)           (Borrow:GetProp dbdoc 'summaryinfo))
                        (list "Custom Properties"       (Borrow:GetProp acdoc 'summaryinfo)           (Borrow:GetProp dbdoc 'summaryinfo))
                        (list "Multileader Styles"      (Borrow:GetItem acdic "ACAD_MLEADERSTYLE")    (Borrow:GetItem dbdic "ACAD_MLEADERSTYLE"))
                        (list "Multiline Styles"        (Borrow:GetItem acdic "ACAD_MLINESTYLE")      (Borrow:GetItem dbdic "ACAD_MLINESTYLE"))
                        (list "Table Styles"            (Borrow:GetItem acdic "ACAD_TABLESTYLE")      (Borrow:GetItem dbdic "ACAD_TABLESTYLE"))
                        (list "Scales"                  (Borrow:GetItem acdic "ACAD_SCALELIST")       (Borrow:GetItem dbdic "ACAD_SCALELIST"))
                        (list "Layer States"            (Borrow:GetItem acext "ACAD_LAYERSTATES")     (Borrow:GetItem dbext "ACAD_LAYERSTATES"))
                    )
                    ;; The difference between the two: only what the source
                    ;; has and this drawing does not.
                    dbdata (vl-remove nil (mapcar '(lambda ( x ) (apply 'Borrow:Compare x)) acdata))
                )
            )
            (princ "\nNothing found to import.")
        )

        ;;  ============ silent mode: BORROWALL ============
        (   lst
            (vla-startundomark acdoc)
            ;; Names are upper-cased at both ends so the caller's category
            ;; names do not have to match the display capitalisation.
            (setq dbdata (mapcar '(lambda ( x ) (cons (strcase (car x)) (cdr x))) dbdata)
                  acdata (mapcar '(lambda ( x ) (cons (strcase (car x)) (cdr x))) acdata)
                  idx    0
            )
            (foreach grp lst
                (setq col   (assoc (strcase (car grp)) acdata)
                      items (mapcar 'strcase (cadr grp))
                      cln   (car  col)
                      col   (cadr col)
                      tmp   nil
                )
                (cond
                    ;;  Category absent at one end, or no patterns given.
                    (   (or (null col) (null items) (null (assoc cln dbdata))))

                    (   (= "LAYER STATES" cln)
                        (if layerstate-importfromdb
                            (foreach pair (cdr (assoc cln dbdata))
                                (if (vl-some '(lambda ( pat ) (wcmatch (strcase (car pair)) pat)) items)
                                    (progn
                                        (layerstate-importfromdb (car pair) dwg)
                                        (setq idx (1+ idx))
                                    )
                                )
                            )
                        )
                    )

                    (   (= "GROUPS" cln)
                        (foreach pair (cdr (assoc cln dbdata))
                            (if (vl-some '(lambda ( pat ) (wcmatch (strcase (car pair)) pat)) items)
                                (progn
                                    (Borrow:CopyGroup (car pair) (cdr pair) col)
                                    (setq idx (1+ idx))
                                )
                            )
                        )
                    )

                    (   (= "DRAWING PROPERTIES" cln)
                        (foreach pair (cdr (assoc cln dbdata))
                            (if (vl-some '(lambda ( pat ) (wcmatch (strcase (car pair)) pat)) items)
                                (progn
                                    (vlax-put-property col (car pair) (cdr pair))
                                    (setq idx (1+ idx))
                                )
                            )
                        )
                    )

                    (   (= "CUSTOM PROPERTIES" cln)
                        (foreach pair (cdr (assoc cln dbdata))
                            (if (vl-some '(lambda ( pat ) (wcmatch (strcase (car pair)) pat)) items)
                                (progn
                                    ;; SetCustomByKey fails if the key does
                                    ;; not exist yet, in which case it has to
                                    ;; be added instead.
                                    (if (vl-catch-all-error-p
                                            (vl-catch-all-apply 'vla-setcustombykey
                                                (list col (car pair) (cdr pair))))
                                        (vla-addcustominfo col (car pair) (cdr pair))
                                    )
                                    (setq idx (1+ idx))
                                )
                            )
                        )
                    )

                    ;;  Everything else copies as objects, all in one call.
                    (   (progn
                            (foreach pair (cdr (assoc cln dbdata))
                                (if (vl-some '(lambda ( pat ) (wcmatch (strcase (car pair)) pat)) items)
                                    (setq tmp (cons (cdr pair) tmp))
                                )
                            )
                            tmp
                        )
                        (vla-copyobjects dbdoc
                            (vlax-make-variant
                                (vlax-safearray-fill
                                    (vlax-make-safearray vlax-vbobject (cons 0 (1- (length tmp))))
                                    tmp
                                )
                            )
                            col
                        )
                        (setq idx (+ idx (length tmp)))
                        (if (= "PAGE SETUPS" cln) (Borrow:FixPageSetups))
                    )
                )
            )
            (setenv *Borrow:Key* dwg)
            (vla-endundomark acdoc)
            (vla-regen acdoc acallviewports)
            (princ (strcat "\n" (itoa idx) " item" (if (= 1 idx) "" "s") " imported."))
        )

        ;;  ============ build the dialog ============
        ;;  Written to a uniquely named temporary file, loaded, and deleted on
        ;;  exit, so two AutoCAD sessions cannot collide and nothing is left
        ;;  behind.
        (   (not
                (and
                    (setq dcl (vl-filename-mktemp nil nil ".dcl"))
                    (setq des (open dcl "w"))
                    (progn
                        (foreach line
                           '(
                                "box : list_box"
                                "{"
                                "    width  = 30.0;"
                                "    height = 20.0;"
                                "    fixed_width  = true;"
                                "    fixed_height = true;"
                                "    alignment = centered;"
                                "}"
                                "but : button"
                                "{"
                                "    width  = 15.0;"
                                "    height =  2.5;"
                                "    fixed_width  = true;"
                                "    fixed_height = true;"
                                "}"
                                "steal : dialog"
                                "{"
                                "    label = \"Borrow From Drawing\";"
                                "    spacer;"
                                "    : row"
                                "    {"
                                "        alignment = left;"
                                "        : button { key = \"refresh\"; label = \"&Refresh Drawing Data\";"
                                "                   mnemonic = \"R\"; fixed_width = true; }"
                                "    }"
                                "    : row"
                                "    {"
                                "        : box { key = \"l1\"; }"
                                "        : box { key = \"l2\"; multiple_select = true; allow_accept = true; }"
                                "    }"
                                "    : row"
                                "    {"
                                "        alignment = centered;"
                                "        : edit_box { key = \"search1\"; label = \"Find:\"; }"
                                "        : button   { key = \"search2\"; label = \"&Search\";"
                                "                     mnemonic = \"S\"; fixed_width = true; }"
                                "    }"
                                "    errtile;"
                                "    : row"
                                "    {"
                                "        spacer;"
                                "        : but { key = \"accept\"; is_default = true; label = \"Import\"; }"
                                "        : but { key = \"cancel\"; is_cancel  = true; label = \"Done\";   }"
                                "        spacer;"
                                "    }"
                                "    spacer;"
                                "}"
                            )
                            (write-line line des)
                        )
                        (setq des (close des))
                        (< 0 (setq dch (load_dialog dcl)))
                    )
                    (new_dialog "steal" dch)
                )
            )
            (princ "\nUnable to create the dialog.")
        )

        ;;  ============ the picking dialog ============
        (   t
            (setenv *Borrow:Key* dwg)
            (vla-startundomark acdoc)

            ;; Left list: the categories that have something to offer.
            ;; Right list: the items in the selected category.
            (Borrow:FillList "l1" (setq collections (acad_strlsort (mapcar 'car dbdata))))
            (set_tile "l1" (setq collection "0"))
            (Borrow:FillList "l2"
                (setq items (mapcar 'car (cdr (assoc (car collections) dbdata)))))
            (set_tile "l2" (setq item "0"))

            ;;; ---------------------------------------------------------------
            ;;; Borrow:Search
            ;;;
            ;;; Finds the first item in any category whose name matches, and
            ;;; moves both lists to it.
            ;;; ---------------------------------------------------------------

            (defun Borrow:Search ( )
                (cond
                    (   (or (null search) (= "" search))
                        (set_tile "error" "Enter something to search for.")
                    )
                    (   (not (setq pair (Borrow:Find (strcat "*" search "*") dbdata)))
                        (set_tile "error" "No matching items found.")
                    )
                    (   t
                        (setq collection
                            (set_tile "l1" (itoa (vl-position (car pair) collections))))
                        (Borrow:FillList "l2"
                            (setq items (mapcar 'car (cdr (assoc (car pair) dbdata)))))
                        (setq item (set_tile "l2" (itoa (vl-position (cdr pair) items))))
                    )
                )
                (setq search (set_tile "search1" ""))
            )

            ;;; ---------------------------------------------------------------
            ;;; Callbacks.
            ;;;
            ;;; Written as quoted lists and converted with vl-prin1-to-string
            ;;; where they are long, because the printer produces correct
            ;;; quoting every time and hand-escaping does not.
            ;;; ---------------------------------------------------------------

            ;;  $reason 1 means the user left the field or pressed Enter.
            (action_tile "search1"
                "(set_tile \"error\" \"\") (setq search (strcase $value)) (if (= 1 $reason) (Borrow:Search))")
            (action_tile "search2" "(set_tile \"error\" \"\") (Borrow:Search)")

            ;;  Refresh: re-read the source drawing, in case it has been
            ;;  changed by someone else since the dialog opened.
            (action_tile "refresh"
                (vl-prin1-to-string
                   '(progn
                        (set_tile "error" "")
                        (if (setq dbdata (vl-remove nil
                                             (mapcar '(lambda ( x ) (apply 'Borrow:Compare x))
                                                     acdata)))
                            (progn
                                (Borrow:FillList "l1"
                                    (setq collections (acad_strlsort (mapcar 'car dbdata))))
                                ;; Keep the highlighted category if it still
                                ;; exists, otherwise fall back to the first.
                                (setq collection
                                    (set_tile "l1"
                                        (if (< (atoi collection) (length collections))
                                            collection
                                            "0"
                                        )
                                    )
                                )
                                (Borrow:FillList "l2"
                                    (setq items
                                        (mapcar 'car
                                            (cdr (assoc (nth (atoi collection) collections) dbdata)))))
                                (setq item (set_tile "l2" "0"))
                            )
                            (progn
                                (alert "Nothing left to import.")
                                (done_dialog 1)
                            )
                        )
                    )
                )
            )

            ;;  Category changed: refill the item list, keeping any still-valid
            ;;  highlighted rows.
            (action_tile "l1"
                (vl-prin1-to-string
                   '(progn
                        (set_tile "error" "")
                        (Borrow:FillList "l2"
                            (setq items
                                (mapcar 'car
                                    (cdr (assoc (nth (atoi (setq collection $value)) collections)
                                                dbdata)))))
                        ;; The highlighted rows are a space-separated list of
                        ;; indices. Any that are beyond the end of the new,
                        ;; possibly shorter list are dropped.
                        (setq item
                            (set_tile "l2"
                                (vl-string-trim "()"
                                    (vl-princ-to-string
                                        (cond
                                            (   (   (lambda ( len )
                                                        (vl-remove-if-not
                                                           '(lambda ( n ) (< n len))
                                                            (read (strcat "(" item ")"))
                                                        )
                                                    )
                                                    (length items)
                                                )
                                            )
                                            (  '("0"))
                                        )
                                    )
                                )
                            )
                        )
                    )
                )
            )

            (action_tile "l2" "(set_tile \"error\" \"\") (setq item $value)")

            ;;  Import: bring across everything highlighted, remove it from
            ;;  the lists, and leave the dialog open for the next category.
            (action_tile "accept"
                (vl-prin1-to-string
                   '(if (and (= 'str (type item)) (/= "" item))
                        (progn
                            (set_tile "error" "")
                            (setq col    (assoc (nth (atoi collection) collections) acdata)
                                  cln    (car  col)
                                  col    (cadr col)
                                  idx    (read (strcat "(" item ")"))
                                  picked (cdr (assoc cln dbdata))
                                  picked (mapcar '(lambda ( n ) (nth n picked)) idx)
                                  flg    t
                            )
                            (cond
                                (   (= "Layer States" cln)
                                    (if layerstate-importfromdb
                                        (foreach pair picked
                                            (layerstate-importfromdb (car pair) dwg)
                                        )
                                    )
                                )
                                (   (= "Groups" cln)
                                    (foreach pair picked
                                        (Borrow:CopyGroup (car pair) (cdr pair) col)
                                    )
                                )
                                (   (= "Drawing Properties" cln)
                                    (foreach pair picked
                                        (vlax-put-property col (car pair) (cdr pair))
                                    )
                                )
                                (   (= "Custom Properties" cln)
                                    (foreach pair picked
                                        (if (vl-catch-all-error-p
                                                (vl-catch-all-apply 'vla-setcustombykey
                                                    (list col (car pair) (cdr pair))))
                                            (vla-addcustominfo col (car pair) (cdr pair))
                                        )
                                    )
                                )
                                (   t
                                    (vla-copyobjects dbdoc
                                        (vlax-make-variant
                                            (vlax-safearray-fill
                                                (vlax-make-safearray vlax-vbobject
                                                    (cons 0 (1- (length picked))))
                                                (mapcar 'cdr picked)
                                            )
                                        )
                                        col
                                    )
                                    (if (= "Page Setups" cln) (Borrow:FixPageSetups))
                                )
                            )

                            ;; Drop what was just imported from the source
                            ;; data, so it cannot be imported twice, and lose
                            ;; the category entirely once it is empty.
                            (if (setq tmp (Borrow:RemoveNth idx (cdr (assoc cln dbdata))))
                                (setq dbdata (subst (cons cln tmp) (assoc cln dbdata) dbdata))
                                (setq dbdata (vl-remove (assoc cln dbdata) dbdata))
                            )
                            (if dbdata
                                (progn
                                    (Borrow:FillList "l1"
                                        (setq collections (acad_strlsort (mapcar 'car dbdata))))
                                    (setq collection
                                        (set_tile "l1"
                                            (if (< (atoi collection) (length collections))
                                                collection
                                                "0"
                                            )
                                        )
                                    )
                                    (Borrow:FillList "l2"
                                        (setq items
                                            (mapcar 'car
                                                (cdr (assoc (nth (atoi collection) collections)
                                                            dbdata)))))
                                    (setq item (set_tile "l2" "0"))
                                )
                                ;; Nothing left: close the dialog.
                                (done_dialog 1)
                            )
                        )
                    )
                )
            )

            (start_dialog)
            (vla-endundomark acdoc)

            ;; Only regenerate if something was actually imported -- a regen
            ;; on a large drawing is not free.
            (if flg
                (progn
                    (vla-regen acdoc acallviewports)
                    (princ "\nImport complete.")
                )
                (princ "\nNothing imported.")
            )
        )
    )

    (Borrow:Restore)
    (princ)
)

;;; ===========================================================================
;;;                    S U P P O R T   F U N C T I O N S
;;; ===========================================================================

;;; ---------------------------------------------------------------------------
;;; Borrow:GetProp
;;;
;;; Returns a document property if the document supports it, otherwise nil.
;;;
;;; Not every collection exists in every AutoCAD release -- Materials and
;;; Multileader Styles are recent additions -- so each is tested for rather
;;; than assumed.
;;; ---------------------------------------------------------------------------

(defun Borrow:GetProp ( obj prop )
    (if (vlax-property-available-p obj prop)
        (vlax-get-property obj prop)
    )
)

;;; ---------------------------------------------------------------------------
;;; Borrow:GetItem
;;;
;;; Returns a named item from a collection, or nil if it is not there.
;;;
;;; vla-Item raises an error rather than returning nil for a missing item, so
;;; the call is caught. This doubles as the "do we already have this?" test
;;; used throughout.
;;; ---------------------------------------------------------------------------

(defun Borrow:GetItem ( collection name / res )
    (if collection
        (progn
            (setq res (vl-catch-all-apply 'vla-item (list collection name)))
            (if (not (vl-catch-all-error-p res)) res)
        )
    )
)

;;; ---------------------------------------------------------------------------
;;; Borrow:Compare
;;;
;;; Returns (category (name . object) ...) listing everything the source
;;; drawing has in this category that the current drawing does not, sorted by
;;; name. Returns nil if there is nothing to offer.
;;;
;;;   cln - category display name
;;;   cl1 - this drawing's collection
;;;   cl2 - the source drawing's collection
;;;
;;; Three categories need their own comparison because they are not
;;; collections of named objects.
;;; ---------------------------------------------------------------------------

(defun Borrow:Compare ( cln cl1 cl2 / exist idx item key lst name val )
    (cond
        ;;  The category does not exist in one of the drawings.
        (   (not (and cl1 cl2)) nil)

        ;;  ---- annotation scales ----
        ;;  A scale has no Name property; its name is in DXF group 300 of the
        ;;  underlying entity.
        (   (= "Scales" cln)
            (vlax-for item cl1
                (setq exist (cons (cdr (assoc 300 (entget (vlax-vla-object->ename item)))) exist))
            )
            (vlax-for item cl2
                (if (not (member (setq name (cdr (assoc 300 (entget (vlax-vla-object->ename item)))))
                                 exist))
                    (setq lst (cons (cons name item) lst))
                )
            )
            (if (setq lst (vl-sort lst '(lambda ( a b ) (< (strcase (car a)) (strcase (car b))))))
                (cons cln lst)
            )
        )

        ;;  ---- drawing properties ----
        ;;  These are values on the document, not objects. They are compared
        ;;  by VALUE, so a property that exists at both ends but differs is
        ;;  still offered.
        (   (= "Drawing Properties" cln)
            (foreach prp '("Author" "Comments" "HyperlinkBase" "Keywords" "Subject" "Title")
                (if (and (vlax-property-available-p cl2 prp)
                         ;; The trailing t means "writable", so a property
                         ;; that cannot be set here is never offered.
                         (vlax-property-available-p cl1 prp t)
                         (setq item (vlax-get-property cl2 prp))
                         (/= "" item)
                         (/= (vlax-get-property cl1 prp) item)
                    )
                    (setq lst (cons (cons prp item) lst))
                )
            )
            (if (setq lst (vl-sort lst '(lambda ( a b ) (< (strcase (car a)) (strcase (car b))))))
                (cons cln lst)
            )
        )

        ;;  ---- custom properties ----
        ;;  User-defined key and value pairs. Read by index because there is
        ;;  no way to enumerate the keys directly.
        (   (= "Custom Properties" cln)
            (repeat (setq idx (vla-numcustominfo cl2))
                (vla-getcustombyindex cl2 (setq idx (1- idx)) 'key 'item)
                (if (and item
                         (/= "" item)
                         ;; Offered if this drawing has no such key, or has it
                         ;; with a different value.
                         (or (vl-catch-all-error-p
                                 (vl-catch-all-apply 'vla-getcustombykey (list cl1 key 'val)))
                             (/= val item)
                         )
                    )
                    (setq lst (cons (cons key item) lst))
                )
            )
            (if (setq lst (vl-sort lst '(lambda ( a b ) (< (strcase (car a)) (strcase (car b))))))
                (cons cln lst)
            )
        )

        ;;  ---- everything else: named objects ----
        (   (progn
                (vlax-for item cl2
                    (if (and
                            ;; Most items have a Name property; a few, such as
                            ;; dictionary entries, keep their name in DXF
                            ;; group 2 instead.
                            (setq name
                                (cond
                                    (   (vlax-property-available-p item 'name) (vla-get-name item))
                                    (   (cdr (assoc 2 (entget (vlax-vla-object->ename item)))))
                                )
                            )
                            (not
                                (or
                                    (= "" name)
                                    ;; Anonymous (*), xref-dependent (|) and
                                    ;; AutoCAD internal names cannot be
                                    ;; meaningfully imported.
                                    (wcmatch name "`**,*|*,ACAD_*")
                                    ;; Already here.
                                    (Borrow:GetItem cl1 name)
                                    ;; An xref belongs to its own file.
                                    (and (vlax-property-available-p item 'isxref)
                                         (= :vlax-true (vla-get-isxref item))
                                    )
                                    ;; A layout's block is offered through the
                                    ;; Layouts category, not Blocks.
                                    (and (vlax-property-available-p item 'islayout)
                                         (= :vlax-true (vla-get-islayout item))
                                    )
                                )
                            )
                        )
                        (setq lst (cons (cons name item) lst))
                    )
                )
                (setq lst (vl-sort lst '(lambda ( a b ) (< (strcase (car a)) (strcase (car b))))))
            )
            (cons cln lst)
        )
    )
)

;;; ---------------------------------------------------------------------------
;;; Borrow:FillList
;;;
;;; Loads a list box tile.
;;; ---------------------------------------------------------------------------

(defun Borrow:FillList ( key lst )
    (start_list key)
    (foreach x lst (add_list x))
    (end_list)
    lst
)

;;; ---------------------------------------------------------------------------
;;; Borrow:RemoveNth
;;;
;;; Removes items from a list by POSITION rather than by value.
;;;
;;; Two categories can legitimately contain the same name -- a layer and a
;;; block called "TITLE", say -- so removing by value could delete the wrong
;;; entry. Positions cannot.
;;; ---------------------------------------------------------------------------

(defun Borrow:RemoveNth ( idxs lst / n )
    (setq n -1)
    (vl-remove-if '(lambda ( x ) (member (setq n (1+ n)) idxs)) lst)
)

;;; ---------------------------------------------------------------------------
;;; Borrow:Find
;;;
;;; Returns (category . name) for the first item in any category whose name
;;; matches the wildcard pattern, or nil.
;;;
;;; vl-some stops at the first hit, so a search over a drawing with thousands
;;; of items does not walk them all.
;;; ---------------------------------------------------------------------------

(defun Borrow:Find ( pattern data )
    (vl-some
       '(lambda ( collection )
            (vl-some
               '(lambda ( item )
                    (if (wcmatch (strcase (car item)) pattern)
                        (cons (car collection) (car item))
                    )
                )
                (cdr collection)
            )
        )
        data
    )
)

;;; ---------------------------------------------------------------------------
;;; Borrow:GetDocument
;;;
;;; Returns a document object for the named drawing file, or nil.
;;;
;;; A drawing already open in this session is returned as its LIVE document
;;; object. Opening it again through ObjectDBX would read the version on
;;; disk, silently ignoring anything unsaved -- and would hold a second
;;; handle on a file the user is editing.
;;;
;;; Otherwise an ObjectDBX document is created. Its ProgID is version-stamped
;;; from AutoCAD 2004 (version 16) onward, so the major version number is
;;; read from ACADVER and appended.
;;; ---------------------------------------------------------------------------

(defun Borrow:GetDocument ( filename / dbdoc open ver )
    (vlax-for doc (vla-get-documents (vlax-get-acad-object))
        (setq open (cons (cons (strcase (vla-get-fullname doc)) doc) open))
    )
    (cond
        (   (null (setq filename (findfile filename))) nil)
        (   (cdr (assoc (strcase filename) open)))
        (   (null
                (vl-catch-all-error-p
                    (vl-catch-all-apply 'vla-open
                        (list
                            (setq dbdoc
                                (vla-getinterfaceobject (vlax-get-acad-object)
                                    (if (< (setq ver (atoi (getvar 'acadver))) 16)
                                        "ObjectDBX.AxDbDocument"
                                        (strcat "ObjectDBX.AxDbDocument." (itoa ver))
                                    )
                                )
                            )
                            filename
                        )
                    )
                )
            )
            dbdoc
        )
    )
)

;;; ---------------------------------------------------------------------------
;;; Borrow:ListBox
;;;
;;; Shows a simple list and returns the chosen entries, or nil.
;;;
;;; The dialog definition is written to a uniquely named temporary file,
;;; loaded, and deleted immediately, so nothing is left behind and two
;;; AutoCAD sessions cannot collide over it.
;;; ---------------------------------------------------------------------------

(defun Borrow:ListBox ( title lst / *error* dch des res tmp )

    (defun *error* ( msg )
        (if (= 'file (type des)) (close des))
        (if (and (= 'int (type dch)) (< 0 dch)) (unload_dialog dch))
        (if (and (= 'str (type tmp)) (findfile tmp)) (vl-file-delete tmp))
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** Borrow list error: " msg " **"))
        )
        (princ)
    )

    (cond
        (   (not
                (and
                    (setq tmp (vl-filename-mktemp nil nil ".dcl"))
                    (setq des (open tmp "w"))
                    (write-line
                        (strcat
                            "listbox : dialog { label = \"" title
                            "\"; spacer; : list_box { key = \"list\"; multiple_select = false"
                            "; } spacer; ok_cancel; }"
                        )
                        des
                    )
                    (not (close des))
                    (< 0 (setq dch (load_dialog tmp)))
                    (new_dialog "listbox" dch)
                )
            )
            (princ "\nUnable to open the selection list.")
        )
        (   t
            (start_list "list")
            (foreach x lst (add_list x))
            (end_list)
            ;; Pre-select the first entry so OK works straight away.
            (setq res (set_tile "list" "0"))
            (action_tile "list" "(setq res $value)")
            (setq res
                (if (= 1 (start_dialog))
                    (mapcar '(lambda ( n ) (nth n lst)) (read (strcat "(" res ")")))
                )
            )
        )
    )
    (if (and (= 'int (type dch)) (< 0 dch)) (unload_dialog dch))
    (if (and (= 'str (type tmp)) (findfile tmp)) (vl-file-delete tmp))
    res
)

(princ "\nBorrow loaded. BORROW / BORROWALL / BORROWTEMPLATE / BORROWTEMPLATES / BORROWLAST.")
(princ)

;;; ---------------------------------------------------------------------------
;;; End of file
;;; ---------------------------------------------------------------------------