;;; SpotBit.lsp - CompanionBits SnipBit
;;; Compares this DWG with a previous version and lists every viewport
;;; (in all layouts) that shows a change: added / changed / deleted model
;;; space objects (matched by handle), changed viewports and changed
;;; paper space content per layout (title block, notes ...).
;;; The affected layouts can be sent to PUBLISH as a sheet list (DSD).
;;; Commands: SPOTBIT or SV
;;;
;;; Notes
;;; - ViewCenter (DXF 12) is in DCS, relative to ViewTarget (DXF 17), and the
;;;   view may be twisted (DXF 51). WCS geometry is converted to DCS first.
;;; - Compare relies on handles: it only works when the current DWG is a later
;;;   save of the selected file (not after WBLOCK / copy to a new drawing).
;;; - Only what is visible on the sheets counts: changes on layers that are
;;;   off, frozen (globally or in the viewport), Plot = No or Defpoints are
;;;   ignored. Layers that changed themselves (on/off, frozen, plottable,
;;;   colour, linetype, lineweight, transparency) are reported separately.
;;; - Not compared: xref contents, page setups.

(vl-load-com)

;; Set to -1.0 if twisted viewports are detected incorrectly.
(setq *em:spot-twistsign* 1.0)

;;; ---------------------------------------------------------------- helpers

(defun em:spot-unit (v / l)
  (setq l (distance '(0.0 0.0 0.0) v))
  (mapcar '(lambda (x) (/ x l)) v)
)

;; WCS point -> viewport DCS (x y)
(defun em:spot-wcs->dcs (p ed / tgt dir tw o)
  (setq tgt (cdr (assoc 17 ed))
        dir (em:spot-unit (cdr (assoc 16 ed)))
        tw  (* *em:spot-twistsign* (cdr (assoc 51 ed)))
        o   (trans (mapcar '- p tgt) 0 dir T)
  )
  (list (- (* (car o) (cos tw)) (* (cadr o) (sin tw)))
        (+ (* (car o) (sin tw)) (* (cadr o) (cos tw)))
  )
)

;; Detect the overall paper space viewport
(defun em:spot-ghost-p (ed / c vc)
  (setq c  (cdr (assoc 10 ed))
        vc (cdr (assoc 12 ed))
  )
  (or (= 1 (cdr (assoc 69 ed)))
      (and (equal (list (car c) (cadr c)) (list (car vc) (cadr vc)) 1e-6)
           (equal (cdr (assoc 17 ed)) '(0.0 0.0 0.0) 1e-6)
      )
  )
)

(defun em:spot-join (l sep / s)
  (setq s (car l))
  (foreach x (cdr l) (setq s (strcat s sep x)))
  s
)

(defun em:spot-clip (str / html ok)
  (if (setq html (vlax-create-object "htmlfile"))
    (progn
      (setq ok (not (vl-catch-all-error-p
                      (vl-catch-all-apply
                        'vlax-invoke
                        (list (vlax-get (vlax-get html 'ParentWindow) 'ClipboardData)
                              'SetData "Text" str)))))
      (vlax-release-object html)
    )
  )
  ok
)

;;; ---------------------------------------------------------------- progress
;;; Status bar progress (Express Tools), fallback: percentage in status line.

(defun em:spot-prog-init (msg n)
  (if (not acet-ui-progress-init)
    (vl-catch-all-apply 'load (list "acetutil.fas" nil))
  )
  (setq *em:spot-pn* (max 1 n)
        *em:spot-pi* 0
        *em:spot-pm* msg
        *em:spot-ps* (max 1 (fix (/ n 100.0))))
  (if acet-ui-progress-init
    (acet-ui-progress-init msg *em:spot-pn*)
    (grtext -1 msg)
  )
)

(defun em:spot-prog ()
  (setq *em:spot-pi* (1+ *em:spot-pi*))
  (if (zerop (rem *em:spot-pi* *em:spot-ps*))
    (if acet-ui-progress-safe
      (acet-ui-progress-safe *em:spot-pi*)
      (grtext -1 (strcat *em:spot-pm* "  "
                         (itoa (fix (/ (* 100.0 *em:spot-pi*) *em:spot-pn*))) "%"))
    )
  )
)

(defun em:spot-prog-done ()
  (if acet-ui-progress-done (vl-catch-all-apply 'acet-ui-progress-done nil))
  (grtext -1 "")
)

;;; ---------------------------------------------------------------- cleanup
;;; The previous version is opened in the background (ObjectDBX). If the user
;;; presses ESC halfway, it must still be released, or the file stays locked.

(defun em:spot-release-dbx ()
  (if *em:spot-dbx*
    (vl-catch-all-apply 'vlax-release-object (list *em:spot-dbx*))
  )
  (setq *em:spot-dbx* nil)
  ;; a drawing SpotBit opened itself (no background reading, e.g. LT):
  ;; close it again without saving and go back to the user's drawing
  (if *em:spot-opened*
    (progn
      (vl-catch-all-apply 'vla-Close (list *em:spot-opened* :vlax-false))
      (if *em:spot-home* (vl-catch-all-apply 'vla-Activate (list *em:spot-home*)))
    )
  )
  (setq *em:spot-opened* nil)
)

;; Fallback when background reading is not available (e.g. AutoCAD LT):
;; open the previous version read-only in AutoCAD itself.
;; Set *em:spot-forceopen* to T to test this route in full AutoCAD.
(defun em:spot-visible-open (fn cur / doc)
  (setq doc (vl-catch-all-apply 'vla-Open
              (list (vla-get-Documents (vlax-get-acad-object)) fn :vlax-true)))
  (if (vl-catch-all-error-p doc)
    nil
    (progn
      (setq *em:spot-opened* doc
            *em:spot-home*   cur)
      ;; stay on the user's drawing while reading the other one
      (vl-catch-all-apply 'vla-Activate (list cur))
      doc
    )
  )
)

;; Shared *error* body: close the progress bar, release the background file
(defun em:spot-error (msg)
  (em:spot-prog-done)
  (em:spot-release-dbx)
  (if (and msg (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*EXIT*,*BREAK*")))
    (princ (strcat "\nSpotBit error: " msg))
    (princ "\nSpotBit: cancelled.")
  )
)

;; Items: (kind layer (bbox ...)) ; bbox = (minpt maxpt) in WCS
;; kind is "added" / "changed" / "deleted"

;;; ---------------------------------------------------------------- compare

;; DXF data without document-specific parts (handles, owners, reactors, enames)
;; Anonymous block names (*D, *U, *T ...) are renumbered on open: ignored.
;; Tables: internal cell flags (90/91/93) differ when read via ObjectDBX: ignored.
;; MText: computed extents (42/43) are recalculated on open: ignored.
(defun em:spot-clean (ed / skip tbl mt res)
  (setq tbl (= "ACAD_TABLE" (cdr (assoc 0 ed)))
        mt  (= "MTEXT" (cdr (assoc 0 ed))))
  (foreach x ed
    (cond
      (skip (if (equal x '(102 . "}")) (setq skip nil)))
      ((and (= 102 (car x)) (= "{" (substr (cdr x) 1 1))) (setq skip T))
      ((member (car x) '(-1 5 102 330 340 350 360 410)) nil)
      ((= 'ENAME (type (cdr x))) nil)
      ((and (= 2 (car x)) (= "*" (substr (cdr x) 1 1))) nil)
      ((and tbl (member (car x) '(90 91 93))) nil)
      ((and mt (member (car x) '(42 43))) nil)
      (T (setq res (cons x res)))
    )
  )
  (reverse res)
)

(defun em:spot-anon-p (name) (= "*" (substr name 1 1)))

;;; Annotative objects: entget returns height/position for the CURRENT
;;; annotation scale (CANNOSCALE), which can differ between the open drawing
;;; and the file read in the background. Those codes are dropped and replaced
;;; by the per-scale data stored in the object's context data, which does not
;;; depend on the current scale.

;; Cleaned DXF of an object and its children (dictionary entries), depth-limited
(defun em:spot-treefp (en depth / ed res)
  (setq ed  (entget en)
        res (em:spot-clean ed))
  (if (> depth 0)
    (foreach x ed
      (if (and (member (car x) '(350 360)) (= 'ENAME (type (cdr x))))
        (setq res (append res (em:spot-treefp (cdr x) (1- depth))))
      )
    )
  )
  res
)

;; Per-scale context data of an annotative object
(defun em:spot-ctxfp (ed / xd mgr)
  (if (and (setq xd (cdr (assoc 360 (member '(102 . "{ACAD_XDICTIONARY") ed))))
           (setq mgr (cdr (cadr (member '(3 . "AcDbContextDataManager") (entget xd)))))
           (= 'ENAME (type mgr)))
    (em:spot-treefp mgr 3)
  )
)

;; Scale-dependent codes per object type
(defun em:spot-annoclean (ed / typ drop res)
  (setq typ  (cdr (assoc 0 ed))
        drop (cond ((= typ "MTEXT") '(10 40 41 42 43 46))
                   ((= typ "TEXT")  '(10 11 40 41))
                   ((= typ "DIMENSION") '(11))
                   ((= typ "HATCH") '(41))
                   ('())))
  (foreach x (em:spot-clean ed)
    (cond
      ((or (= -3 (car x)) (member (car x) drop)) nil)
      ;; dimension flag 32 ("block used by this dimension only") follows the regen
      ((and (= typ "DIMENSION") (= 70 (car x)))
       (setq res (cons (cons 70 (boole 1 (cdr x) (~ 32))) res)))
      (T (setq res (cons x res)))
    )
  )
  (reverse res)
)

;;; Fields (layout name, date, file name, sheet number ...): the text AutoCAD
;;; shows is a cached value that is re-evaluated on open, regen or save, and
;;; for a field inside a block definition it is whatever layout was regenerated
;;; last. So for text with fields, SpotBit compares the field codes (which
;;; include the literal text around them), not the displayed value.

(defun em:spot-fieldcodes (en depth / ed res)
  (setq ed (entget en))
  (foreach x ed
    (cond
      ;; code 2 = field code; code 1 also holds the cached value, so it is skipped
      ((and (= 2 (car x)) (= 'STR (type (cdr x))))
       (setq res (cons x res)))
      ((and (> depth 0) (member (car x) '(350 360)) (= 'ENAME (type (cdr x))))
       (setq res (append (reverse (em:spot-fieldcodes (cdr x) (1- depth))) res)))
    )
  )
  (reverse res)
)

;; Field codes of an object, or nil when it has no fields
(defun em:spot-fieldfp (ed / xd fd)
  (if (and (setq xd (cdr (assoc 360 (member '(102 . "{ACAD_XDICTIONARY") ed))))
           (setq fd (cdr (cadr (member '(3 . "ACAD_FIELD") (entget xd)))))
           (= 'ENAME (type fd)))
    (em:spot-fieldcodes fd 4)
  )
)

(defun em:spot-fp (obj / en ed fp ff)
  (setq en (vl-catch-all-apply 'vlax-vla-object->ename (list obj)))
  (if (and en (not (vl-catch-all-error-p en)))
    (progn
      (setq ed (entget en '("AcadAnnotative"))
            fp (if (assoc -3 ed)
                 (append (em:spot-annoclean ed) (em:spot-ctxfp ed))
                 (em:spot-clean ed)))
      (if (setq ff (vl-catch-all-apply 'em:spot-fieldfp (list ed)))
        (if (vl-catch-all-error-p ff)
          fp
          (append (vl-remove-if '(lambda (x) (member (car x) '(1 3))) fp)
                  (list (cons "FIELD" ff)))
        )
        fp
      )
    )
  )
)

;; Fingerprint incl. dynamic properties and attributes of block references.
;; Dynamic blocks get (2 . EffectiveName) instead of their *U name.
(defun em:spot-try (f args / r)
  (setq r (vl-catch-all-apply f args))
  (if (vl-catch-all-error-p r) "?" r)
)

;; Tables: compared on what you see, not on their (unstable) DXF data
(defun em:spot-tablefp (obj / rows cols r c fp fid)
  (setq rows (vla-get-Rows obj)
        cols (vla-get-Columns obj)
        fp   (list (cons "T" (vlax-get obj 'InsertionPoint))
                   (cons "T" (vla-get-Layer obj))
                   (cons "T" (em:spot-try 'vlax-get (list obj 'Direction)))
                   (cons "T" (list rows cols))))
  (setq c -1)
  (while (< (setq c (1+ c)) cols)
    (setq fp (cons (cons "W" (em:spot-try 'vla-GetColumnWidth (list obj c))) fp))
  )
  (setq r -1)
  (while (< (setq r (1+ r)) rows)
    (setq fp (cons (cons "H" (em:spot-try 'vla-GetRowHeight (list obj r))) fp))
    (setq c -1)
    (while (< (setq c (1+ c)) cols)
      ;; a cell with a field: its shown text is a cached value, not compared
      (setq fid (vl-catch-all-apply 'vla-GetFieldId (list obj r c)))
      (setq fp (cons (cons "C" (if (and (numberp fid) (/= 0 fid))
                                 "<field>"
                                 (em:spot-try 'vla-GetText (list obj r c))))
                     fp))
    )
  )
  (cons '(0 . "ACAD_TABLE") (reverse fp))
)

(defun em:spot-objfp (obj / fp dp)
  (setq fp (if (= "AcDbTable" (vla-get-ObjectName obj))
             (em:spot-tablefp obj)
             (em:spot-fp obj)))
  (if (and (vlax-property-available-p obj 'IsDynamicBlock)
           (= :vlax-true (vla-get-IsDynamicBlock obj)))
    (progn
      (setq fp (append fp (list (cons 2 (vla-get-EffectiveName obj)))))
      (setq dp (vl-catch-all-apply 'vlax-invoke (list obj 'GetDynamicBlockProperties)))
      (if (not (vl-catch-all-error-p dp))
        (foreach p dp
          (setq fp (append fp (list (cons "DYN" (vl-catch-all-apply 'vlax-get (list p 'Value))))))
        )
      )
    )
  )
  (if (and (vlax-property-available-p obj 'HasAttributes)
           (= :vlax-true (vla-get-HasAttributes obj)))
    (foreach a (vlax-invoke obj 'GetAttributes)
      (setq fp (append fp (em:spot-fp a)))
    )
  )
  fp
)

(defun em:spot-bbox (obj / mn mx r)
  (setq r (vl-catch-all-apply 'vla-GetBoundingBox (list obj 'mn 'mx)))
  (if (and (not (vl-catch-all-error-p r)) mn mx)
    (list (vlax-safearray->list mn) (vlax-safearray->list mx))
  )
)

;; Objects of a block (model or paper space), sorted by handle:
;; (handle fp layer bbox blockname). skipvp: leave viewports out.
(defun em:spot-entries (blk skipvp prog / res)
  (vlax-for o blk
    (if prog (em:spot-prog))
    (if (not (and skipvp (= "AcDbViewport" (vla-get-ObjectName o))))
      (setq res (cons (list (vla-get-Handle o)
                            (em:spot-objfp o)
                            (vla-get-Layer o)
                            (em:spot-bbox o)
                            (if (vlax-property-available-p o 'EffectiveName)
                              (strcase (vla-get-EffectiveName o))))
                      res))
    )
  )
  (vl-sort res '(lambda (a b) (< (car a) (car b))))
)

(defun em:spot-collect (doc msg / ms res)
  (setq ms (vla-get-ModelSpace doc))
  (em:spot-prog-init msg (vla-get-Count ms))
  (setq res (em:spot-entries ms nil T))
  (em:spot-prog-done)
  res
)

;; Paper space per layout (viewports excluded, they are compared separately):
;; ((layouthandle layoutname entries) ...) - keyed by handle, so renamed
;; layouts still match.
(defun em:spot-pscollect (doc msg / los res)
  (setq los (vla-get-Layouts doc))
  (em:spot-prog-init msg (vla-get-Count los))
  (vlax-for lo los
    (em:spot-prog)
    (if (/= "MODEL" (strcase (vla-get-Name lo)))
      (setq res (cons (list (vla-get-Handle lo)
                            (vla-get-Name lo)
                            (em:spot-entries (vla-get-Block lo) T nil))
                      res))
    )
  )
  (em:spot-prog-done)
  res
)

;; Sheet changes per layout: ((layoutname summary) ...)
;; Sheet changes per layout: ((layoutname summary details) ...)
(defun em:spot-sheetchanges (oldps newps chgblk lch lblks / gfrz o its res)
  (setq gfrz (em:spot-frozen))
  (foreach n newps
    (if (not (setq o (assoc (car n) oldps)))
      (setq res (cons (list (cadr n) "new layout" (list "new layout")) res))
      (progn
        (setq its (vl-remove-if '(lambda (it) (and (not (em:spot-layerkind-p (car it)))
                                                   (member (strcase (cadr it)) gfrz)))
                                (append (em:spot-diff (caddr o) (caddr n) chgblk)
                                        (em:spot-layeritems (caddr n) lch lblks))))
        ;; renamed layout (matched by handle, so the name may differ)
        (if (/= (cadr o) (cadr n))
          (setq its (cons (list "renamed" "" nil (strcat "layout renamed - was \"" (cadr o) "\"")) its))
        )
        (if its
          (setq res (cons (list (cadr n)
                                (em:spot-summary (mapcar 'car its))
                                (mapcar 'cadddr its))
                          res))
        )
      )
    )
  )
  res
)

;; Viewport lines + sheet lines, grouped per layout in tab order
;; Viewport rows + sheet rows, grouped per layout in tab order.
;; Rows: ((line . details) ...)
(defun em:spot-merge (vprows sheet / order nm s res)
  (vlax-for lo (vla-get-Layouts (vla-get-ActiveDocument (vlax-get-acad-object)))
    (setq order (cons (cons (vla-get-TabOrder lo) (vla-get-Name lo)) order))
  )
  (foreach p (vl-sort order '(lambda (a b) (< (car a) (car b))))
    (setq nm (cdr p))
    (if (setq s (assoc nm sheet))
      (setq res (cons (cons (strcat nm "\tsheet\t" (cadr s)) (em:spot-dedupe (caddr s))) res))
    )
    (foreach r vprows
      (if (= nm (substr (car r) 1 (vl-string-search "\t" (car r))))
        (setq res (cons r res))
      )
    )
  )
  (reverse res)
)

;; Block definitions: (NAME origin (handle . fp) ...)
(defun em:spot-blocks (doc msg / bl res l)
  (setq bl (vla-get-Blocks doc))
  (em:spot-prog-init msg (vla-get-Count bl))
  (vlax-for b bl
    (em:spot-prog)
    (if (and (= :vlax-false (vla-get-IsLayout b))
             (= :vlax-false (vla-get-IsXRef b))
             (not (em:spot-anon-p (vla-get-Name b))))
      (progn
        (setq l nil)
        (vlax-for o b (setq l (cons (cons (vla-get-Handle o) (em:spot-objfp o)) l)))
        (setq res (cons (cons (strcase (vla-get-Name b))
                              (cons (vlax-get b 'Origin) l))
                        res))
      )
    )
  )
  (em:spot-prog-done)
  res
)

;; Names of new/changed block definitions, incl. blocks that nest them
(defun em:spot-changed-blocks (old new / chg go)
  (foreach b new
    (if (not (equal (cdr b) (cdr (assoc (car b) old)) 1e-8))
      (setq chg (cons (car b) chg))
    )
  )
  (setq go T)
  (while go
    (setq go nil)
    (foreach b new
      (if (and (not (member (car b) chg))
               (vl-some '(lambda (e)
                           (and (equal (assoc 0 (cdr e)) '(0 . "INSERT"))
                                (assoc 2 (cdr e))
                                (member (strcase (cdr (assoc 2 (cdr e)))) chg)))
                        (cddr b)))
        (setq chg (cons (car b) chg) go T)
      )
    )
  )
  chg
)

;;; ---------------------------------------------------------------- details
;;; Human-readable description per change, shown in the details list.
;;; A description must never break the comparison: every call goes through
;;; em:spot-desc, which falls back to a plain text and reports the error once.

(defun em:spot-desc (f args fallback / r)
  (setq r (vl-catch-all-apply f args))
  (if (vl-catch-all-error-p r)
    (progn
      (if (not (member f *em:spot-descerr*))
        (progn
          (setq *em:spot-descerr* (cons f *em:spot-descerr*))
          (princ (strcat "\nSpotBit: could not describe a change (" (vl-princ-to-string f) ": "
                         (vl-catch-all-error-message r) ") - please report."))
        )
      )
      fallback
    )
    r
  )
)

(defun em:spot-typename (e / typ)
  (setq typ (cdr (assoc 0 (cadr e))))
  (cond ((nth 4 e) (strcat "block " (nth 4 e)))
        ((= typ "ACAD_TABLE") "table")
        ((= typ "LWPOLYLINE") "polyline")
        ((= typ "MULTILEADER") "multileader")
        (typ (strcase typ T))
        ("object"))
)

(defun em:spot-objdesc (e)
  (strcat (em:spot-typename e) " (" (nth 2 e) ")")
)

;; What a changed DXF code means, in words
(defun em:spot-propname (code typ)
  (cond
    ((= code "DYN") "dynamic property")
    ((= code "FIELD") "field")
    ((= code "C") "cell text")
    ((member code '("W" "H")) "cell size")
    ((= code "T") "position")
    ((not (numberp code)) "properties")
    ((and (= typ "DIMENSION") (= code 42)) "value")
    ((and (= typ "DIMENSION") (= code 1)) "text override")
    ((and (member typ '("LWPOLYLINE" "POLYLINE")) (= code 42)) "moved/reshaped")
    ((member code '(10 11 12 13 14 15 16 90 91 92 93)) "moved/reshaped")
    ((member code '(1 3)) "text")
    ((= code 8) "layer")
    ((member code '(62 420 430)) "colour")
    ((= code 6) "linetype")
    ((= code 48) "linetype scale")
    ((= code 370) "lineweight")
    ((= code 7) "text style")
    ((= code 50) "rotation")
    ((= code 40) "size")
    ((member code '(41 42 43)) "scale")
    ((= code 2) "name")
    ("properties"))
)

;; (own-data (attrib-data) (attrib-data) ...)
(defun em:spot-splitattr (fp / own atts cur)
  (foreach x fp
    (if (equal x '(0 . "ATTRIB"))
      (progn
        (if cur (setq atts (cons (reverse cur) atts)))
        (setq cur (list x))
      )
      (if cur (setq cur (cons x cur)) (setq own (cons x own)))
    )
  )
  (if cur (setq atts (cons (reverse cur) atts)))
  (cons (reverse own) (reverse atts))
)

(defun em:spot-changedesc (o n blkchg / typ so sn props w i ao an)
  (setq typ (cdr (assoc 0 (cadr n)))
        so  (em:spot-splitattr (cadr o))
        sn  (em:spot-splitattr (cadr n)))
  (foreach x (append (em:spot-pairdiff (car so) (car sn)) (em:spot-pairdiff (car sn) (car so)))
    (setq w (em:spot-propname (car x) typ))
    (if (not (member w props)) (setq props (cons w props)))
  )
  (setq i 0)
  (while (or (setq ao (nth i (cdr so))) (setq an (nth i (cdr sn))))
    (setq an (nth i (cdr sn)))
    (if (not (equal ao an 1e-8))
      (setq props (cons (strcat "attribute " (cond ((cdr (assoc 2 (cond (an) (ao))))) ("?"))) props))
    )
    (setq i (1+ i))
  )
  (if (and (null props) blkchg)
    (setq props (list (strcat "block definition: "
                              (cond ((cdr (assoc (nth 4 n) *em:spot-bdesc*))) ("contents"))))))
  (if (null props) (setq props (list "properties")))
  (strcat "changed - " (em:spot-objdesc n) " - " (em:spot-join (reverse props) ", "))
)

;; What changed inside a block definition, e.g.
;; "mtext (0) - text; added line (0)". Nested-only changes name the nested block.
(defun em:spot-blockdesc (ob nb name chg / o n oe ne x e parts d)
  (setq o (cdr (assoc name ob))
        n (cdr (assoc name nb)))
  (cond
    ((null o) "new block")
    (T
     (if (not (equal (car o) (car n) 1e-8)) (setq parts (list "base point")))
     (setq oe (cdr o) ne (cdr n))
     (foreach e ne
       (setq x (assoc (car e) oe))
       (cond
         ((null x)
          (setq d (strcat "added " (em:spot-objdesc (list (car e) (cdr e) (cond ((cdr (assoc 8 (cdr e)))) ("?")))))))
         ((not (equal (cdr x) (cdr e) 1e-8))
          (setq d (substr (em:spot-changedesc
                            (list (car x) (cdr x) (cond ((cdr (assoc 8 (cdr x)))) ("?")))
                            (list (car e) (cdr e) (cond ((cdr (assoc 8 (cdr e)))) ("?")))
                            nil)
                          11)))
         ((and (equal (assoc 0 (cdr e)) '(0 . "INSERT"))
               (assoc 2 (cdr e))
               (member (strcase (cdr (assoc 2 (cdr e)))) chg))
          (setq d (strcat "nested block " (strcase (cdr (assoc 2 (cdr e)))))))
         (T (setq d nil))
       )
       (if (and d (not (member d parts))) (setq parts (cons d parts)))
     )
     (foreach x oe
       (if (not (assoc (car x) ne))
         (progn
           (setq d (strcat "deleted " (em:spot-objdesc (list (car x) (cdr x) (cond ((cdr (assoc 8 (cdr x)))) ("?"))))))
           (if (not (member d parts)) (setq parts (cons d parts)))
         )
       )
     )
     (if parts (em:spot-join (reverse parts) "; ") "contents"))
  )
)

;; What changed on a layer
(defun em:spot-layerdesc (ofp nfp / o n res)
  (setq o (cdr (assoc 62 ofp)) n (cdr (assoc 62 nfp)))
  (if (and o n (/= (minusp o) (minusp n)))
    (setq res (cons (if (minusp n) "switched off" "switched on") res)))
  (if (and o n (/= (abs o) (abs n))) (setq res (cons "colour" res)))
  (if (not (equal (assoc 420 ofp) (assoc 420 nfp)))
    (if (not (member "colour" res)) (setq res (cons "colour" res))))
  (if (/= (cdr (assoc 70 ofp)) (cdr (assoc 70 nfp)))
    (setq res (cons (if (= 1 (cdr (assoc 70 nfp))) "frozen" "thawed") res)))
  (if (/= (cond ((cdr (assoc 290 ofp))) (1)) (cond ((cdr (assoc 290 nfp))) (1)))
    (setq res (cons (if (= 0 (cond ((cdr (assoc 290 nfp))) (1))) "set to no plot" "set to plot") res)))
  (if (not (equal (assoc 6 ofp) (assoc 6 nfp))) (setq res (cons "linetype" res)))
  (if (not (equal (assoc 370 ofp) (assoc 370 nfp))) (setq res (cons "lineweight" res)))
  (if (not (equal (assoc -3 ofp) (assoc -3 nfp))) (setq res (cons "transparency" res)))
  (if (null res) (setq res (list "properties")))
  (em:spot-join (reverse res) ", ")
)

;; What changed on a viewport (fingerprints from em:spot-vpfp)
(defun em:spot-vpdesc (ofp nfp / res)
  (if (not (equal (nth 0 ofp) (nth 0 nfp) 1e-8)) (setq res (cons "moved on sheet" res)))
  (if (not (and (equal (nth 1 ofp) (nth 1 nfp) 1e-8) (equal (nth 2 ofp) (nth 2 nfp) 1e-8)))
    (setq res (cons "resized" res)))
  (if (not (and (equal (nth 3 ofp) (nth 3 nfp) 1e-8) (equal (nth 5 ofp) (nth 5 nfp) 1e-8)))
    (setq res (cons "panned" res)))
  (if (not (equal (nth 6 ofp) (nth 6 nfp) 1e-8)) (setq res (cons "scale/zoom" res)))
  (if (not (equal (nth 4 ofp) (nth 4 nfp) 1e-8)) (setq res (cons "view direction" res)))
  (if (not (equal (nth 7 ofp) (nth 7 nfp) 1e-8)) (setq res (cons "twist" res)))
  (if (not (equal (nth 8 ofp) (nth 8 nfp))) (setq res (cons "layers frozen/thawed in viewport" res)))
  (strcat "viewport - " (if res (em:spot-join (reverse res) ", ") "changed"))
)

;; Sorted, with duplicates counted: "3x changed - line (MUREN) - moved/reshaped"
(defun em:spot-dedupe (l / res c)
  (setq l (vl-remove-if-not '(lambda (x) (= 'STR (type x))) l))
  (foreach x (if l (acad_strlsort l))
    (if (setq c (assoc x res))
      (setq res (subst (cons x (1+ (cdr c))) c res))
      (setq res (cons (cons x 1) res))
    )
  )
  (mapcar '(lambda (p) (if (> (cdr p) 1) (strcat (itoa (cdr p)) "x " (car p)) (car p)))
          (reverse res))
)

;;; ---------------------------------------------------------------- layers
;;; What is visible on a sheet also depends on the layers: on/off, frozen,
;;; plottable, colour, linetype, lineweight, transparency. A layer that changed
;;; between the two versions marks every viewport and sheet that shows objects
;;; on it - also when it was switched off (then they disappeared).

(defun em:spot-layerkind-p (k)
  (and (= 'STR (type k)) (wcmatch k "layer:*"))
)

;; Layer fingerprint: only what affects the plot (lock state and xref bits ignored)
(defun em:spot-layerfp (ed / res)
  (foreach x (em:spot-clean ed)
    (setq res (cons (if (= 70 (car x)) (cons 70 (logand 1 (cdr x))) x) res))
  )
  (reverse res)
)

;; ((NAME fp visible) ...)
(defun em:spot-layermap (doc / res en ed nm)
  (vlax-for la (vla-get-Layers doc)
    (setq en (vl-catch-all-apply 'vlax-vla-object->ename (list la)))
    (if (and en (not (vl-catch-all-error-p en)))
      (progn
        (setq ed (entget en '("AcCmTransparency"))
              nm (strcase (vla-get-Name la)))
        (setq res (cons (list nm
                              (em:spot-layerfp ed)
                              (and (> (cdr (assoc 62 ed)) 0)
                                   (zerop (logand 1 (cdr (assoc 70 ed))))
                                   (/= 0 (cond ((cdr (assoc 290 ed))) (1)))
                                   (/= nm "DEFPOINTS")))
                        res))
      )
    )
  )
  res
)

;; Layers that changed and are visible in at least one of the two versions
;; Layers that changed and are visible in at least one version: ((NAME . desc) ...)
(defun em:spot-changedlayers (old new / o res)
  (foreach n new
    (if (and (setq o (assoc (car n) old))
             (not (equal (cadr o) (cadr n) 1e-8))
             (or (caddr o) (caddr n)))
      (setq res (cons (cons (car n) (em:spot-desc 'em:spot-layerdesc (list (cadr o) (cadr n)) "changed")) res))
    )
  )
  res
)

;; Blocks containing objects on changed layers (nested included):
;; ((BLOCK layer ...) ...)
(defun em:spot-layerblocks (nb lays / res l lay sub cur go)
  (foreach b nb
    (setq l nil)
    (foreach e (cddr b)
      (if (and (listp (cdr e))
               (setq lay (cdr (assoc 8 (cdr e))))
               (member (strcase lay) lays)
               (not (member (strcase lay) l)))
        (setq l (cons (strcase lay) l))
      )
    )
    (if l (setq res (cons (cons (car b) l) res)))
  )
  (setq go T)
  (while go
    (setq go nil)
    (foreach b nb
      (foreach e (cddr b)
        (if (and (listp (cdr e))
                 (equal (assoc 0 (cdr e)) '(0 . "INSERT"))
                 (assoc 2 (cdr e))
                 (setq sub (assoc (strcase (cdr (assoc 2 (cdr e)))) res)))
          (foreach x (cdr sub)
            (setq cur (assoc (car b) res))
            (if (not (member x (cdr cur)))
              (setq res (if cur
                          (subst (append cur (list x)) cur res)
                          (cons (list (car b) x) res))
                    go  T)
            )
          )
        )
      )
    )
  )
  res
)

;; Items for objects on changed layers, directly or inside a block
;; Items for objects on changed layers, directly or inside a block.
;; lch: ((NAME . desc) ...)
(defun em:spot-layeritems (ents lch lblks / res lay sub)
  (foreach n ents
    (setq lay (strcase (nth 2 n)))
    (if (nth 3 n)
      (progn
        (if (assoc lay lch)
          (setq res (cons (list (strcat "layer:" lay) (nth 2 n) (list (nth 3 n))
                                (strcat "layer " lay " - " (cdr (assoc lay lch))))
                          res))
        )
        (if (and (nth 4 n) (setq sub (assoc (nth 4 n) lblks)))
          (foreach x (cdr sub)
            (setq res (cons (list (strcat "layer:" x) (nth 2 n) (list (nth 3 n))
                                  (strcat "layer " x " - " (cdr (assoc x lch))))
                            res))
          )
        )
      )
    )
  )
  res
)

;; Layouts (current names) that lost a viewport: (name ...)
(defun em:spot-removedvps (oldvpm newvpm / names nm res)
  (vlax-for lo (vla-get-Layouts (vla-get-ActiveDocument (vlax-get-acad-object)))
    (setq names (cons (cons (vla-get-Handle lo) (vla-get-Name lo)) names))
  )
  (foreach o (cdr oldvpm)
    (if (and (not (nth 3 o))
             (not (assoc (car o) (cdr newvpm)))
             (setq nm (cdr (assoc (caddr o) names)))
             (not (member nm res)))
      (setq res (cons nm res))
    )
  )
  res
)

;; Merge two handle-sorted lists into change items
;; Items: (kind layer (bbox ...) description)
(defun em:spot-diff (old new chgblk / o n res)
  (while (or old new)
    (setq o (car old) n (car new))
    (cond
      ((and o n (= (car o) (car n)))
       (if (or (not (equal (cadr o) (cadr n) 1e-8))
               (and (nth 4 n) (member (nth 4 n) chgblk)))
         (setq res (cons (list "changed" (nth 2 n)
                               (vl-remove nil (list (nth 3 n) (nth 3 o)))
                               (em:spot-desc 'em:spot-changedesc
                                             (list o n (and (nth 4 n) (member (nth 4 n) chgblk)))
                                             (strcat "changed - " (nth 2 n))))
                         res))
       )
       (setq old (cdr old) new (cdr new))
      )
      ((or (null n) (and o (< (car o) (car n))))
       (setq res (cons (list "deleted" (nth 2 o) (vl-remove nil (list (nth 3 o)))
                             (strcat "deleted - " (em:spot-desc 'em:spot-objdesc (list o) (nth 2 o))))
                       res)
             old (cdr old))
      )
      (T
       (setq res (cons (list "added" (nth 2 n) (vl-remove nil (list (nth 3 n)))
                             (strcat "added - " (em:spot-desc 'em:spot-objdesc (list n) (nth 2 n))))
                       res)
             new (cdr new))
      )
    )
  )
  res
)

;; Viewport fingerprint: position/size on paper, view, scale, twist, VP-frozen layers
(defun em:spot-vpfp (ed / fz)
  (foreach x ed
    (if (= 341 (car x))
      (setq fz (cons (strcase (cdr (assoc 2 (entget (cdr x))))) fz))
    )
  )
  (append (mapcar '(lambda (c) (assoc c ed)) '(10 40 41 12 16 17 45 51))
          (list (if fz (acad_strlsort fz))))
)

;; Viewports of a document: (VP (handle fp layouthandle ghost) ...)
;; - the VP tag keeps it non-nil
(defun em:spot-vpmap (doc msg / los res en ed)
  (setq los (vla-get-Layouts doc))
  (em:spot-prog-init msg (vla-get-Count los))
  (vlax-for lo los
    (em:spot-prog)
    (vlax-for o (vla-get-Block lo)
      (if (= "AcDbViewport" (vla-get-ObjectName o))
        (progn
          (setq en (vl-catch-all-apply 'vlax-vla-object->ename (list o)))
          (if (and en (not (vl-catch-all-error-p en)))
            (setq ed  (entget en)
                  res (cons (list (vla-get-Handle o)
                                  (em:spot-vpfp ed)
                                  (vla-get-Handle lo)
                                  (em:spot-ghost-p ed))
                            res))
          )
        )
      )
    )
  )
  (em:spot-prog-done)
  (cons 'VP res)
)

(defun em:spot-dbx-open (fn / dbx)
  (setq dbx (if *em:spot-forceopen*
              (vl-catch-all-apply '/ (list 1 0))        ; simulate "not available"
              (vl-catch-all-apply 'vla-GetInterfaceObject
                (list (vlax-get-acad-object)
                      (strcat "ObjectDBX.AxDbDocument." (substr (getvar "ACADVER") 1 2))))))
  (setq *em:spot-dbxwhy* nil)
  (cond
    ((vl-catch-all-error-p dbx)
     ;; no background reading available (e.g. AutoCAD LT)
     (setq *em:spot-dbxwhy* 'nodbx)
     nil)
    ((vl-catch-all-error-p (vl-catch-all-apply 'vla-Open (list dbx fn)))
     (setq *em:spot-dbxwhy* 'locked)
     (vlax-release-object dbx)
     nil)
    (T (setq *em:spot-dbx* dbx))
  )
)

;; Returns (items message vpmap sheet) ; vpmap nil when the file could not be read
(defun em:spot-compare (fn / acad cur doc dbx oe ne ob nb vpm nvpm ops nps olm lch lays lblks chg items sheet s del msg)
  (setq acad (vlax-get-acad-object)
        cur  (vla-get-ActiveDocument acad))
  (if (/= (strcase fn) (strcase (vla-get-FullName cur)))
    (vlax-for d (vla-get-Documents acad)
      (if (= (strcase fn) (strcase (vla-get-FullName d))) (setq doc d))
    )
  )
  (cond
    ((= (strcase fn) (strcase (vla-get-FullName cur)))
     (list nil "That is the current drawing - select the previous version."))
    ((not (or doc
              (setq doc (setq dbx (em:spot-dbx-open fn)))
              (and (= *em:spot-dbxwhy* 'nodbx)
                   (setq doc (setq dbx (em:spot-visible-open fn cur))))))
     (list nil (if (= *em:spot-dbxwhy* 'nodbx)
                 "Could not open the previous version. Open it in this AutoCAD too, then compare again."
                 "Could not open the selected drawing. Is it open elsewhere? Close it there or open it in this AutoCAD.")))
    (T
     (princ "\nSpotBit: comparing drawings...")
     (setq oe  (em:spot-collect doc "SpotBit 1/8: reading previous model space")
           ob  (em:spot-blocks doc "SpotBit 2/8: reading previous blocks")
           vpm (em:spot-vpmap doc "SpotBit 3/8: reading previous viewports")
           ops (em:spot-pscollect doc "SpotBit 4/8: reading previous paper space")
           olm (em:spot-layermap doc))
     (if dbx (em:spot-release-dbx))
     (setq ne    (em:spot-collect cur "SpotBit 5/8: reading current model space")
           nb    (em:spot-blocks cur "SpotBit 6/8: reading current blocks")
           nps   (em:spot-pscollect cur "SpotBit 7/8: reading current paper space")
           nvpm  (em:spot-vpmap cur "SpotBit 7/8: reading current viewports")
           lch   (em:spot-changedlayers olm (em:spot-layermap cur))
           lays  (mapcar 'car lch)
           lblks (em:spot-layerblocks nb lays)
           chg   (em:spot-changed-blocks ob nb)
           *em:spot-descerr* nil
           *em:spot-bdesc* (mapcar '(lambda (b) (cons b (em:spot-desc 'em:spot-blockdesc (list ob nb b chg) "contents")))
                                   chg)
           items (append (em:spot-diff oe ne chg) (em:spot-layeritems ne lch lblks))
           sheet (em:spot-sheetchanges ops nps chg lch lblks))
     ;; Layouts that lost a viewport
     (foreach nm (em:spot-removedvps vpm nvpm)
       (setq sheet (if (setq s (assoc nm sheet))
                     (subst (list nm (strcat (cadr s) ", viewport removed")
                                  (cons "viewport removed" (caddr s)))
                            s sheet)
                     (cons (list nm "viewport removed" (list "viewport removed")) sheet)))
     )
     (setq del   (length (vl-remove-if-not '(lambda (x) (= (car x) "deleted")) items))
           msg   (if (or items sheet)
                   (strcat (itoa (length (vl-remove-if '(lambda (x) (em:spot-layerkind-p (car x))) items)))
                           " model space change(s), "
                           (if lays (strcat (itoa (length lays)) " layer(s) changed, ") "")
                           (itoa (length sheet)) " sheet(s) changed")
                   "No changes found."))
     (if (and (> (length oe) 20) (> del (* 0.5 (length oe))))
       (setq msg (strcat msg " - WARNING: most objects do not match; files may not share history"))
     )
     (list items msg vpm sheet))
  )
)

;;; ---------------------------------------------------------------- viewports

;; Layers that are not visible on the sheets now: off, frozen, Plot = No,
;; Defpoints. Changes on them don't count - a layer that was switched on or
;; off itself is caught by the layer comparison.
(defun em:spot-frozen (/ l)
  (vlax-for la (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object)))
    (if (or (= :vlax-false (vla-get-LayerOn la))
            (= :vlax-true (vla-get-Freeze la))
            (= :vlax-false (vla-get-Plottable la))
            (= "DEFPOINTS" (strcase (vla-get-Name la))))
      (setq l (cons (strcase (vla-get-Name la)) l))
    )
  )
  l
)

(defun em:spot-vpfrozen (ed / l)
  (foreach x ed
    (if (= 341 (car x))
      (setq l (cons (strcase (cdr (assoc 2 (entget (cdr x))))) l))
    )
  )
  l
)

;; Does the WCS box overlap the viewport (conservative, via DCS extents)?
(defun em:spot-box-hit (bb ed vc hw hh / p1 p2 dp xs ys)
  (setq p1 (car bb) p2 (cadr bb))
  (foreach x (list (car p1) (car p2))
    (foreach y (list (cadr p1) (cadr p2))
      (foreach z (list (caddr p1) (caddr p2))
        (setq dp (em:spot-wcs->dcs (list x y z) ed)
              xs (cons (car dp) xs)
              ys (cons (cadr dp) ys))
      )
    )
  )
  (and (<= (- (apply 'min xs) (car vc)) hw)
       (>= (- (apply 'max xs) (car vc)) (- hw))
       (<= (- (apply 'min ys) (cadr vc)) hh)
       (>= (- (apply 'max ys) (cadr vc)) (- hh)))
)

(defun em:spot-count (k hits)
  (length (vl-remove-if-not '(lambda (x) (= x k)) hits))
)

(defun em:spot-summary (hits / c a d lays)
  (setq c (em:spot-count "changed" hits)
        a (em:spot-count "added" hits)
        d (em:spot-count "deleted" hits))
  (foreach h hits
    (if (and (em:spot-layerkind-p h) (not (member (substr h 7) lays)))
      (setq lays (cons (substr h 7) lays))
    )
  )
  (em:spot-join
    (vl-remove nil (list (if (member "renamed" hits) "layout renamed")
                         (if (> c 0) (strcat (itoa c) " changed"))
                         (if (> a 0) (strcat (itoa a) " added"))
                         (if (> d 0) (strcat (itoa d) " deleted"))
                         (if lays (strcat "layer changed: "
                                          (em:spot-join (acad_strlsort lays) ", ")))))
    ", ")
)

;; Returns sorted, tab-separated result lines for the given items.
;; vpmap (compare mode only): previous viewports, to report new/changed viewports.
;; Returns sorted rows ((line . details) ...) for the given items.
;; vpmap: previous viewports, to report new/changed viewports.
(defun em:spot-scan (items vpmap / ss i en ed w h vc hh hw gfrz vfrz frz hits dets vpst vpd o res order tot idx prev rows)
  (if (setq ss (ssget "_X" '((0 . "VIEWPORT"))))
    (progn
      (setq gfrz (em:spot-frozen)
            i    -1)
      (em:spot-prog-init "SpotBit 8/8: checking viewports" (sslength ss))
      (while (setq en (ssname ss (setq i (1+ i))))
        (em:spot-prog)
        (setq ed (entget en)
              w  (cdr (assoc 40 ed))
              h  (cdr (assoc 41 ed))
        )
        (if (and (not (em:spot-ghost-p ed)) (> w 0.0) (> h 0.0))
          (progn
            (setq vc   (cdr (assoc 12 ed))
                  hh   (/ (cdr (assoc 45 ed)) 2.0)
                  hw   (* hh (/ w h))
                  vfrz (em:spot-vpfrozen ed)
                  frz  (append gfrz vfrz)
                  hits nil
                  dets nil
                  vpd  nil
            )
            (foreach it items
              (if (and (not (member (strcase (cadr it))
                                     (if (em:spot-layerkind-p (car it)) vfrz frz)))
                       (vl-some '(lambda (bb) (em:spot-box-hit bb ed vc hw hh))
                                (caddr it)))
                (setq hits (cons (car it) hits)
                      dets (cons (cadddr it) dets))
              )
            )
            (setq vpst (if vpmap
                         (cond ((not (setq o (assoc (cdr (assoc 5 ed)) (cdr vpmap))))
                                (setq vpd "viewport - new")
                                "new")
                               ((not (equal (cadr o) (em:spot-vpfp ed) 1e-8))
                                (setq vpd (em:spot-desc 'em:spot-vpdesc (list (cadr o) (em:spot-vpfp ed))
                                                        "viewport - changed"))
                                "view changed"))))
            (if (or hits vpst)
              (setq res (cons (list (cdr (assoc 410 ed))
                                    (cdr (assoc 5 ed))
                                    nil
                                    (reverse hits)
                                    vpst
                                    (= 'ENAME (type (cdr (assoc 340 ed))))
                                    (if vpd (cons vpd (em:spot-dedupe dets)) (em:spot-dedupe dets)))
                              res))
            )
          )
        )
      )
      (em:spot-prog-done)
      ;; Sort by layout tab order, then handle
      (vlax-for lo (vla-get-Layouts (vla-get-ActiveDocument (vlax-get-acad-object)))
        (setq order (cons (cons (strcase (vla-get-Name lo)) (vla-get-TabOrder lo)) order))
      )
      (setq res (vl-sort res
                  '(lambda (a b / ta tb)
                     (setq ta (cdr (assoc (strcase (car a)) order))
                           tb (cdr (assoc (strcase (car b)) order)))
                     (if (= ta tb) (< (cadr a) (cadr b)) (< ta tb)))))
      ;; "viewport", numbered only when a layout has more than one affected viewport
      (foreach r res
        (setq tot  (length (vl-remove-if-not '(lambda (x) (= (car x) (car r))) res))
              idx  (if (= (car r) prev) (1+ idx) 1)
              prev (car r)
              rows (cons (cons (strcat (car r)
                                       "\tviewport" (if (> tot 1) (strcat " " (itoa idx)) "")
                                       (if (nth 5 r) " (clipped)" "")
                                       "\t" (em:spot-join
                                              (vl-remove nil (list (nth 4 r)
                                                                   (if (cadddr r) (em:spot-summary (cadddr r)))))
                                              ", "))
                               (nth 6 r))
                         rows))
      )
      (reverse rows)
    )
  )
)

;;; ---------------------------------------------------------------- publish
;;; Same approach as ModFlagger: write a sheet list (DSD) with only the
;;; affected layouts, each with its own page setup (empty Setup=), then open
;;; PUBLISH. The user loads the list there with "Load Sheet List".

;; Unique layout names from the result lines, in list (= tab) order
(defun em:spot-layouts-of (lines / nm res)
  (foreach l lines
    (setq nm (substr l 1 (vl-string-search "\t" l)))
    (if (not (member nm res)) (setq res (cons nm res)))
  )
  (reverse res)
)

;; Writes <drawing>_SpotBit.dsd next to the drawing. Returns its path or nil.
(defun em:spot-write-dsd (names / dwg base path f)
  (setq dwg  (strcat (getvar "DWGPREFIX") (getvar "DWGNAME"))
        base (vl-filename-base (getvar "DWGNAME"))
        path (strcat (getvar "DWGPREFIX") base "_SpotBit.dsd"))
  (if (findfile path) (vl-file-delete path))
  (if (setq f (open path "w"))
    (progn
      (write-line "[DWF6Version]" f)
      (write-line "Ver=1" f)
      (write-line "[DWF6MinorVersion]" f)
      (write-line "MinorVer=1" f)
      (foreach nm names
        (write-line (strcat "[DWF6Sheet:" base "-" nm "]") f)
        (write-line (strcat "DWG=" dwg) f)
        (write-line (strcat "Layout=" nm) f)
        (write-line "Setup=" f)
        (write-line (strcat "OriginalSheetPath=" dwg) f)
        (write-line "Has Plot Port=0" f)
        (write-line "Has3DDWF=0" f)
      )
      (write-line "[Target]" f)
      (write-line "Type=0" f)
      (write-line "DWF=" f)
      (write-line (strcat "OUT=" (getvar "DWGPREFIX")) f)
      (write-line "PWD=" f)
      (write-line "[SheetSet Properties]" f)
      (write-line "IsSheetSet=FALSE" f)
      (write-line "IsHomogeneous=FALSE" f)
      (write-line "SheetSet Name=" f)
      (write-line "NoOfCopies=1" f)
      (write-line "PlotStampOn=FALSE" f)
      (write-line "ViewFile=FALSE" f)
      (write-line "JobID=0" f)
      (write-line "SelectionSetName=" f)
      (write-line "AcadProfile=" f)
      (write-line "CategoryName=" f)
      (write-line "LogFilePath=" f)
      (write-line "IncludeLayer=FALSE" f)
      (write-line "LineMerge=FALSE" f)
      (write-line "CurrentPrecision=" f)
      (write-line "PromptForDwfName=TRUE" f)
      (write-line "PwdProtectPublishedDWF=FALSE" f)
      (write-line "PromptForPwd=FALSE" f)
      (write-line "RepublishingMarkups=FALSE" f)
      (write-line "DSTPath=" f)
      (write-line "PublishSheetSetMetadata=FALSE" f)
      (write-line "PublishSheetMetadata=FALSE" f)
      (write-line "3DDWFOptions=0 0" f)
      (close f)
      path
    )
  )
)

;; Asks "Save and Publish" / "Cancel" in a small dialog. Returns T to go ahead.
(defun em:spot-publish-ask (id n path / ok)
  (if (new_dialog "spotbitpub" id)
    (progn
      (set_tile "pubcount" (strcat "Sheet list ready with " (itoa n) " layout(s):"))
      (set_tile "pubpath" path)
      (action_tile "save"   "(done_dialog 1)")
      (action_tile "cancel" "(done_dialog 0)")
      (setq ok (= 1 (start_dialog)))
    )
  )
  ok
)

;; Writes the sheet list, asks, saves the drawing. Returns the DSD path to
;; start PUBLISH with, or nil (cancelled or not possible).
(defun em:spot-publish-prep (lines id / los path)
  (cond
    ((= 0 (getvar "DWGTITLED"))
     (alert "Save the drawing first.\nThe sheet list refers to the drawing file on disk.")
     nil)
    ((not (setq path (em:spot-write-dsd (setq los (em:spot-layouts-of lines)))))
     (alert "Could not write the sheet list next to the drawing.\nIs the folder read-only?")
     nil)
    ((not (em:spot-publish-ask id (length los) path))
     (princ "\nSpotBit: publish cancelled.")
     nil)
    (T
     (princ (strcat "\nSpotBit: sheet list with " (itoa (length los)) " layout(s): " path))
     (foreach l los (princ (strcat "\n  " l)))
     (command "_.QSAVE")
     (if (/= 0 (logand 1 (getvar "DBMOD")))
       (alert "The drawing could not be saved.\nPublish will use the last saved version.")
     )
     path)
  )
)

;;; ---------------------------------------------------------------- command

(defun em:spot-report (msg rows)
  (princ (strcat "\nSpotBit: " msg))
  (foreach r rows
    (princ (strcat "\n  " (car r)))
    (foreach d (cdr r) (princ (strcat "\n      " d)))
  )
)

;; Clipboard text: each line, details in a 4th column on the lines below
(defun em:spot-copytext (rows / l)
  (foreach r rows
    (setq l (cons (car r) l))
    (foreach d (cdr r) (setq l (cons (strcat "\t\t\t" d) l)))
  )
  (em:spot-join (reverse l) "\r\n")
)

;; Fills the details list for the selected row
(defun em:spot-showdet (i rows)
  (start_list "det")
  (mapcar 'add_list (cdr (nth i rows)))
  (end_list)
)

(defun c:SpotBit (/ *error* dcl id act rows lines hint fn r pub)
  (defun *error* (msg)
    (em:spot-error msg)
    (if id (unload_dialog id))
    (princ)
  )
  (if (not (setq dcl (findfile "SpotBit.dcl")))
    (alert "SpotBit.dcl not found.\nPlace it in the same folder as SpotBit.lsp and add that folder to the AutoCAD support path.")
    (progn
      (setq id   (load_dialog dcl)
            act  -1
            hint "Nothing compared yet.")
      (while (/= act 0)
        (if (not (new_dialog "spotbit" id))
          (setq act 0)
          (progn
            (setq lines (mapcar 'car rows))
            (start_list "lst")
            (mapcar 'add_list lines)
            (end_list)
            (start_list "det")
            (end_list)
            ;; first line selected, its details shown
            (if rows
              (progn
                (set_tile "lst" "0")
                (em:spot-showdet 0 rows)
              )
            )
            (set_tile "hint" hint)
            (mode_tile "copy" (if lines 0 1))
            (mode_tile "plot" (if lines 0 1))
            (action_tile "lst"   "(em:spot-showdet (atoi $value) rows)")
            (action_tile "cmp"   "(done_dialog 3)")
            (action_tile "plot"  "(done_dialog 4)")
            (action_tile "copy"
              "(set_tile \"hint\" (if (em:spot-clip (em:spot-copytext rows)) \"Copied to clipboard.\" \"Copy failed - the list is also on the command line (F2).\"))")
            (action_tile "close" "(done_dialog 0)")
            (setq act (start_dialog))
            (cond
              ((= act 4)
               (if (setq pub (em:spot-publish-prep lines id))
                 (setq act 0)
               )
              )
              ((= act 3)
               (if (setq fn (getfiled "SpotBit - select the previous version" (getvar "DWGPREFIX") "dwg" 0))
                 (progn
                   (setq r     (em:spot-compare fn)
                         rows  (if (caddr r)
                                 (em:spot-merge (em:spot-scan (car r) (caddr r)) (cadddr r)))
                         hint  (strcat (cadr r)
                                       (cond (rows (strcat " - " (itoa (length (em:spot-layouts-of (mapcar 'car rows))))
                                                           " layout(s) affected. Click a line for details."))
                                             ((car r) " - no viewport shows them.")
                                             ((caddr r) " No viewports changed.")
                                             (""))))
                   (em:spot-report hint rows)
                 )
               )
              )
            )
          )
        )
      )
      (unload_dialog id)
      ;; Started after SpotBit has ended
      (if pub
        (vla-SendCommand (vla-get-ActiveDocument (vlax-get-acad-object)) "_.PUBLISH ")
      )
    )
  )
  (princ)
)

;;; ---------------------------------------------------------------- diagnose
;;; SVDIAG: shows WHY objects are reported as changed (temporary, for tuning)

(defun em:spot-pairdiff (a b / r)
  (foreach x a
    (if (not (vl-some '(lambda (y) (equal x y 1e-8)) b)) (setq r (cons x r)))
  )
  (reverse r)
)

;; Prints what differs inside one block definition (old/new: (origin (h . fp) ...))
(defun em:spot-diagblock (bn old new / x n)
  (princ (strcat "\n\n--- BLOCK " bn))
  (cond
    ((null old) (princ "\n  new block"))
    (T
     (if (not (equal (car old) (car new) 1e-8))
       (progn (princ "\n  base point: ") (prin1 (car old)) (princ " -> ") (prin1 (car new))))
     (princ (strcat "\n  objects: old " (itoa (length (cdr old))) ", new " (itoa (length (cdr new)))))
     (setq n 0)
     (foreach e (cdr new)
       (setq x (assoc (car e) (cdr old)))
       (cond
         ((null x)
          (princ (strcat "\n  added handle " (car e) " " (vl-princ-to-string (cdr (assoc 0 (cdr e)))))))
         ((and (not (equal (cdr x) (cdr e) 1e-8)) (< n 3))
          (setq n (1+ n))
          (princ (strcat "\n  changed handle " (car e) " " (vl-princ-to-string (cdr (assoc 0 (cdr e))))))
          (princ "\n    old only: ") (prin1 (em:spot-pairdiff (cdr x) (cdr e)))
          (princ "\n    new only: ") (prin1 (em:spot-pairdiff (cdr e) (cdr x))))
       )
     )
     (foreach x (cdr old)
       (if (not (assoc (car x) (cdr new)))
         (princ (strcat "\n  deleted handle " (car x) " " (vl-princ-to-string (cdr (assoc 0 (cdr x))))))
       )
     )
     (if (and (= (length (cdr old)) (length (cdr new)))
              (vl-every '(lambda (e) (equal (cdr (assoc (car e) (cdr old))) (cdr e) 1e-8)) (cdr new)))
       (princ "\n  same objects, different ORDER (draw order inside the block)")
     ))
  )
)

(defun c:SVDIAG (/ *error* fn dbx oe ne ob nb ops nps lo chg o k types ptypes shown viablk)
  (defun *error* (msg) (em:spot-error msg) (princ))
  (if (not (setq fn (getfiled "SpotBit diagnose - select the previous version" (getvar "DWGPREFIX") "dwg" 0)))
    (princ "\nCancelled.")
    (if (not (setq dbx (em:spot-dbx-open fn)))
      (princ "\nCould not open the file (close it in AutoCAD first).")
      (progn
        (setq oe (em:spot-collect dbx "SVDIAG: reading previous version")
              ob (em:spot-blocks dbx "SVDIAG: reading previous blocks")
              ops (em:spot-pscollect dbx "SVDIAG: reading previous paper space"))
        (em:spot-release-dbx)
        (setq nps (em:spot-pscollect (vla-get-ActiveDocument (vlax-get-acad-object)) "SVDIAG: reading current paper space"))
        (setq ne     (em:spot-collect (vla-get-ActiveDocument (vlax-get-acad-object)) "SVDIAG: reading current drawing")
              nb     (em:spot-blocks (vla-get-ActiveDocument (vlax-get-acad-object)) "SVDIAG: reading current blocks")
              chg    (em:spot-changed-blocks ob nb)
              shown  0
              viablk 0)
        (princ (strcat "\nObjects: old " (itoa (length oe)) ", new " (itoa (length ne))))
        (princ (strcat "\nChanged block definitions: " (if chg (em:spot-join chg ", ") "none")))
        ;; For the first 3 changed blocks: what exactly differs inside
        (setq shown 0)
        (foreach bn chg
          (if (< shown 3)
            (progn
              (setq shown (1+ shown))
              (em:spot-diagblock bn (cdr (assoc bn ob)) (cdr (assoc bn nb)))
            )
          )
        )
        (foreach n ne
          (if (setq o (assoc (car n) oe))
            (cond
              ((not (equal (cadr o) (cadr n) 1e-8))
               (setq k (cond ((cdr (assoc 0 (cadr n)))) ("?")))
               (setq types (if (assoc k types)
                             (subst (cons k (1+ (cdr (assoc k types)))) (assoc k types) types)
                             (cons (cons k 1) types)))
               (if (<= (cdr (assoc k types)) 3)
                 (progn
                   (princ (strcat "\n\n--- " k " handle " (car n)))
                   (princ "\n  old only: ") (prin1 (em:spot-pairdiff (cadr o) (cadr n)))
                   (princ "\n  new only: ") (prin1 (em:spot-pairdiff (cadr n) (cadr o)))
                 )
               )
              )
              ((and (nth 4 n) (member (nth 4 n) chg))
               (setq viablk (1+ viablk)))
            )
          )
        )
        (princ "\n\nChanged per type (own data): ")
        (foreach t2 types (princ (strcat "\n  " (car t2) ": " (itoa (cdr t2)))))
        (princ (strcat "\nInserts flagged only via changed block definition: " (itoa viablk)))
        ;; Paper space, per layout matched by handle
        (foreach pl nps
          (if (setq lo (assoc (car pl) ops))
            (foreach n (caddr pl)
              (if (and (setq o (assoc (car n) (caddr lo)))
                       (not (equal (cadr o) (cadr n) 1e-8)))
                (progn
                  (setq k (cond ((cdr (assoc 0 (cadr n)))) ("?")))
                  (setq ptypes (if (assoc k ptypes)
                                 (subst (cons k (1+ (cdr (assoc k ptypes)))) (assoc k ptypes) ptypes)
                                 (cons (cons k 1) ptypes)))
                  (if (<= (cdr (assoc k ptypes)) 3)
                    (progn
                      (princ (strcat "\n\n--- PAPER SPACE '" (cadr pl) "' " k " handle " (car n)))
                      (princ "\n  old only: ") (prin1 (em:spot-pairdiff (cadr o) (cadr n)))
                      (princ "\n  new only: ") (prin1 (em:spot-pairdiff (cadr n) (cadr o)))
                    )
                  )
                )
              )
            )
          )
        )
        (princ "\n\nPaper space changed per type (own data): ")
        (foreach t2 ptypes (princ (strcat "\n  " (car t2) ": " (itoa (cdr t2)))))
      )
    )
  )
  (princ)
)

;; --- CompanionBits family alias ---
(defun c:SV () (c:SpotBit))

(princ "\nSpotBit loaded. Type SPOTBIT or SV to start.\n")
(princ)