; SmartBoundaryHatch v1.0
; Safe hatch helper for AutoCAD / AutoCAD LT 2026 (Windows)
; Command: SH
;
; DESIGN RULES
; - Never modifies original LINE/ARC/POLYLINE geometry.
; - Works on temporary copies only.
; - Uses a user pick point plus a user-configurable search window.
; - Cleans/join temp geometry, then asks AutoCAD BOUNDARY to create a closed polyline.
; - Hatches the resulting boundary only after a closed boundary exists.
; - Deletes temp geometry at the end.
;
; NOTE:
; Geometry in locked/frozen/off layers is intentionally ignored by the visible selection.

(vl-load-com)

(setq *SBH-Gap* nil)
(setq *SBH-Window* nil)

(defun SBH:_safe-getvar (v / r)
  (setq r (vl-catch-all-apply 'getvar (list v)))
  (if (vl-catch-all-error-p r) nil r)
)

(defun SBH:_safe-setvar (v x)
  (if (not (null x))
    (vl-catch-all-apply 'setvar (list v x))
  )
)

(defun SBH:_3d (p)
  (if (= (length p) 2) (append p '(0.0)) p)
)

(defun SBH:_bbox-window (p size / h)
  (setq h (/ size 2.0))
  (list
    (list (- (car p) h) (- (cadr p) h))
    (list (+ (car p) h) (+ (cadr p) h))
  )
)

(defun SBH:_delete-ss (ss / i e)
  (if ss
    (progn
      (setq i 0)
      (repeat (sslength ss)
        (setq e (ssname ss i))
        (if (and e (entget e)) (entdel e))
        (setq i (1+ i))
      )
    )
  )
)

(defun SBH:_entities-after (marker / ss e)
  (setq ss (ssadd))
  (setq e (if marker (entnext marker) (entnext)))
  (while e
    (ssadd e ss)
    (setq e (entnext e))
  )
  ss
)

(defun SBH:_copy-selection (ss / i e obj cp out)
  (setq out (ssadd))
  (if ss
    (progn
      (setq i 0)
      (repeat (sslength ss)
        (setq e (ssname ss i))
        (if (and e
                 (member (cdr (assoc 0 (entget e)))
                         '("LINE" "ARC" "CIRCLE" "ELLIPSE" "LWPOLYLINE" "POLYLINE" "SPLINE")))
          (progn
            (setq obj (vlax-ename->vla-object e))
            (setq cp (vl-catch-all-apply 'vla-copy (list obj)))
            (if (not (vl-catch-all-error-p cp))
              (ssadd (vlax-vla-object->ename cp) out)
            )
          )
        )
        (setq i (1+ i))
      )
    )
  )
  out
)

(defun SBH:_put-temp-layer (ss lay / i e o)
  (if ss
    (progn
      (setq i 0)
      (repeat (sslength ss)
        (setq e (ssname ss i))
        (if (and e (entget e))
          (progn
            (setq o (vlax-ename->vla-object e))
            (vl-catch-all-apply 'vla-put-Layer (list o lay))
          )
        )
        (setq i (1+ i))
      )
    )
  )
)

(defun SBH:_ensure-layer (name / doc lays r)
  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (setq lays (vla-get-Layers doc))
  (setq r (vl-catch-all-apply 'vla-Item (list lays name)))
  (if (vl-catch-all-error-p r)
    (vla-Add lays name)
    r
  )
)

(defun SBH:_closed-poly-p (e / d typ flg o val)
  (if (and e (setq d (entget e)))
    (progn
      (setq typ (cdr (assoc 0 d)))
      (cond
        ((= typ "LWPOLYLINE")
          (= 1 (logand 1 (cdr (assoc 70 d)))))
        ((= typ "POLYLINE")
          (= 1 (logand 1 (cdr (assoc 70 d)))))
        ((member typ '("CIRCLE" "ELLIPSE"))
          T)
        (T
          (progn
            (setq o (vlax-ename->vla-object e))
            (setq val (vl-catch-all-apply 'vlax-curve-isClosed (list o)))
            (if (vl-catch-all-error-p val) nil val)
          )
        )
      )
    )
  )
)

(defun SBH:_cleanup-created-except (ss keep / i e)
  (if ss
    (progn
      (setq i 0)
      (repeat (sslength ss)
        (setq e (ssname ss i))
        (if (and e (entget e) (/= e keep))
          (entdel e)
        )
        (setq i (1+ i))
      )
    )
  )
)

(defun SBH:_restore ()
  (SBH:_safe-setvar "CMDECHO" *SBH-old-cmdecho*)
  (SBH:_safe-setvar "HPGAPTOL" *SBH-old-hpgaptol*)
  (SBH:_safe-setvar "HPISLANDDETECTION" *SBH-old-hpisland*)
  (SBH:_safe-setvar "HPASSOC" *SBH-old-hpassoc*)
  (SBH:_safe-setvar "CLAYER" *SBH-old-layer*)
)

(defun SBH:_err (msg)
  (if *SBH-temp* (SBH:_delete-ss *SBH-temp*))
  (SBH:_restore)
  (if (and msg (/= msg "Function cancelled"))
    (princ (strcat "\nSmartHatch: " msg))
  )
  (princ)
)

(defun c:SH (/ *error* p vs gap win bb p1 p2 src tmp mark created boundary
               hatchMark hatchEnt newObjs ssf ans)
  (setq *error* SBH:_err)
  (setq *SBH-temp* nil)

  (setq *SBH-old-cmdecho* (getvar "CMDECHO"))
  (setq *SBH-old-hpgaptol* (SBH:_safe-getvar "HPGAPTOL"))
  (setq *SBH-old-hpisland* (SBH:_safe-getvar "HPISLANDDETECTION"))
  (setq *SBH-old-hpassoc* (SBH:_safe-getvar "HPASSOC"))
  (setq *SBH-old-layer* (getvar "CLAYER"))

  (setvar "CMDECHO" 0)

  (princ "\nSmartBoundaryHatch — click inside the area.")
  (setq p (getpoint "\nPick inside area: "))

  (if p
    (progn
      ; automatic defaults based on current view
      (setq vs (getvar "VIEWSIZE"))
      (if (null *SBH-Gap*) (setq *SBH-Gap* (* vs 0.00015)))
      (if (null *SBH-Window*) (setq *SBH-Window* (* vs 0.65)))

      ; Allow a quick Settings keyword without interrupting the one-click workflow
      (setq gap *SBH-Gap*)
      (setq win *SBH-Window*)

      (SBH:_ensure-layer "_SBH_TEMP_")
      (setq bb (SBH:_bbox-window p win))
      (setq p1 (car bb) p2 (cadr bb))

      ; visible/current-space geometry in a local window
      (setq src
        (ssget "_C" p1 p2
          '((-4 . "<OR")
              (0 . "LINE")
              (0 . "ARC")
              (0 . "CIRCLE")
              (0 . "ELLIPSE")
              (0 . "LWPOLYLINE")
              (0 . "POLYLINE")
              (0 . "SPLINE")
            (-4 . "OR>")
           ))
      )

      (if (or (null src) (= (sslength src) 0))
        (princ "\nNo nearby boundary geometry found.")
        (progn
          ; clone only: originals remain untouched
          (setq tmp (SBH:_copy-selection src))
          (setq *SBH-temp* tmp)
          (SBH:_put-temp-layer tmp "_SBH_TEMP_")

          ; Work on the temporary layer only
          (setvar "CLAYER" "_SBH_TEMP_")
          (SBH:_safe-setvar "HPGAPTOL" gap)
          (SBH:_safe-setvar "HPISLANDDETECTION" 0)
          (SBH:_safe-setvar "HPASSOC" 1)

          ; Try OVERKILL only on temporary copies.
          ; We deliberately feed only the temp selection.
          (vl-catch-all-apply
            '(lambda ()
               (command "_.-OVERKILL" tmp "" "" "" "" "" "")
             )
          )

          ; Try PEDIT JOIN only on temporary copies using gap as fuzz.
          (vl-catch-all-apply
            '(lambda ()
               (command "_.PEDIT" "_M" tmp "" "_Y" "_J" gap "" "")
             )
          )

          ; Ask BOUNDARY to create a real closed object.
          ; Boundary engine sees the cleaned temp geometry plus the originals,
          ; but only temp objects have been modified.
          (setq mark (entlast))
          (vl-catch-all-apply
            '(lambda ()
               (command "_.-BOUNDARY" p "")
             )
          )

          (setq created (SBH:_entities-after mark))
          (setq boundary nil)

          ; choose the first newly created closed curve
          (if created
            (progn
              (setq i 0)
              (while (and (< i (sslength created)) (null boundary))
                (setq e (ssname created i))
                (if (SBH:_closed-poly-p e) (setq boundary e))
                (setq i (1+ i))
              )
            )
          )

          (if boundary
            (progn
              ; Move clean boundary to user's original layer.
              (vla-put-Layer (vlax-ename->vla-object boundary) *SBH-old-layer*)

              ; Remove any other artifacts created by BOUNDARY.
              (SBH:_cleanup-created-except created boundary)

              ; Delete temporary repair geometry before hatching.
              (SBH:_delete-ss tmp)
              (setq *SBH-temp* nil)

              ; Hatch by selecting the validated boundary object.
              ; Using Select Objects avoids another unreliable point-boundary search.
              (setvar "CLAYER" *SBH-old-layer*)
              (setq hatchMark (entlast))
              (vl-catch-all-apply
                '(lambda ()
                   (command "_.HATCH" "_S" boundary "" "")
                 )
              )
              (setq hatchEnt (entnext hatchMark))

              (if hatchEnt
                (princ
                  (strcat
                    "\nDone. Clean boundary created + hatch applied."
                    "\nOriginal drawing geometry was not modified."
                    "\nAuto gap used: "
                    (rtos gap 2 6)
                  )
                )
                (princ
                  "\nClean boundary was created, but HATCH did not finish. Boundary has been kept."
                )
              )
            )
            (progn
              (SBH:_delete-ss tmp)
              (setq *SBH-temp* nil)
              (princ
                (strcat
                  "\nNo safe closed boundary found."
                  "\nNothing in the original drawing was modified."
                  "\nTry SHSET to increase Gap or Search Window."
                )
              )
            )
          )
        )
      )
    )
  )

  (SBH:_restore)
  (setq *error* nil)
  (princ)
)

(defun c:SHSET (/ g w)
  (princ "\nSmartBoundaryHatch settings")
  (if (null *SBH-Gap*) (setq *SBH-Gap* (* (getvar "VIEWSIZE") 0.00015)))
  (if (null *SBH-Window*) (setq *SBH-Window* (* (getvar "VIEWSIZE") 0.65)))

  (setq g (getdist
            (strcat "\nMaximum small-gap repair distance <"
                    (rtos *SBH-Gap* 2 6) ">: ")))
  (if g (setq *SBH-Gap* g))

  (setq w (getdist
            (strcat "\nLocal search window size <"
                    (rtos *SBH-Window* 2 3) ">: ")))
  (if w (setq *SBH-Window* w))

  (princ
    (strcat
      "\nGap = " (rtos *SBH-Gap* 2 6)
      " | Window = " (rtos *SBH-Window* 2 3)
    )
  )
  (princ)
)

(defun c:SHRESET ()
  (setq *SBH-Gap* nil)
  (setq *SBH-Window* nil)
  (princ "\nSmartBoundaryHatch automatic settings restored.")
  (princ)
)

(princ "\nSmartBoundaryHatch v1.0 loaded. Commands: SH, SHSET, SHRESET")
(princ)