;;; ================================================================
;;; WallHatch Inside v1.5 GUI
;;; Commands: WHATCH / WALLHATCH
;;; AutoCAD / AutoCAD LT 2024+
;;;
;;; v1.5
;;; - Hatch thickness can be typed OR picked from drawing with 2 clicks.
;;; - ANSI31 is the default hatch pattern.
;;; - Supports CLOSED/OPEN LWPOLYLINE/POLYLINE, LINE and ARC.
;;; - Closed polylines hatch inward automatically.
;;; - Open curves ask for a side point, then hatch on that one side.
;;; - Temporary offset/end-cap boundaries are deleted after hatching.
;;; - Original polyline Global Width is adjustable in the dialog.
;;; - No Custom Pattern Name field.
;;; ================================================================

(vl-load-com)

;; -------------------- v1.5 session defaults -----------------------
(if (not *WH15-thk*) (setq *WH15-thk* 0.20))
(if (not *WH15-pat*) (setq *WH15-pat* "ANSI31"))
(if (not *WH15-scl*) (setq *WH15-scl* 1.0))
(if (not *WH15-ang*) (setq *WH15-ang* 45.0))
(if (not *WH15-gw*)  (setq *WH15-gw* 0.00))

;; --------------------------- helpers -------------------------------
(defun WH15:etype (e) (cdr (assoc 0 (entget e))))

(defun WH15:poly-p (e)
  (member (WH15:etype e) '("LWPOLYLINE" "POLYLINE")))

(defun WH15:closed-p (e / d f)
  (setq d (entget e))
  (cond
    ((member (cdr (assoc 0 d)) '("LWPOLYLINE" "POLYLINE"))
     (setq f (cdr (assoc 70 d)))
     (= 1 (logand 1 f)))
    (T nil)))

(defun WH15:valid-obj (e)
  (and e (member (WH15:etype e) '("LWPOLYLINE" "POLYLINE" "LINE" "ARC"))))

(defun WH15:area (e / o a)
  (setq o (vlax-ename->vla-object e))
  (setq a (vl-catch-all-apply 'vla-get-Area (list o)))
  (if (vl-catch-all-error-p a) nil a))

(defun WH15:offset-one (e dist / o r a lst)
  (setq o (vlax-ename->vla-object e))
  (setq r (vl-catch-all-apply 'vla-Offset (list o dist)))
  (if (vl-catch-all-error-p r)
    nil
    (progn
      (setq a (vlax-variant-value r))
      (setq lst (vlax-safearray->list a))
      (if lst (vlax-vla-object->ename (car lst)) nil))))

(defun WH15:del (e)
  (if (and e (entget e)) (entdel e)))

(defun WH15:dist2d (a b)
  (distance (list (car a) (cadr a)) (list (car b) (cadr b))))

(defun WH15:curve-midpoint (e / ep)
  (setq ep (vlax-curve-getEndParam e))
  (vlax-curve-getPointAtParam e (/ ep 2.0)))

(defun WH15:offset-score (off sidept / q)
  ;; Smaller distance from side point to offset curve is better.
  (setq q (vlax-curve-getClosestPointTo off sidept))
  (if q (distance q sidept) 1e99))

(defun WH15:make-inward-offset (e thk / a0 ep em ap am best)
  ;; Closed polyline: try both signs and keep the valid smaller-area loop.
  (setq a0 (WH15:area e))
  (if (or (null a0) (<= a0 0.0))
    nil
    (progn
      (setq ep (WH15:offset-one e thk))
      (setq em (WH15:offset-one e (- thk)))
      (setq ap (if ep (WH15:area ep) nil))
      (setq am (if em (WH15:area em) nil))
      (cond
        ((and ap (< ap a0) am (< am a0))
         ;; Keep the larger of the two smaller areas = nearest inward offset.
         (if (> ap am)
           (progn (setq best ep) (WH15:del em))
           (progn (setq best em) (WH15:del ep))))
        ((and ap (< ap a0)) (setq best ep) (WH15:del em))
        ((and am (< am a0)) (setq best em) (WH15:del ep))
        (T (WH15:del ep) (WH15:del em) (setq best nil)))
      best)))

(defun WH15:make-sided-offset (e thk sidept / ep em sp sm best)
  ;; Open curve: make both sides; keep the offset closest to user's side click.
  (setq ep (WH15:offset-one e thk))
  (setq em (WH15:offset-one e (- thk)))
  (cond
    ((and ep em)
     (setq sp (WH15:offset-score ep sidept))
     (setq sm (WH15:offset-score em sidept))
     (if (<= sp sm)
       (progn (setq best ep) (WH15:del em))
       (progn (setq best em) (WH15:del ep))))
    (ep (setq best ep))
    (em (setq best em))
    (T (setq best nil)))
  best)

(defun WH15:make-line (p1 p2)
  (entmakex
    (list
      '(0 . "LINE")
      (cons 10 p1)
      (cons 11 p2))))

(defun WH15:make-end-caps (orig off / a1 a2 b1 b2 c1 c2 dss dcr)
  ;; Pair endpoints in the orientation that gives the shorter total connector length.
  (setq a1 (vlax-curve-getStartPoint orig)
        a2 (vlax-curve-getEndPoint orig)
        b1 (vlax-curve-getStartPoint off)
        b2 (vlax-curve-getEndPoint off))
  (setq dss (+ (distance a1 b1) (distance a2 b2)))
  (setq dcr (+ (distance a1 b2) (distance a2 b1)))
  (if (<= dss dcr)
    (progn
      (setq c1 (WH15:make-line a1 b1))
      (setq c2 (WH15:make-line a2 b2)))
    (progn
      (setq c1 (WH15:make-line a1 b2))
      (setq c2 (WH15:make-line a2 b1))))
  (list c1 c2))

(defun WH15:hatch-by-objects (objs pat scl ang / vars before h ss)
  ;; Create non-associative hatch from a closed set of boundary objects.
  (setq vars
    (list
      (cons "HPASSOC" (getvar "HPASSOC"))
      (cons "HPNAME" (getvar "HPNAME"))
      (cons "HPSCALE" (getvar "HPSCALE"))
      (cons "HPANG" (getvar "HPANG"))
      (cons "HPISLANDDETECTION" (getvar "HPISLANDDETECTION"))))

  (setvar "HPASSOC" 0)
  (setvar "HPNAME" pat)
  (setvar "HPSCALE" scl)
  (setvar "HPANG" (* pi (/ ang 180.0)))
  (setvar "HPISLANDDETECTION" 0)

  (setq ss (ssadd))
  (foreach x objs (if (and x (entget x)) (ssadd x ss)))
  (setq before (entlast))
  (vl-catch-all-apply
    '(lambda () (vl-cmdf "_.-HATCH" "_S" ss "" "")))
  (setq h (entlast))

  (foreach p vars (setvar (car p) (cdr p)))

  (if (and h (/= h before) (entget h)
           (= "HATCH" (cdr (assoc 0 (entget h)))))
    h nil))

;; -------------------- polyline GLOBAL WIDTH ------------------------
(defun WH15:set-global-width-lwpoly (e w / d nd pair)
  (setq d (entget e) nd '())
  (foreach pair d
    (if (not (member (car pair) '(40 41 43)))
      (setq nd (cons pair nd))))
  (setq nd (reverse nd))
  (setq nd (append nd (list (cons 43 w))))
  (if (entmod nd) (progn (entupd e) T) nil))

(defun WH15:set-global-width-oldpoly (e w / n d)
  (setq n (entnext e))
  (while (and n (setq d (entget n)) (/= "SEQEND" (cdr (assoc 0 d))))
    (if (= "VERTEX" (cdr (assoc 0 d)))
      (progn
        (if (assoc 40 d)
          (setq d (subst (cons 40 w) (assoc 40 d) d))
          (setq d (append d (list (cons 40 w)))))
        (if (assoc 41 d)
          (setq d (subst (cons 41 w) (assoc 41 d) d))
          (setq d (append d (list (cons 41 w)))))
        (entmod d)))
    (setq n (entnext n)))
  (entupd e)
  T)

(defun WH15:set-global-width (e w / typ o r)
  (setq typ (WH15:etype e))
  (if (member typ '("LWPOLYLINE" "POLYLINE"))
    (progn
      (setq o (vlax-ename->vla-object e))
      (setq r (vl-catch-all-apply 'vla-put-ConstantWidth (list o w)))
      (if (not (vl-catch-all-error-p r))
        T
        (cond
          ((= typ "LWPOLYLINE") (WH15:set-global-width-lwpoly e w))
          ((= typ "POLYLINE")   (WH15:set-global-width-oldpoly e w))
          (T nil))))
    nil))

;; --------------------------- DCL GUI -------------------------------
(defun WH15:write-dcl (/ fn f lines)
  (setq fn (vl-filename-mktemp "WallHatch_v15.dcl"))
  (setq f (open fn "w"))
  (setq lines
    '("wallhatch : dialog {"
      "  label = \"Wall Hatch v1.5\";"
      "  : boxed_column {"
      "    label = \"Wall / Hatch Settings\";"
      "    : row {"
      "      : text { label = \"Wall hatch thickness:\"; width = 24; }"
      "      : edit_box { key = \"thk\"; edit_width = 10; }"
      "      : button { key = \"pickthk\"; label = \"Pick from drawing...\"; width = 18; fixed_width = true; }"
      "    }"
      "    : row {"
      "      : text { label = \"Original polyline Global Width:\"; width = 24; }"
      "      : edit_box { key = \"gw\"; edit_width = 10; }"
      "    }"
      "    : row {"
      "      : text { label = \"Hatch pattern:\"; width = 24; }"
      "      : popup_list { key = \"pat\"; width = 18; }"
      "    }"
      "    : row {"
      "      : text { label = \"Hatch scale:\"; width = 24; }"
      "      : edit_box { key = \"scl\"; edit_width = 10; }"
      "    }"
      "    : row {"
      "      : text { label = \"Hatch angle (deg):\"; width = 24; }"
      "      : edit_box { key = \"ang\"; edit_width = 10; }"
      "    }"
      "  }"
      "  : text { label = \"Closed polylines: inward automatically.\"; }"
      "  : text { label = \"Open polyline / line / arc: click the side to hatch.\"; }"
      "  : text { label = \"Temporary boundaries are deleted; only original object + hatch remain.\"; }"
      "  spacer;"
      "  ok_cancel;"
      "}"))
  (foreach s lines (write-line s f))
  (close f)
  fn)

(defun WH15:pattern-index (p / u)
  (setq u (strcase p))
  (cond
    ((= u "ANSI31") 0)
    ((= u "ANSI32") 1)
    ((= u "ANSI33") 2)
    ((= u "ANSI34") 3)
    ((= u "ANSI37") 4)
    ((= u "SOLID") 5)
    ((= u "AR-CONC") 6)
    (T 0)))

(defun WH15:index-pattern (i)
  (cond
    ((= i 0) "ANSI31")
    ((= i 1) "ANSI32")
    ((= i 2) "ANSI33")
    ((= i 3) "ANSI34")
    ((= i 4) "ANSI37")
    ((= i 5) "SOLID")
    ((= i 6) "AR-CONC")
    (T "ANSI31")))

(defun WH15:dialog-once (/ dclfile dclid rc pidx thkstr gwstr sclstr angstr)
  (setq dclfile (WH15:write-dcl))
  (setq dclid (load_dialog dclfile))
  (if (or (< dclid 0) (not (new_dialog "wallhatch" dclid)))
    (progn
      (if (>= dclid 0) (unload_dialog dclid))
      (if (findfile dclfile) (vl-file-delete dclfile))
      (alert "WallHatch dialog could not be loaded.")
      0)
    (progn
      (start_list "pat")
      (mapcar 'add_list '("ANSI31" "ANSI32" "ANSI33" "ANSI34" "ANSI37" "SOLID" "AR-CONC"))
      (end_list)

      (setq pidx (WH15:pattern-index *WH15-pat*))
      (set_tile "pat" (itoa pidx))
      (set_tile "thk" (rtos *WH15-thk* 2 4))
      (set_tile "gw"  (rtos *WH15-gw* 2 4))
      (set_tile "scl" (rtos *WH15-scl* 2 4))
      (set_tile "ang" (rtos *WH15-ang* 2 2))

      ;; Pick thickness: save current fields, close dialog with return code 2.
      (action_tile "pickthk"
        "(progn
           (setq thkstr (get_tile \"thk\"))
           (setq gwstr  (get_tile \"gw\"))
           (setq sclstr (get_tile \"scl\"))
           (setq angstr (get_tile \"ang\"))
           (setq pidx (atoi (get_tile \"pat\")))
           (done_dialog 2))")

      (action_tile "accept"
        "(progn
           (setq thkstr (get_tile \"thk\"))
           (setq gwstr  (get_tile \"gw\"))
           (setq sclstr (get_tile \"scl\"))
           (setq angstr (get_tile \"ang\"))
           (setq pidx (atoi (get_tile \"pat\")))
           (done_dialog 1))")
      (action_tile "cancel" "(done_dialog 0)")

      (setq rc (start_dialog))
      (unload_dialog dclid)
      (if (findfile dclfile) (vl-file-delete dclfile))

      ;; Preserve valid field edits for both OK and Pick.
      (if (member rc '(1 2))
        (progn
          (if (and thkstr (distof thkstr 2) (> (distof thkstr 2) 0.0))
            (setq *WH15-thk* (distof thkstr 2)))
          (if (and gwstr (distof gwstr 2) (>= (distof gwstr 2) 0.0))
            (setq *WH15-gw* (distof gwstr 2)))
          (if (and sclstr (distof sclstr 2) (> (distof sclstr 2) 0.0))
            (setq *WH15-scl* (distof sclstr 2)))
          (if (and angstr (distof angstr 2))
            (setq *WH15-ang* (distof angstr 2)))
          (setq *WH15-pat* (WH15:index-pattern pidx))))
      rc)))

(defun WH15:get-settings (/ rc d)
  ;; Re-open dialog after drawing-distance pick.
  (setq rc 2)
  (while (= rc 2)
    (setq rc (WH15:dialog-once))
    (if (= rc 2)
      (progn
        (princ "\nPick wall-hatch thickness with two points: ")
        (setq d (getdist))
        (if (and d (> d 0.0))
          (setq *WH15-thk* d)))))
  (= rc 1))

;; ---------------------- hatch one object --------------------------
(defun WH15:hatch-closed (e / inner h)
  (setq inner (WH15:make-inward-offset e *WH15-thk*))
  (if inner
    (progn
      (setq h (WH15:hatch-by-objects (list e inner) *WH15-pat* *WH15-scl* *WH15-ang*))
      (WH15:del inner)
      (if h T nil))
    nil))

(defun WH15:hatch-open (e / sidept off caps h)
  (princ "\nClick on the side of the object where the hatch should go: ")
  (setq sidept (getpoint))
  (if sidept
    (progn
      (setq off (WH15:make-sided-offset e *WH15-thk* sidept))
      (if off
        (progn
          (setq caps (WH15:make-end-caps e off))
          (setq h (WH15:hatch-by-objects
                    (append (list e off) caps)
                    *WH15-pat* *WH15-scl* *WH15-ang*))
          ;; Always remove generated offset and end caps.
          (WH15:del off)
          (foreach c caps (WH15:del c))
          (if h T nil))
        nil))
    nil))

;; --------------------------- main ----------------------------------
(defun WH15:run (/ *error* oldcmdecho ss i e typ ok fail skipped)
  (setq oldcmdecho (getvar "CMDECHO"))

  (defun *error* (msg)
    (setvar "CMDECHO" oldcmdecho)
    (if (and msg (/= msg "Function cancelled"))
      (princ (strcat "\nWallHatch error: " msg)))
    (princ))

  (if (WH15:get-settings)
    (progn
      (setvar "CMDECHO" 0)
      (princ "\nSelect closed/open polyline(s), line(s), or arc(s): ")
      (setq ss (ssget '((0 . "LWPOLYLINE,POLYLINE,LINE,ARC"))))
      (if ss
        (progn
          (setq i 0 ok 0 fail 0 skipped 0)
          (repeat (sslength ss)
            (setq e (ssname ss i))
            (if (WH15:valid-obj e)
              (progn
                ;; Global Width applies only to original polylines.
                (if (WH15:poly-p e)
                  (WH15:set-global-width e *WH15-gw*))

                (if (and (WH15:poly-p e) (WH15:closed-p e))
                  (if (WH15:hatch-closed e)
                    (setq ok (1+ ok))
                    (setq fail (1+ fail)))
                  (if (WH15:hatch-open e)
                    (setq ok (1+ ok))
                    (setq fail (1+ fail)))))
              (setq skipped (1+ skipped)))
            (setq i (1+ i)))

          (princ
            (strcat
              "\nWallHatch complete. Hatched=" (itoa ok)
              ", failed=" (itoa fail)
              ", skipped=" (itoa skipped)
              ". Temporary boundaries deleted.")))
        (princ "\nNothing selected."))
      (setvar "CMDECHO" oldcmdecho)))
  (princ))

(defun c:WHATCH () (WH15:run))
(defun c:WALLHATCH () (WH15:run))

(princ "\nWallHatch Inside v1.5 GUI loaded. Commands: WHATCH / WALLHATCH")
(princ)