;;; ---------------------------------------------------------------------------
;;; StrayHunt.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; Finds objects sitting at absurd coordinates, and takes you to them.
;;;
;;; THE PROBLEM THIS SOLVES
;;; A drawing whose geometry sits millions of units from the origin behaves
;;; badly: snaps become unreliable, hatches fail, dimensions drift, and display
;;; artefacts appear at high zoom. This happens because coordinate arithmetic
;;; is done in double precision, and the further from the origin you work, the
;;; fewer bits remain for the fractional part.
;;;
;;; Almost always the cause is not the drawing itself but ONE stray object -
;;; a point, a line, a piece of text - accidentally placed at some enormous
;;; coordinate, dragging the drawing extents out with it. ZOOM EXTENTS then
;;; zooms to a mostly empty rectangle and everything real becomes a dot.
;;;
;;; WHY THIS REPLACES A SIMPLE EXTENTS WARNING
;;; Checking EXTMIN and EXTMAX and popping an alert tells you that you have a
;;; problem. It does not tell you WHICH object causes it, and finding that by
;;; hand in a large drawing is genuinely difficult - the object is by
;;; definition somewhere you cannot see.
;;;
;;; This examines every object individually, lists the offenders by type and
;;; layer with their coordinates, and offers to select them and zoom to them so
;;; you can deal with them.
;;;
;;; COMMANDS
;;;   STRAYHUNT   - find and report objects at extreme coordinates
;;;   STRAYCHECK  - silent check, for loading at startup; prints a one-line
;;;                 warning only if there is something to report
;;;
;;; THE THRESHOLD
;;; StrayHunt:Limit below is the distance from the origin beyond which an
;;; object is considered stray. The default of 1e8 is deliberately generous -
;;; real survey coordinates can legitimately reach the millions, and flagging
;;; those would make the tool useless on exactly the drawings that need it.
;;; Lower it if you work purely in local coordinates.
;;; ---------------------------------------------------------------------------

(vl-load-com)

;;; ---------------------------------------------------------------------------
;;; SETTINGS
;;; ---------------------------------------------------------------------------

;; Distance from the origin beyond which an object is flagged.
(setq StrayHunt:Limit 1e8)

;; How many offenders to list individually before summarising the rest - a
;; drawing with four thousand stray points should not print four thousand
;; lines.
(setq StrayHunt:MaxReport 20)

;; ---------------------------------------------------------------------------
;; StrayHunt:Doc  -  cached active document
;; ---------------------------------------------------------------------------
(defun StrayHunt:Doc nil
    (eval (list 'defun 'StrayHunt:Doc 'nil
                (vla-get-activedocument (vlax-get-acad-object))
          )
    )
    (StrayHunt:Doc)
)

;; ---------------------------------------------------------------------------
;; StrayHunt:Extreme
;; ---------------------------------------------------------------------------
;; Returns the largest absolute ordinate of an object's bounding box, or nil if
;; it has no measurable extent.
;;
;; The bounding box is used rather than the insertion point because an object
;; can be anchored near the origin and still reach a long way - a line from
;; 0,0 to 10^9,0 has a perfectly reasonable start point.
;;
;; Both the request and the test are guarded: a few object types cannot report
;; a bounding box at all, and asking throws rather than returning nil.
;; ---------------------------------------------------------------------------
(defun StrayHunt:Extreme ( ent / obj lower upper )
    (if (and (setq obj (vlax-ename->vla-object ent))
             (vlax-method-applicable-p obj 'getboundingbox)
             (not (vl-catch-all-error-p
                      (vl-catch-all-apply 'vla-getboundingbox (list obj 'lower 'upper))
                  )
             )
        )
        (apply 'max
            (mapcar 'abs
                (append (vlax-safearray->list lower)
                        (vlax-safearray->list upper)
                )
            )
        )
    )
)

;; ---------------------------------------------------------------------------
;; StrayHunt:Scan
;; ---------------------------------------------------------------------------
;; Examines every object in the given space and returns the offenders as
;;
;;     ((entityName distance type layer) ...)
;;
;; sorted with the worst first, so the object doing the most damage is dealt
;; with first.
;;
;; space - [str] "Model", a layout name, or nil for the current space
;; ---------------------------------------------------------------------------
(defun StrayHunt:Scan ( space / filter sel idx ent enx dist found )

    (setq filter
        (if space
            (list (cons 410 space))
            (list (if (= 1 (getvar 'cvport))
                      (cons 410 (getvar 'ctab))
                     '(410 . "Model")
                  )
            )
        )
    )

    (if (setq sel (ssget "_X" filter))
        (repeat (setq idx (sslength sel))
            (setq ent (ssname sel (setq idx (1- idx)))
                  enx (entget ent)
            )
            (if (and (setq dist (StrayHunt:Extreme ent))
                     (< StrayHunt:Limit dist)
                )
                (setq found
                    (cons (list ent dist
                                (cdr (assoc 0 enx))
                                (cdr (assoc 8 enx))
                          )
                          found
                    )
                )
            )
        )
    )

    (vl-sort found (function (lambda ( a b ) (> (cadr a) (cadr b)))))
)

;; ---------------------------------------------------------------------------
;; StrayHunt:Report
;; ---------------------------------------------------------------------------
;; Prints the offenders, worst first, truncating a very long list.
;; ---------------------------------------------------------------------------
(defun StrayHunt:Report ( found / idx item )
    (princ (strcat "\n" (itoa (length found))
                   " object" (if (= 1 (length found)) "" "s")
                   " found beyond " (rtos StrayHunt:Limit 2 0)
                   " units from the origin:"
           )
    )
    (princ "\n------------------------------------------------------------")

    (setq idx 0)
    (foreach item found
        (if (< idx StrayHunt:MaxReport)
            (princ
                (strcat "\n  " (caddr item)
                        " on layer \"" (cadddr item) "\""
                        "  -  " (rtos (cadr item) 2 0) " units out"
                )
            )
        )
        (setq idx (1+ idx))
    )

    (if (< StrayHunt:MaxReport (length found))
        (princ (strcat "\n  ... and " (itoa (- (length found) StrayHunt:MaxReport)) " more."))
    )
    (princ "\n------------------------------------------------------------")
    (princ)
)

;; ---------------------------------------------------------------------------
;; c:STRAYHUNT  -  main routine
;; ---------------------------------------------------------------------------
(defun c:STRAYHUNT ( / *error* vars vals found sel item answer )

    ;; Read-only until the user explicitly asks for something: nothing is
    ;; created, modified or deleted, so no undo group is opened.
    (setq vars '("CMDECHO")
          vals (mapcar 'getvar vars)
    )

    (defun StrayHunt:Restore ( )
        (mapcar 'setvar vars vals)
        (princ)
    )

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

    (setvar "CMDECHO" 0)

    (princ "\nScanning for objects at extreme coordinates...")
    (setq found (StrayHunt:Scan nil))

    (if (null found)
        (princ (strcat "\nNothing found beyond " (rtos StrayHunt:Limit 2 0)
                       " units - this space is clean."
               )
        )
        (progn
            (StrayHunt:Report found)

            ;; ---------------------------------------------------------------
            ;; Offer to select them. They are gripped rather than deleted -
            ;; deciding what to do with a stray object is a judgement the user
            ;; must make, since it might be legitimate geometry someone put in
            ;; the wrong place rather than rubbish to be erased.
            ;; ---------------------------------------------------------------
            (initget "Yes No")
            (setq answer (getkword "\nSelect the offending objects? [Yes/No] <Yes>: "))

            (if (/= "No" answer)
                (progn
                    (setq sel (ssadd))
                    (foreach item found
                        (ssadd (car item) sel)
                    )
                    (sssetfirst nil sel)
                    (princ (strcat "\n" (itoa (sslength sel)) " objects selected and gripped."))

                    ;; Zooming to the worst offender is what actually lets the
                    ;; user see it - by definition it is nowhere near the rest
                    ;; of the drawing.
                    (initget "Yes No")
                    (if (/= "No" (getkword "\nZoom to the worst offender? [Yes/No] <Yes>: "))
                        (progn
                            (command "_.ZOOM" "_Object" (car (car found)) "")
                            (princ "\nZoomed to the furthest object. Use ZOOM Previous to return.")
                        )
                    )
                )
            )

            (princ "\n\nTo fix: erase anything unwanted, or MOVE the whole drawing")
            (princ "\nback towards the origin, then run AUDIT and re-save.")
        )
    )

    (StrayHunt:Restore)
    (princ)
)

;; ---------------------------------------------------------------------------
;; c:STRAYCHECK  -  quiet check, suitable for loading at startup
;; ---------------------------------------------------------------------------
;; Prints a single warning line only if something is wrong, and says nothing at
;; all otherwise - so it can sit in an acaddoc.lsp without adding noise to
;; every drawing you open.
;;
;; The check is deliberately cheap: it reads EXTMIN and EXTMAX rather than
;; examining every object, because a startup routine must not add a measurable
;; delay to opening a drawing. The full scan is only worth running once you
;; know there is something to find.
;;
;; The (-1.0E+20) test detects a drawing whose extents have never been set -
;; that is AutoCAD's "no extents yet" sentinel value, not a real coordinate,
;; and reporting it would produce a false alarm on every new drawing.
;; ---------------------------------------------------------------------------
(defun c:STRAYCHECK ( / *error* mn mx worst )

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

    (setq mn (getvar "EXTMIN")
          mx (getvar "EXTMAX")
    )

    (if (and mn mx
             (/= (car mx) -1.0E+20)
             (< StrayHunt:Limit
                (setq worst (apply 'max (mapcar 'abs (append mn mx))))
             )
        )
        (princ
            (strcat "\n** WARNING: this drawing extends "
                    (rtos worst 2 0)
                    " units from the origin, which will cause precision problems."
                    "\n** Run STRAYHUNT to find the objects responsible."
            )
        )
    )
    (princ)
)

(princ "\nStrayHunt loaded - type STRAYHUNT to find objects at extreme coordinates.")
(princ)