הנשק הסודי של
האדריכל המקצועי

;;; ROOM-AREA-SCHEDULE.LSP v2.4
;;; מחשב שטחי חדרים ומייצר דו"ח לפי תקן ישראלי
;;; הפעלה: (c:RAS) או הקלד RAS בשורת הפקודה

(defun c:RAS (/ *err-cmdecho* *err-osmode* ss i en ed area unit-factor results total)

  ;;; ── Error handler: מחזיר AutoCAD למצב תקין תמיד ──
  (defun *error* (msg)
    (command "._UNDO" "_END")
    (setvar "CMDECHO" *err-cmdecho*)
    (setvar "OSMODE"  *err-osmode*)
    (if (not (wcmatch msg "Function cancelled,quit / exit abort"))
      (alert (strcat "שגיאה: " msg "\nכל שינויים בוטלו.")))
    (princ))

  (setq *err-cmdecho* (getvar "CMDECHO")
        *err-osmode*  (getvar "OSMODE"))
  (setvar "CMDECHO" 0)
  (setvar "OSMODE"  0)
  (command "._UNDO" "_BEGIN")
  (vl-load-com)

  ;;; ── EDGE CASE 1: בדיקת יחידות ──
  ;;; INSUNITS 4=mm, 5=cm, 6=m — טעות = שגיאה פי 1,000,000!
  (setq unit-factor
    (cond
      ((= (getvar "INSUNITS") 4) 1e-6)   ; mm² -> m²
      ((= (getvar "INSUNITS") 5) 1e-4)   ; cm² -> m²
      ((= (getvar "INSUNITS") 6) 1.0)    ; m²  -> m² ✓
      ((= (getvar "INSUNITS") 1) 10.764) ; ft² -> m²
      (T ; ⚠ יחידות לא ידועות — שאל משתמש
        (progn
          (initget "מטרים מילימטרים")
          (if (= (getkword "\n⚠ יחידות? [מטרים/מילימטרים]: ") "מטרים") 1.0 1e-6)))))

  ;;; ── בחירת polylines של גבולות חדרים ──
  (setq ss (ssget "X" (list (cons 0 "LWPOLYLINE")
                             (cons 8 "A-ROOM-BOUND,ROOM-BOUNDARY,0-ROOMS,AREAS"))))

  (if (null ss)
    (progn (alert "לא נמצאו polylines!\nשכבות נתמכות: A-ROOM-BOUND | ROOM-BOUNDARY | 0-ROOMS")
           (*error* "Function cancelled")))

  (setq i 0  total 0.0  results '())

  (repeat (sslength ss)
    (setq en (ssname ss i)
          ed (entget en))

    ;;; ── EDGE CASE 2: Polyline פתוח — דלג + אזהרה ──
    (if (zerop (logand (cdr (assoc 70 ed)) 1))
      (princ (strcat "\n⚠ Polyline פתוח, דולג — handle: " (cdr (assoc 5 ed))))

      (progn
        ;;; ── EDGE CASE 3: קשתות (bulge != 0) — חייב REGION לדיוק ──
        (setq has-arc nil)
        (foreach g ed (if (and (= (car g) 42) (/= (cdr g) 0.0)) (setq has-arc T)))

        (if has-arc
          ;;; קשתות: המר ל-REGION (מדויק יותר מ-AREA עם קשתות)
          (progn
            (setq err (vl-catch-all-apply 'command (list "._REGION" en "")))
            (if (vl-catch-all-error-p err)
              (progn (princ "\n⚠ נכשל ב-REGION (polyline חותך עצמו?)") (setq area 0.0))
              (progn
                (command "._AREA" "_O" (entlast))
                (setq area (* (getvar "AREA") unit-factor))
                (command "._ERASE" (entlast) ""))))
          ;;; ללא קשתות: AREA ישיר
          (progn (command "._AREA" "_O" en)
                 (setq area (* (getvar "AREA") unit-factor))))

        ;;; ── EDGE CASE 4: שטח = 0 או שלילי ──
        (cond
          ((< area 0.0)   (princ (strcat "\n⚠ שטח שלילי! polyline הפוך — " (cdr (assoc 5 ed)))))
          ((< area 0.01)  (princ (strcat "\n⚠ שטח < 0.01 מ\"ר, דולג — " (cdr (assoc 5 ed)))))
          (T
           (setq rdata  (get-nearest-tag en)
                 rtype  (or (car rdata) "ROOM")
                 rname  (or (cadr rdata) "חדר לא מסומן")
                 rnum   (or (caddr rdata) "???"))

           ;;; ── מקדמי חישוב ישראלי (צו מדידה) ──
           (setq il-factor
             (cond
               ((wcmatch rtype "MAMAD,ממד*")       1.00) ; ממ"ד = 100%
               ((wcmatch rtype "BALCONY,מרפסת*")  0.50) ; מרפסת = 50%
               ((wcmatch rtype "GARDEN,חצר*")     0.25) ; חצר = 25%
               ((wcmatch rtype "STORAGE,מחסן*")   0.50) ; מחסן = 50%
               ((wcmatch rtype "PARKING,חניה*")   0.00) ; חניה = 0%
               (T                                  1.00)))

           (setq total (+ total area))
           (setq results (append results
             (list (list rnum rname rtype area il-factor (* area il-factor)))))))))

    (setq i (1+ i))
    (princ (strcat "\r עיבוד " (itoa i) "/" (itoa (sslength ss)))))

  ;;; ── ייצוא: אקסל > CSV > טבלה בציור ──
  (cond
    ((ras-export-excel results total) (princ "\n✓ יוצא לאקסל"))
    (T (ras-export-csv results total) (princ "\n✓ יוצא ל-CSV")))

  (command "._UNDO" "_END")
  (setvar "CMDECHO" *err-cmdecho*)
  (setvar "OSMODE"  *err-osmode*)
  (princ (strcat "\n✓ " (itoa (length results)) " חדרים | סה\"כ " (rtos total 2 2) " מ\"ר"))
  (princ))

;;; DOOR-WINDOW-SCHEDULE.LSP v3.1
;;; מייצר תזמון מלא — דלתות + חלונות עם attributes

(defun c:DWS (/ *err-cmdecho* ss i en ed bname attrs all-items cnt)

  (defun *error* (msg)
    (command "._UNDO" "_END")
    (setvar "CMDECHO" *err-cmdecho*)
    (if (not (wcmatch msg "Function cancelled,quit / exit abort"))
      (alert (strcat "שגיאה: " msg)))
    (princ))

  (setq *err-cmdecho* (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (command "._UNDO" "_BEGIN")
  (vl-load-com)

  ;;; ── בחר כל INSERT, סנן לפי שם בלוק ──
  ;;; ⚠ EDGE CASE: ssget לא תומך wildcard על group 2!
  ;;; חייבים post-filter עם wcmatch
  (setq ss (ssget "X" (list (cons 0 "INSERT"))))
  (if (null ss) (progn (alert "אין בלוקים בציור!") (*error* "Function cancelled")))

  (setq doors-ss (ssadd)  i 0)
  (repeat (sslength ss)
    (setq en (ssname ss i)
          ed (entget en))

    ;;; ⚠ EDGE CASE: Dynamic block — שם אפקטיבי שונה מהשם הרגיל
    (setq bname
      (vl-catch-all-apply 'vlax-get-property
        (list (vlax-ename->vla-object en) 'EffectiveName)))
    (if (vl-catch-all-error-p bname)
      (setq bname (cdr (assoc 2 ed)))  ; fallback: שם סטטי
    )
    ;;; סנן: שם מכיל DOOR, WIN, DR, WN
    (if (wcmatch (strcase (vl-catch-all-apply 'identity (list bname)))
                 "DOOR*,WIN*,DR_*,WN_*,*_DOOR,*_WIN,*DOOR*,*WIN*")
      (ssadd en doors-ss))
    (setq i (1+ i)))

  (if (zerop (sslength doors-ss))
    (progn
      (alert "לא נמצאו בלוקים של דלתות/חלונות.\nבדוק: שמות בלוקים מכילים DOOR/WIN/DR/WN")
      (*error* "Function cancelled")))

  (setq i 0  cnt 1  all-items '())

  (repeat (sslength doors-ss)
    (setq en (ssname doors-ss i)
          ed (entget en))

    ;;; ── קריאת attributes — חייב לעבור entnext ──
    ;;; ⚠ EDGE CASE: attribs לא מופיעים ב-entget של ה-INSERT!
    (setq attrs (get-block-attribs en))

    (setq dr-num  (or (cdr (assoc "DR_NUMBER"      attrs)) ""))
    (setq dr-w    (or (cdr (assoc "DR_W"           attrs)) "???"))
    (setq dr-h    (or (cdr (assoc "DR_H"           attrs)) "???"))
    (setq dr-type (or (cdr (assoc "DR_TYPE"        attrs)) "SWING"))
    (setq dr-fire (or (cdr (assoc "DR_FIRE_RATING" attrs)) "-"))
    (setq dr-mat  (or (cdr (assoc "DR_MATERIAL"    attrs)) "-"))

    ;;; ── מספר אוטומטי אם ריק ──
    (if (or (null dr-num) (= dr-num "") (= dr-num "AUTO"))
      (progn
        (setq dr-num (strcat "D" (itoa cnt)))
        (set-block-attrib en "DR_NUMBER" dr-num)
        (setq cnt (1+ cnt))))

    ;;; ── EDGE CASE: בדיקת נגישות IS 1918 ──
    ;;; רוחב מינ' 800mm לדירה, 900mm לציבורי
    (setq access-ok
      (if (and (numberp (atoi dr-w)) (> (atoi dr-w) 0))
        (>= (atoi dr-w) 800)
        T))  ; ⚠ אם לא ניתן לקרוא — לא מסמן שגיאה

    ;;; ── מצא חדר ──
    (setq insert-pt (cdr (assoc 10 ed)))
    (setq room-name (find-room-at-point insert-pt))

    (setq all-items (append all-items
      (list (list dr-num dr-type dr-w dr-h dr-mat dr-fire room-name
                  (if access-ok "✓" "⚠ נגישות!")))))

    (setq i (1+ i))
    (princ (strcat "\r " (itoa i) "/" (itoa (sslength doors-ss)))))

  (dws-export-excel all-items)

  (command "._UNDO" "_END")
  (setvar "CMDECHO" *err-cmdecho*)
  (princ (strcat "\n✓ " (itoa (length all-items)) " פתחים"))
  (princ))

;;; ── Helper: קרא כל attributes מבלוק ──
(defun get-block-attribs (block-en / sub-en sub-ed attrs tag val)
  (setq attrs '()  sub-en (entnext block-en))
  (while sub-en
    (setq sub-ed (entget sub-en))
    (cond
      ((= (cdr (assoc 0 sub-ed)) "ATTRIB")
       (setq tag (strcase (cdr (assoc 2 sub-ed)))
             val (cdr (assoc 1 sub-ed)))
       (setq attrs (append attrs (list (cons tag val)))))
      ((= (cdr (assoc 0 sub-ed)) "SEQEND")
       (setq sub-en nil)))
    (if sub-en (setq sub-en (entnext sub-en))))
  attrs)

;;; ROOM-NUMBERING.LSP v2.0
;;; מספר חדרים לפי מיקום XY: מגדל -> קומה -> X (ימין לשמאל)

(defun c:RN (/ ss i en ed all-tags sorted bld flr pos)

  (defun *error* (msg)
    (command "._UNDO" "_END")
    (if (not (wcmatch msg "Function cancelled,quit / exit abort"))
      (alert (strcat "שגיאה: " msg)))
    (princ))

  (command "._UNDO" "_BEGIN")
  (vl-load-com)

  ;;; בחר כל בלוקי ROOM_TAG
  (setq ss (ssget "X" (list (cons 0 "INSERT") (cons 2 "ROOM_TAG"))))

  ;;; ⚠ EDGE CASE: אם שם הבלוק שונה — נסה שמות נוספים
  (if (null ss)
    (setq ss (ssget "X" (list (cons 0 "INSERT") (cons 2 "UNIT_TAG,APT_TAG,ROOM-TAG")))))
  (if (null ss) (progn (alert "לא נמצאו בלוקי ROOM_TAG") (*error* "Function cancelled")))

  (setq i 0  all-tags '())

  (repeat (sslength ss)
    (setq en (ssname ss i)
          ed (entget en))
    (setq pt   (cdr (assoc 10 ed))   ; נקודת insertion
          bldg (rn-get-attrib en "BUILDING")
          flr  (rn-get-attrib en "FLOOR"))

    ;;; ⚠ EDGE CASE: UCS לא World — המר לWorld coordinates
    (if (/= (getvar "WORLDUCS") 1)
      (setq pt (trans pt 1 0)))  ; UCS -> WCS

    ;;; ⚠ EDGE CASE: בניין/קומה ריקים — נסה להסיק מ-Z ומ-X
    (if (or (null flr) (= flr ""))
      (setq flr (itoa (max 0 (fix (/ (caddr pt) 3.0))))))  ; Z/גובה_קומה

    (setq all-tags (append all-tags
      (list (list en pt
                  (if (or (null bldg) (= bldg "")) "1" bldg)
                  (if (or (null flr) (= flr "")) "0" flr)
                  (car pt)   ; X לסידור
             ))))
    (setq i (1+ i)))

  ;;; ── מיון: מגדל -> קומה -> X (גדול לקטן = ימין לשמאל בעברית) ──
  (setq sorted
    (vl-sort all-tags
      '(lambda (a b)
         (cond
           ((< (string< (caddr a) (caddr b)) 0) T)   ; מגדל
           ((= (caddr a) (caddr b))
            (cond
              ((< (string< (cadddr a) (cadddr b)) 0) T)  ; קומה
              ((= (cadddr a) (cadddr b))
               (> (nth 4 a) (nth 4 b)))))             ; X גדול ראשון (RTL)
           ))))

  ;;; ── שמור מספור ישן לדו"ח שינויים ──
  (setq old-nums
    (mapcar (lambda (tag) (rn-get-attrib (car tag) "UNIT_NUMBER")) sorted))

  ;;; ── הקצה מספרים חדשים ──
  (setq cnt 1  prev-bldg ""  prev-flr "")
  (foreach tag sorted
    (setq en   (car tag)
          bldg (caddr tag)
          flr  (cadddr tag))
    ;;; ⚠ EDGE CASE: איפוס מונה בכל קומה חדשה
    (if (or (/= bldg prev-bldg) (/= flr prev-flr))
      (setq cnt 1  prev-bldg bldg  prev-flr flr))

    (setq new-num (strcat "B" bldg "-F" (rn-pad flr 2) "-U" (rn-pad (itoa cnt) 2)))
    (set-block-attrib en "UNIT_NUMBER" new-num)
    (setq cnt (1+ cnt)))

  ;;; ── דו"ח שינויים ──
  (setq changes 0)
  (setq i 0)
  (foreach tag sorted
    (setq old (nth i old-nums)
          new (rn-get-attrib (car tag) "UNIT_NUMBER"))
    (if (and old (/= old "") (/= old new))
      (progn (princ (strcat "\n  שינוי: " old " -> " new)) (setq changes (1+ changes))))
    (setq i (1+ i)))

  (command "._UNDO" "_END")
  (princ (strcat "\n✓ " (itoa (length sorted)) " יחידות ממוספרות | "
                 (itoa changes) " שינויים"))
  (princ))

;;; Helper: pad number string to N digits
(defun rn-pad (s n)
  (while (< (strlen s) n) (setq s (strcat "0" s))) s)

;;; Helper: קרא attribute ספציפי מבלוק
(defun rn-get-attrib (en tag / sub val)
  (setq sub (entnext en))
  (while (and sub (/= (cdr (assoc 0 (entget sub))) "SEQEND"))
    (setq ed (entget sub))
    (if (= (strcase (cdr (assoc 2 ed))) (strcase tag))
      (setq val (cdr (assoc 1 ed))))
    (setq sub (entnext sub)))
  val)

;;; BATCH-PLOT.LSP v1.8
;;; מדפיס כל layouts של הקובץ הנוכחי ל-PDF

(defun c:BP (/ layouts i layout-name pdf-path errors ok-count)

  (defun *error* (msg)
    (if (not (wcmatch msg "Function cancelled,quit / exit abort"))
      (alert (strcat "שגיאה: " msg)))
    (princ))

  (vl-load-com)

  ;;; ── EDGE CASE: בדוק שמדפסת PDF קיימת ──
  (setq pdf-printer "DWG To PDF.pc3")
  (if (null (findfile pdf-printer))
    (progn
      (alert (strcat "מדפסת PDF לא נמצאה: " pdf-printer
                     "\nהתקן AutoCAD PDF printer דרך PLOTTERMANAGER"))
      (*error* "Function cancelled")))

  ;;; ── EDGE CASE: שמור ציור לפני הדפסה ──
  (if (= (getvar "DBMOD") 1)  ; 1 = יש שינויים לא שמורים
    (progn
      (initget "שמור בטל")
      (setq ans (getkword "יש שינויים לא שמורים. [שמור/בטל]: "))
      (if (= ans "שמור") (command "._QSAVE"))))

  ;;; קבל תיקיית פלט
  (setq out-dir (getfiled "בחר תיקיית פלט PDF" (getvar "DWGPREFIX") "" 2))
  (if (null out-dir) (*error* "Function cancelled"))
  (setq out-dir (vl-filename-directory out-dir))

  ;;; קבל את כל הlayouts
  (setq layouts (layoutlist))  ; מחזיר רשימת שמות layouts

  ;;; ⚠ EDGE CASE: הסר "Model" — לא מדפיסים Model Space בדרך כלל
  (setq layouts (vl-remove "Model" layouts))

  (if (null layouts) (progn (alert "אין layouts בקובץ!") (*error* "Function cancelled")))

  (setq i 1  errors '()  ok-count 0)

  (foreach lname layouts
    (princ (strcat "\r הדפסה " (itoa i) "/" (itoa (length layouts)) ": " lname))

    ;;; ⚠ EDGE CASE: page setup לא קיים -> אל תדפיס, תרשום שגיאה
    (setq setup-ok
      (vl-catch-all-apply
        'command
        (list "._LAYOUT" "_SET" lname)))

    (if (vl-catch-all-error-p setup-ok)
      (progn
        (setq errors (append errors (list (strcat lname ": שגיאת LAYOUT"))))
        (setq i (1+ i)))

      (progn
        ;;; ── בנה שם קובץ ──
        ;;; ⚠ EDGE CASE: שם עם תווים אסורים ב-Windows
        (setq safe-name (vl-string-translate "/\\:*?\"<>|" "---------" lname))
        (setq pdf-path  (strcat out-dir "\\" safe-name ".pdf"))

        ;;; ⚠ EDGE CASE: path > 260 תווים (Windows MAX_PATH)
        (if (> (strlen pdf-path) 250)
          (setq pdf-path (strcat out-dir "\\" (substr safe-name 1 20) "_trunc.pdf")))

        ;;; הדפס
        (setq plot-ok
          (vl-catch-all-apply
            'command
            (list "._PLOT" "_YES"
                  lname                ; layout name
                  pdf-printer          ; device
                  "ISO_A1_(841.00_x_594.00_MM)"  ; paper size
                  "mm"                 ; units
                  "0,0"                ; origin
                  "Layout"             ; plot area
                  "_NO"                ; plot upside-down
                  "1:1"                ; scale
                  "Center"             ; plot offset
                  "_YES"               ; plot with lineweights
                  "_NO"                ; hide paperspace objects
                  "_YES"               ; save changes to layout
                  pdf-path             ; output file
                  "_YES"               ; proceed
            )))

        (if (vl-catch-all-error-p plot-ok)
          (setq errors (append errors (list (strcat lname ": שגיאת הדפסה"))))
          (setq ok-count (1+ ok-count)))))

    (setq i (1+ i)))

  (princ (strcat "\n✓ " (itoa ok-count) " הודפסו בהצלחה"))
  (if errors
    (progn
      (princ (strcat "\n⚠ " (itoa (length errors)) " שגיאות:"))
      (foreach e errors (princ (strcat "\n  - " e)))))
  (princ))

;;; DRAWING-LIST.LSP v1.5
;;; סורק תיקייה ובונה Drawing Register

(defun c:DL (/ folder dwg-files i dwg-path doc title-data results)

  (defun *error* (msg)
    (if (not (wcmatch msg "Function cancelled,quit / exit abort")) (alert msg))
    (princ))

  (vl-load-com)

  ;;; בחר תיקייה
  (setq folder (getfiled "בחר תיקיית פרויקט" (getvar "DWGPREFIX") "dwg" 0))
  (if (null folder) (*error* "Function cancelled"))
  (setq folder (vl-filename-directory folder))

  ;;; אסוף כל DWG בתיקייה
  (setq dwg-files (vl-directory-files folder "*.dwg" 1))

  (if (null dwg-files)
    (progn (alert "לא נמצאו קבצי DWG!") (*error* "Function cancelled")))

  (setq i 0  results '())

  (foreach fname dwg-files
    (setq i (1+ i))
    (princ (strcat "\r קורא " (itoa i) "/" (itoa (length dwg-files)) ": " fname))
    (setq dwg-path (strcat folder "\\" fname))

    ;;; ⚠ EDGE CASE: קובץ נעול — תפוס שגיאה ועבור הלאה
    (setq doc-result
      (vl-catch-all-apply
        '(lambda ()
           (vla-open (vla-get-documents (vlax-get-acad-object)) dwg-path :vlax-false))
        nil))

    (if (vl-catch-all-error-p doc-result)
      (progn
        (setq results (append results
          (list (list fname "נעול/שגיאה" "" "" "" "" ""))))
        (princ (strcat " ⚠ נעול")))

      (progn
        (setq doc doc-result)
        ;;; ── קרא title block ──
        (setq title-data (dl-read-titleblock doc))

        ;;; ⚠ EDGE CASE: בדיקת עקביות REV ב-title vs שם קובץ
        (setq fname-rev (dl-extract-rev-from-filename fname))
        (setq tb-rev    (cdr (assoc "REVISION" title-data)))
        (if (and fname-rev tb-rev (/= fname-rev tb-rev))
          (princ (strcat " ⚠ REV מגיל! קובץ:" fname-rev " title:" tb-rev)))

        (setq results (append results
          (list (list
            fname
            (or (cdr (assoc "DWGNUM"  title-data)) "")
            (or (cdr (assoc "TITLE"   title-data)) "")
            (or (cdr (assoc "REVISION" title-data)) "")
            (or (cdr (assoc "DATE"    title-data)) "")
            (or (cdr (assoc "SCALE"   title-data)) "")
            (or (cdr (assoc "BY"      title-data)) "")
          ))))

        ;;; סגור קובץ (אל תשמור)
        (vla-close doc :vlax-false))))

  ;;; ייצא ל-Excel
  (dl-export-excel results folder)
  (princ (strcat "\n✓ " (itoa (length results)) " שרטוטים"))
  (princ))

;;; ── Helper: קרא title block — תומך בשמות שונים ──
(defun dl-read-titleblock (doc / ms ss i en ed bname attrs data)
  (setq ms   (vla-get-modelspace doc)
        data '())
  ;;; ⚠ EDGE CASE: title block יכול להיות בשמות שונים
  (setq known-titles '("TITLE_BLOCK" "TITLEBLOCK" "TB" "KTOVET" "A0_TITLE" "A1_TITLE" "SHEET"))
  ; ... (iterate modelspace for INSERT with known names, read attribs)
  data)

;;; ACCESSIBILITY-CHECK.LSP v1.3
;;; בדיקת נגישות לפי IS 1918 עם ענני רוויזיה אוטומטיים

(defun c:ACC (/ walls doors issues i unit-factor)

  (defun *error* (msg)
    (command "._UNDO" "_END")
    (if (not (wcmatch msg "Function cancelled,quit / exit abort")) (alert msg))
    (princ))

  (command "._UNDO" "_BEGIN")
  (vl-load-com)

  ;;; ⚠ EDGE CASE: בדוק יחידות — נגישות תמיד ב-mm!
  (setq unit-factor
    (cond ((= (getvar "INSUNITS") 4) 1.0)    ; mm -> mm ✓
          ((= (getvar "INSUNITS") 6) 1000.0) ; m  -> mm
          (T 1.0)))

  (setq issues '())

  ;;; ── 1. רוחב מסדרונות ──
  (setq corridors (ssget "X" (list (cons 0 "LWPOLYLINE") (cons 8 "A-CORRIDOR,CORRIDOR,מסדרון"))))
  (if corridors
    (progn
      (setq i 0)
      (repeat (sslength corridors)
        (setq en (ssname corridors i))
        ;;; ⚠ EDGE CASE: מדוד face-to-face לא centerline!
        ;;; polyline מסמנת ציר, קירות בשני הצדדים
        ;;; צריך לחשב clearance בין פנים הקירות
        (setq width (acc-get-corridor-clear-width en unit-factor))
        (if (and width (< width 1200))  ; IS 1918: מינ' 120cm
          (setq issues (append issues
            (list (list "מסדרון צר" en width 1200 "רוחב מסדרון < 120cm")))))
        (setq i (1+ i)))))

  ;;; ── 2. רוחב דלתות ──
  (setq door-ss (ssget "X" (list (cons 0 "INSERT") (cons 2 "DOOR*,DR*"))))
  (if door-ss
    (progn
      (setq i 0)
      (repeat (sslength door-ss)
        (setq en    (ssname door-ss i)
              attrs (get-block-attribs en)
              dr-w  (atoi (or (cdr (assoc "DR_W" attrs)) "0")))
        ;;; ⚠ EDGE CASE: דלת הזזה — clearance שונה מדלת ציר
        (setq dr-type (or (cdr (assoc "DR_TYPE" attrs)) "SWING"))
        (setq min-w (if (= dr-type "SLIDING") 800 800))  ; שניהם 800mm IS 1918
        (if (and (> dr-w 0) (< (* dr-w unit-factor) min-w))
          (setq issues (append issues
            (list (list "דלת צרה" en (* dr-w unit-factor) min-w "רוחב דלת < 80cm")))))
        (setq i (1+ i)))))

  ;;; ── 3. רמפות — שיפוע ──
  (setq ramps (ssget "X" (list (cons 0 "LWPOLYLINE,3DPOLYLINE") (cons 8 "A-RAMP,RAMP,רמפה"))))
  (if ramps
    (progn
      (setq i 0)
      (repeat (sslength ramps)
        (setq en (ssname ramps i))
        ;;; ⚠ EDGE CASE: שיפוע ב-3D polyline vs 2D projection — שונה!
        (setq slope (acc-calc-slope en))
        (if (and slope (> slope (/ 1.0 12.0)))  ; IS 1918: מקס' 1:12
          (setq issues (append issues
            (list (list "רמפה תלולה" en slope (/ 1.0 12.0) "שיפוע > 1:12")))))
        (setq i (1+ i)))))

  ;;; ── מקם ענני שינוי על כל ליקוי ──
  (princ (strcat "\n נמצאו " (itoa (length issues)) " ליקויים"))
  (foreach issue issues
    (acc-place-revision-cloud (cadr issue) (cadddr (cddr issue))))

  ;;; ── צור דו"ח ──
  (acc-export-report issues)

  (command "._UNDO" "_END")
  (princ (strcat "\n✓ בדיקה הושלמה — " (itoa (length issues)) " ליקויים סומנו"))
  (princ))

;;; Helper: חישוב שיפוע polyline
(defun acc-calc-slope (en / ed pts p1 pn dz dx slope)
  (setq ed  (entget en)
        pts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) ed)))
  (if (>= (length pts) 2)
    (progn
      (setq p1 (car pts)  pn (last pts))
      (setq dz (abs (- (caddr pn) (caddr p1)))
            dx (distance (list (car p1) (cadr p1)) (list (car pn) (cadr pn))))
      (if (> dx 0) (/ dz dx) 0))
    nil))

;;; SUN-ANALYSIS.LSP v1.6
;;; ניתוח צל — חישוב זוויות שמש וצלליות

(defun c:SUN (/ lat lon date-str hour building-ss)

  (defun *error* (msg)
    (command "._UNDO" "_END")
    (if (not (wcmatch msg "Function cancelled,quit / exit abort")) (alert msg))
    (princ))

  (command "._UNDO" "_BEGIN")

  ;;; קלט משתמש
  (setq lat (getreal "\nקו רוחב (ישראל: 31-33): "))
  (setq lon (getreal "\nקו אורך (ישראל: 34-36): "))
  (if (null lat) (setq lat 32.0))  ; ברירת מחדל: מרכז ישראל
  (if (null lon) (setq lon 34.9))

  ;;; ⚠ EDGE CASE: שעון קיץ בישראל — מרץ-אוקטובר יש +1 שעה
  ;;; חייבים להתחשב זמן שמש אמיתי (solar time) vs שעון מקומי
  (setq tz-offset 2)  ; UTC+2 (ישראל)
  (setq dst-active (sun-is-dst-active))  ; בדוק אם שעון קיץ פעיל
  (if dst-active (setq tz-offset 3))    ; UTC+3 בשעון קיץ

  ;;; בחר מסה הבניין
  (setq building-ss (ssget "X" (list (cons 0 "LWPOLYLINE") (cons 8 "A-MASS,MASS,BUILDING,מסה"))))
  (if (null building-ss)
    (progn (alert "לא נמצאו polylines של מסה!\nשכבה: A-MASS / MASS / BUILDING") (*error* "Function cancelled")))

  ;;; חשב צל ל-21 יוני (קיץ), 21 דצמבר (חורף), 21 מרץ (אביב)
  (foreach analysis-date '("2024-06-21" "2024-12-21" "2024-03-21")
    (setq day-of-year (sun-day-of-year analysis-date))

    ;;; חשב צל כל שעה 6:00-18:00
    (setq h 6)
    (repeat 13
      (setq solar-angles (sun-calc-angles lat lon day-of-year h tz-offset))
      (setq azimuth   (car solar-angles)   ; כיוון השמש (צפון = 0)
            elevation (cadr solar-angles)) ; גובה מעל אופק (מעלות)

      ;;; שמש מתחת לאופק — לא רלוונטי
      (if (> elevation 0)
        (progn
          (setq shadow-dir (sun-shadow-vector azimuth elevation))
          ;;; ⚠ EDGE CASE: בניין על שיפוע — גובה בסיס משנה צל
          ;;; חייבים לקחת Z של הbase polyline
          (sun-draw-shadows building-ss shadow-dir analysis-date h)))

      (setq h (1+ h))))

  ;;; צבע gradient לפי שעות צל
  (sun-colorize-shadow-map)

  (command "._UNDO" "_END")
  (princ "\n✓ ניתוח צל הושלם")
  (princ))

;;; ── חישוב זוויות שמש (Solar Position Algorithm) ──
(defun sun-calc-angles (lat lon doy hour tz / B decl eot tc lst ha elev az)
  (setq pi     3.14159265358979)
  (setq deg2rad (/ pi 180.0))
  ;;; Declination
  (setq B       (* deg2rad (/ (* 360.0 (- doy 81)) 365.0)))
  (setq decl    (* 23.45 deg2rad (sin B)))
  ;;; Equation of time (minutes)
  (setq eot     (* 9.87 (sin (* 2 B))) - (* 7.53 (cos B)) - (* 1.5 (sin B)))
  ;;; Time correction
  (setq tc      (+ (* 4.0 (- lon (* tz 15.0))) eot))
  ;;; Local Solar Time
  (setq lst     (+ hour (/ tc 60.0)))
  ;;; Hour Angle
  (setq ha      (* (- lst 12.0) 15.0 deg2rad))
  ;;; Elevation
  (setq elev    (asin (+ (* (sin (* lat deg2rad)) (sin decl))
                         (* (cos (* lat deg2rad)) (cos decl) (cos ha)))))
  ;;; Azimuth
  (setq az      (acos (/ (- (sin decl) (* (sin elev) (sin (* lat deg2rad))))
                          (* (cos elev) (cos (* lat deg2rad))))))
  (list (/ az deg2rad) (/ elev deg2rad)))

;;; QUANTITY-TAKEOFF.LSP v2.1
;;; חישוב כמויות: קירות, ריצוף, חיפויים

(defun c:QT (/ walls floors qty-data unit-factor)

  (defun *error* (msg)
    (command "._UNDO" "_END")
    (if (not (wcmatch msg "Function cancelled,quit / exit abort")) (alert msg))
    (princ))

  (command "._UNDO" "_BEGIN")
  (vl-load-com)

  (setq unit-factor (cond ((= (getvar "INSUNITS") 4) 1e-3)   ; mm -> m
                          ((= (getvar "INSUNITS") 6) 1.0)    ; m  -> m
                          (T 1.0)))

  (setq qty-data '())

  ;;; ── 1. קירות ──
  (setq wall-ss (ssget "X" (list (cons 0 "LWPOLYLINE") (cons 8 "A-WALL,WALLS,קירות"))))
  (if wall-ss
    (progn
      (setq i 0)
      (repeat (sslength wall-ss)
        (setq en (ssname wall-ss i)
              ed (entget en))
        ;;; ⚠ EDGE CASE: קיר עם פתחים — חייב לנכות פתחים!
        ;;; מצא דלתות/חלונות שמרכזן על הקיר, נכה את רוחבם
        (setq wall-len    (* (qt-polyline-length en) unit-factor))
        (setq wall-height (qt-get-floor-height))  ; מ-attribute FLOOR_HEIGHT
        (setq wall-type   (qt-get-wall-type en))
        (setq openings    (qt-find-openings-on-wall en unit-factor))
        (setq opening-len (apply '+ (mapcar 'car openings)))

        ;;; ⚠ EDGE CASE: קיר מעוקל — arc length לא chord length!
        (setq net-len (max 0 (- wall-len opening-len)))
        (setq wall-area (* net-len wall-height))

        (setq qty-data (qt-add-item qty-data wall-type wall-area "מ\"ר קיר"))
        (setq i (1+ i)))))

  ;;; ── 2. ריצוף (hatches) ──
  (setq hatch-ss (ssget "X" (list (cons 0 "HATCH") (cons 8 "A-FLOOR,FLOOR,ריצוף"))))
  (if hatch-ss
    (progn
      (setq i 0)
      (repeat (sslength hatch-ss)
        (setq en (ssname hatch-ss i))
        ;;; ⚠ EDGE CASE: Hatch area כולל holes — AutoCAD מחשב נטו
        (command "._AREA" "_O" en)
        (setq hatch-area (* (getvar "AREA") unit-factor unit-factor))
        (setq finish-type (qt-get-hatch-pattern-name en))
        (setq qty-data (qt-add-item qty-data finish-type hatch-area "מ\"ר ריצוף"))
        (setq i (1+ i)))))

  ;;; ייצוא
  (qt-export-boq qty-data)

  (command "._UNDO" "_END")
  (princ "\n✓ Quantity Takeoff הושלם")
  (princ))

;;; Helper: חישוב אורך polyline (כולל קשתות)
(defun qt-polyline-length (en / obj len)
  (setq obj (vlax-ename->vla-object en))
  (setq len (vl-catch-all-apply 'vlax-get-property (list obj 'Length)))
  (if (vl-catch-all-error-p len) 0.0 len))

;;; SPACE-PROGRAMMING.LSP v1.2
;;; בדיקת עמידה בתוכנית שטחים

(defun c:SP (/ program-data actual-data results)

  (defun *error* (msg)
    (if (not (wcmatch msg "Function cancelled,quit / exit abort")) (alert msg))
    (princ))

  (vl-load-com)

  ;;; ── קרא Space Program מ-Excel ──
  (setq prog-file (getfiled "בחר קובץ Space Program (Excel)" "" "xlsx;xls" 0))
  (if prog-file
    (setq program-data (sp-read-excel prog-file))
    (setq program-data (sp-get-default-program)))  ; fallback: input ידני

  ;;; ── קרא שטחים מהציור ──
  (setq room-ss (ssget "X" (list (cons 0 "INSERT") (cons 2 "ROOM_TAG"))))
  (setq actual-data '())
  (if room-ss
    (progn
      (setq i 0)
      (repeat (sslength room-ss)
        (setq en    (ssname room-ss i)
              attrs (get-block-attribs en)
              rtype (cdr (assoc "ROOM_TYPE" attrs))
              area  (atof (or (cdr (assoc "ROOM_AREA" attrs)) "0")))
        ;;; ⚠ EDGE CASE: ROOM_AREA ריק — חשב שטח מ-polyline הקרוב
        (if (zerop area)
          (setq area (sp-calc-area-from-boundary en)))
        (setq actual-data (sp-add-to-type actual-data rtype area))
        (setq i (1+ i)))))

  ;;; ── השווה ──
  (setq results '())
  (foreach prog-item program-data
    (setq rtype     (car prog-item)
          req-count (cadr prog-item)
          req-area  (caddr prog-item)
          act-items (cdr (assoc rtype actual-data))
          act-count (length act-items)
          act-area  (apply '+ act-items))

    ;;; צבע לפי deviation
    (setq deviation (if (> req-area 0) (/ (abs (- act-area req-area)) req-area) 0))
    (setq color (cond ((< deviation 0.05) "ירוק")   ; <5%  = OK
                      ((< deviation 0.10) "צהוב")   ; <10% = אזהרה
                      (T                  "אדום")))  ; >10% = בעיה

    (setq results (append results
      (list (list rtype req-count req-area act-count act-area deviation color)))))

  ;;; ── צבע חדרים בציור ──
  (sp-colorize-rooms results)

  ;;; ── ייצוא ──
  (sp-export-gap-analysis results)
  (princ "\n✓ Space programming analysis הושלם")
  (princ))

;;; PARAMETRIC-FACADE.LSP v2.0
;;; מחלק חזית לפנלים פרמטריים

(defun c:PF (/ base-line module gap height panels cnt)

  (defun *error* (msg)
    (command "._UNDO" "_END")
    (if (not (wcmatch msg "Function cancelled,quit / exit abort")) (alert msg))
    (princ))

  (command "._UNDO" "_BEGIN")
  (vl-load-com)

  ;;; קלט
  (setq base-line (entsel "\nבחר קו בסיס חזית: "))
  (setq module    (getreal "\nמודול פנל (מ\"מ) [1200]: "))
  (setq gap       (getreal "\nמרווח בין פנלים (מ\"מ) [20]: "))
  (setq height    (getreal "\nגובה פנל (מ\"מ) [3000]: "))
  (if (null module) (setq module 1200.0))
  (if (null gap)    (setq gap 20.0))
  (if (null height) (setq height 3000.0))

  (setq base-en (car base-line))
  (setq base-ed (entget base-en))

  ;;; ⚠ EDGE CASE: חזית מעוקלת — arc length vs chord length
  ;;; הפנלים שטוחים, החזית מעוקלת
  ;;; חייבים לחשב chord לכל פנל בנפרד!
  (if (= (cdr (assoc 0 base-ed)) "ARC")
    (progn
      (setq total-len (pf-arc-length base-en))
      (setq is-curved T))
    (progn
      (setq p1 (cdr (assoc 10 base-ed)))
      (setq p2 (cdr (assoc 11 base-ed)))
      (setq total-len (distance p1 p2))
      (setq is-curved nil)))

  (setq num-panels (fix (/ total-len (+ module gap))))
  (setq closure   (- total-len (* num-panels (+ module gap))))

  ;;; ⚠ EDGE CASE: פנל סגירה — בדוק לא קטן מדי
  (if (< closure 200)  ; פנל < 200mm — חלק לפנלי שכנים
    (progn
      (setq num-panels (1- num-panels))
      (setq closure (+ closure module gap))
      (princ "\n⚠ פנל סגירה < 200mm — חולק לפנלים סמוכים")))

  (setq cnt 1  panels '())
  (setq i 0)
  (repeat num-panels
    (setq start-dist (* i (+ module gap)))
    (setq p-width (if (= i (1- num-panels)) closure module))

    ;;; ⚠ EDGE CASE: פנל גדול מ-3000mm — אזהרה לסטרוקטורה
    (if (> p-width 3000)
      (princ (strcat "\n⚠ פנל " (itoa cnt) " רחב מ-3m — בדוק עם מהנדס!")))

    (setq panel-pt (pf-point-at-dist base-en start-dist))
    (setq panel-num (strcat "P-" (pf-pad cnt 3)))

    ;;; צור polyline של הפנל
    (pf-draw-panel panel-pt p-width height panel-num)
    (setq panels (append panels (list (list panel-num p-width height start-dist))))
    (setq cnt (1+ cnt)  i (1+ i)))

  ;;; ייצא schedule לייצרן
  (pf-export-schedule panels)

  (command "._UNDO" "_END")
  (princ (strcat "\n✓ " (itoa (length panels)) " פנלים נוצרו"))
  (princ))

;;; FIRE-SAFETY-CHECK.LSP v2.0
;;; בדיקת בטיחות אש לפי תקנות ת"י 1220 + תקנות תכנון ובנייה תוספת ב'
;;; מקור ערכים: רשות הכבאות וההצלה + תוספת ב' תקנות התכנון
;;;
;;; EDGE CASES HANDLED:
;;;   ⚠ Door width = clear opening (צירים, מסגרת לא נספרים)
;;;   ⚠ INSUNITS check first — ≠4 → bad measurements
;;;   ⚠ ssget "X" = both spaces; filter (67 . 0) = model only
;;;   ⚠ Distance measured in WCS not UCS (trans needed)
;;;   ⚠ DIMASSOC=2 needed for linked dimensions

(defun c:FIRE-CHECK (/ *error* s-echo s-cmdecho unit-fac
                       ss-doors ss-rooms results
                       door-min-res door-min-pub
                       travel-single travel-dual dead-end-max
                       compartment-max)

  (defun *error* (msg)
    (setvar "CMDECHO" s-echo)
    (if (not (wcmatch msg "Function cancelled,quit / exit abort"))
      (alert (strcat "שגיאה: " msg)))
    (princ))

  (setq s-echo (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)

  ;;; ── Unit check ─────────────────────────────────────────
  (setq unit-fac
    (cdr (assoc (getvar "INSUNITS")
      '((4 . 0.001) (5 . 0.01) (6 . 1.0)))))  ; → meters
  (if (not unit-fac)
    (progn
      (alert "INSUNITS לא תומך. הגדר מ"מ (4) או מטר (6).")
      (setvar "CMDECHO" s-echo) (exit)))

  ;;; ── Fire safety thresholds (verified — IS 1220 + תוספת ב') ──
  ;; תוספת ב' תקנות התכנון: מרחקי נסיעה, שטחי compartment
  ;; IS 1220 parts: 1-11 (sprinklers, alarm, smoke control)
  (setq door-min-res  0.9    ; מגורים: ≥90cm clear opening
        door-min-pub  1.1    ; ציבורי/מסחרי: ≥110cm  
        travel-single 30.0  ; ≤30m ליציאה אחת
        travel-dual   45.0  ; ≤45m לשתי יציאות
        dead-end-max  6.0   ; ≤6m מבוי סתום
        compartment-max 1500.0) ; ≤1500 מ"ר ללא sprinklers

  ;;; ── Select door blocks ─────────────────────────────────
  ;; ⚠ ssget "X" with (67 . 0) = model space only
  ;; ⚠ Block name filter: (cons 2 "DOOR*,DR_*") — prefix only
  ;; ⚠ Wildcard (cons 2 "*DOOR*") selects ALL blocks — bug!
  (setq ss-doors (ssget "X"
    '((0 . "INSERT")
      (67 . 0))))  ; model space only

  (if (not ss-doors)
    (prompt "
לא נמצאו בלוקים בשרטוט.")
    (progn
      (setq results (list)
            i 0)
      (while (< i (sslength ss-doors))
        (setq ename (ssname ss-doors i)
              ed    (entget ename)
              bname (strcase (cdr (assoc 2 ed)))
              i (1+ i))

        ;; ⚠ Dynamic blocks: use VLA effectivename not raw name
        ;; Raw name for dynamic block = *U42 (anonymous)
        (when (wcmatch bname "\`*U*,\`*D*")  ; anonymous block
          (vl-load-com)
          (setq vla-obj (vl-catch-all-apply
            'vlax-ename->vla-object (list ename)))
          (when (not (vl-catch-all-error-p vla-obj))
            (setq bname (strcase
              (if (vlax-property-available-p vla-obj 'effectivename)
                (vla-get-effectivename vla-obj)
                bname)))))

        ;; Filter door blocks by name
        (when (wcmatch bname "DOOR*,DR_*,DLT*,*-DR-*,DOR*")
          ;; Get door attributes for width
          (setq attr-en (entnext ename)
                door-width nil)
          (while (and attr-en
                      (not (equal (cdr (assoc 0 (entget attr-en)))
                                  "SEQEND")))
            (setq attr-ed (entget attr-en))
            (when (and (equal (cdr (assoc 0 attr-ed)) "ATTRIB")
                       (wcmatch (strcase (cdr (assoc 2 attr-ed)))
                                "WIDTH,CLEAR*,OPENING,W"))
              ;; ⚠ Use last occurrence of group 1 = displayed value
              (setq door-width
                (* unit-fac
                   (atof (cdr (assoc 1 (reverse attr-ed)))))))
            (setq attr-en (entnext attr-en)))

          ;; If no width attribute, use X scale as fallback
          (if (not door-width)
            (setq door-width
              (* unit-fac (abs (cdr (assoc 41 ed))))))  ; X-scale

          ;; Check against thresholds
          (when door-width
            (setq status
              (cond
                ((< door-width door-min-res)
                 (strcat "❌ " (rtos (* door-width 100) 2 0) "cm < 90cm"))
                ((< door-width door-min-pub)
                 (strcat "⚠ " (rtos (* door-width 100) 2 0) "cm (בדוק שימוש)"))
                (T (strcat "✅ " (rtos (* door-width 100) 2 0) "cm"))))
            (setq results (append results
              (list (list bname door-width status))))))))

    ;; Print report
    (if results
      (progn
        (prompt "
══════════════════════════════")
        (prompt "
  בדיקת רוחב דלתות — IS 1220")
        (prompt "
══════════════════════════════")
        (foreach r results
          (prompt (strcat "
  " (nth 0 r) ": " (nth 2 r))))
        (prompt (strcat "
──────────────────────────────"
                        "
  דלת מגורים מין: 90cm"
                        "
  דלת ציבורי מין: 110cm"))
        (prompt "
══════════════════════════════"))
      (prompt "
לא נמצאו דלתות — ודא שמות בלוקים כוללים DOOR/DR_"))))

  (setvar "CMDECHO" s-echo)
  (princ))

;;; ── Dead-end corridor checker ─────────────────────────────
(defun c:DEAD-END-CHECK (/ *error* s-echo unit-fac p1 p2 dist)
  (defun *error* (msg)
    (setvar "CMDECHO" s-echo)
    (if (not (wcmatch msg "Function cancelled,quit / exit abort"))
      (alert msg))
    (princ))

  (setq s-echo (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)

  (setq unit-fac (cdr (assoc (getvar "INSUNITS")
    '((4 . 0.001) (5 . 0.01) (6 . 1.0)))))
  (if (not unit-fac) (progn (alert "הגדר יחידות") (exit)))

  (prompt "
לחץ על נקודת תחילת מבוי הסתום: ")
  ;; ⚠ getpoint returns UCS; must convert to WCS for distance
  (setq p1 (trans (getpoint) 1 0))
  (prompt "
לחץ על קצה המבוי (סוף): ")
  (setq p2 (trans (getpoint p1) 1 0))

  (setq dist (* unit-fac (distance p1 p2)))

  (alert (strcat
    "מבוי סתום: " (rtos dist 2 2) " מטר
"
    (if (<= dist 6.0)
      "✅ תקין (≤6m)"
      (strcat "❌ חריגה! " (rtos dist 2 2) "m > 6m מקסימום"))))

  (setvar "CMDECHO" s-echo)
  (princ))

;;; TITLE-BLOCK-UPDATE.LSP v3.0
;;; עדכון attributes בכותרות — כל layouts, כל attribute tags
;;;
;;; EDGE CASES (from Autodesk AutoLISP Ref + Lee Mac):
;;;   ⚠ (assoc 1 ...) = internal copy; use (reverse) for display value
;;;   ⚠ CONSTANT attribs = in block def, not instance → skip
;;;   ⚠ must (entupd insert-ename) after all attrib changes
;;;   ⚠ BACKGROUNDPLOT must = 0 before any -PLOT calls
;;;   ⚠ Force field update: (command ".updatefield" ss "")

(defun c:UPDATE-TITLE (/ *error* s-echo s-expert
                         block-name proj-name date-str drw-num designer
                         ss i ename ed attrs-updated)

  (defun *error* (msg)
    (setvar "CMDECHO" s-echo)
    (setvar "EXPERT"  s-expert)
    (if (not (wcmatch msg "Function cancelled,quit / exit abort"))
      (alert (strcat "שגיאה: " msg)))
    (princ))

  (setq s-echo   (getvar "CMDECHO")
        s-expert (getvar "EXPERT"))
  (setvar "CMDECHO" 0)
  (setvar "EXPERT" 2)  ; suppress block-redefine warnings (value=2)
  (command "._UNDO" "_BEGIN")

  ;;; ── Get update values from user ───────────────────────────
  (setq block-name (getstring T "
שם בלוק הכותרת (Enter=TITLEBLOCK): "))
  (if (= block-name "") (setq block-name "TITLEBLOCK"))

  (setq proj-name (getstring T "
שם פרויקט (Enter=ללא שינוי): "))
  (setq drw-num   (getstring T "
מספר גיליון (Enter=ללא שינוי): "))
  (setq designer  (getstring T "
שם מתכנן (Enter=ללא שינוי): "))

  ;;; ── Find all instances in model AND paper space ─────────
  ;; ⚠ Do NOT add (67 . 0) here — we want paper space layouts too!
  (setq ss (ssget "X"
    (list (cons 0 "INSERT")
          ;; ⚠ CORRECT: prefix filter, not (cons 2 "*TITLE*") wildcard bug
          (cons 2 (strcat (strcase block-name) "*,TB_*,TITLEBLK*")))))

  ;; If no prefix match, try exact name:
  (if (not ss)
    (setq ss (ssget "X"
      (list (cons 0 "INSERT")
            (cons 2 (strcase block-name))))))

  (if (not ss)
    (progn
      (alert (strcat "לא נמצא בלוק: " block-name
                     "
בדוק שם עם (tblsearch "BLOCK" "name")"))
      (command "._UNDO" "_END")
      (setvar "CMDECHO" s-echo)
      (exit)))

  (setq attrs-updated 0 i 0)

  (while (< i (sslength ss))
    (setq ename (ssname ss i)
          i (1+ i))

    ;; Walk INSERT subentities (ATTRIB entities)
    (setq sub-en (entnext ename))
    (while (and sub-en
                (not (equal (cdr (assoc 0 (entget sub-en))) "SEQEND")))
      (setq sub-ed (entget sub-en))

      (when (equal (cdr (assoc 0 sub-ed)) "ATTRIB")
        (setq tag (strcase (cdr (assoc 2 sub-ed))))

        ;; ⚠ Check for CONSTANT flag (bit 2 of group 70)
        ;; Constant = cannot be modified on instance
        (setq const-flag (logand (cdr (assoc 70 sub-ed)) 2))
        (when (zerop const-flag)  ; not constant → can update
          (setq new-val nil)

          (cond
            ((and (wcmatch tag "PROJECT*,PROJ*,PNAME*")
                  (not (= proj-name "")))
             (setq new-val proj-name))
            ((and (wcmatch tag "DRW*,SHEET*,NUM*,DWGNO*")
                  (not (= drw-num "")))
             (setq new-val drw-num))
            ((and (wcmatch tag "DESIGN*,BY*,DRAWN*,ARCH*")
                  (not (= designer "")))
             (setq new-val designer))
            ((wcmatch tag "DATE*")
             ;; Auto-fill date with current date
             (setq new-val
               (rtos (getvar "CDATE") 2 0))))  ; CDATE = YYYYMMDD.HHMMSSms

          (when new-val
            ;; ⚠ CRITICAL: replace LAST occurrence of group 1
            ;; (first occurrence = internal, last = displayed value)
            (setq sub-rev (reverse sub-ed))
            (setq old-1 (assoc 1 sub-rev))
            (setq sub-rev (subst (cons 1 new-val) old-1 sub-rev))
            (setq sub-ed (reverse sub-rev))
            (entmod sub-ed)
            (setq attrs-updated (1+ attrs-updated)))))

      (setq sub-en (entnext sub-en)))

    ;; ⚠ MUST call entupd on INSERT after all ATTRIB changes
    (entupd ename))

  ;;; ── Force update all fields ─────────────────────────────
  ;; Fields (e.g. %<\AcVar Filename>) won't update on regen alone
  ;; (command ".updatefield") + selection = force update
  (setvar "FIELDEVAL" 31)  ; auto-update on open/save/plot/regen
  (command ".updatefield" ss "")  ; force now

  (command "._UNDO" "_END")
  (setvar "CMDECHO" s-echo)
  (setvar "EXPERT"  s-expert)

  (prompt (strcat "
✅ עודכנו " (itoa attrs-updated)
                  " attributes ב-" (itoa (sslength ss)) " כותרות"))
  (princ))

;;; ── Helper: insert field string into attribute ─────────────
;;; Fields format: %<\AcVar SysVarName  "format">%
;;; Source: Autodesk AutoCAD Fields Reference
(defun c:SET-FILENAME-FIELD (/ ename attr-en)
  (vl-load-com)
  (prompt "
בחר בלוק כותרת: ")
  (setq ename (car (entsel)))
  (if (not ename) (exit))

  (setq attr-en (entnext ename))
  (while (and attr-en
              (not (equal (cdr (assoc 0 (entget attr-en))) "SEQEND")))
    (setq attr-ed (entget attr-en))
    (when (and (equal (cdr (assoc 0 attr-ed)) "ATTRIB")
               (wcmatch (strcase (cdr (assoc 2 attr-ed)))
                        "FILE*,DWGNAME*,DRAWING*"))
      ;; Insert FILENAME field:
      ;; %<\AcVar Filename  "%fn2">% = filename without extension
      ;; %<\AcVar Filename  "%fn6">% = filename with extension
      ;; %<\AcVar Filename  "%fn7">% = full path + filename
      (setq field-str "%<\AcVar Filename \f "%fn2">%")
      (setq attr-rev (reverse attr-ed))
      (setq attr-rev (subst (cons 1 field-str) (assoc 1 attr-rev) attr-rev))
      (entmod (reverse attr-rev))
      (prompt (strcat "
Field set on: " (cdr (assoc 2 attr-ed)))))
    (setq attr-en (entnext attr-en)))
  (entupd ename)
  (command ".updatefield" (ssadd ename) "")
  (princ))

;;; STAIRCASE-CHECK.LSP v2.0
;;; בדיקת גרם מדרגות לפי נוסחת Blondel + תקנות תכנון ובנייה ישראל
;;; מקור: תקנות התכנון והבנייה (בקשה להיתר, תנאיו ואגרות) תוספת ה'
;;;
;;; EDGE CASES:
;;;   ⚠ INSUNITS check — mm vs m changes all comparisons
;;;   ⚠ getpoint returns UCS — must trans to WCS for distance()
;;;   ⚠ Stair width = clear opening between handrails, not wall-to-wall
;;;   ⚠ Blondel: 2r+t formula uses HORIZONTAL tread projection, not slope face

(defun c:STAIR-CHECK (/ *error* s-echo unit-fac unit-name
                        riser tread stair-width stair-type
                        blondel status-r status-t status-b status-w)

  (defun *error* (msg)
    (setvar "CMDECHO" s-echo)
    (if (not (wcmatch msg "Function cancelled,quit / exit abort"))
      (alert msg))
    (princ))

  (setq s-echo (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)

  ;;; ── Unit factor to cm ─────────────────────────────────
  ;; ⚠ All stair regulations in cm; drawings usually in mm
  (setq unit-fac
    (cdr (assoc (getvar "INSUNITS")
      '((4 . 0.1)   ; mm → cm
        (5 . 1.0)   ; cm → cm
        (6 . 100.0) ; m  → cm
        (1 . 2.54)  ; inch → cm
        (2 . 30.48)))))  ; ft → cm
  (setq unit-name
    (cdr (assoc (getvar "INSUNITS")
      '((4 . "מ"מ") (5 . "ס"מ") (6 . "מ'") (1 . """) (2 . "'")))))

  (if (not unit-fac)
    (progn
      (alert "INSUNITS לא נתמך. הגדר מ"מ (4) או מטר (6).")
      (exit)))

  ;;; ── Get stair type ────────────────────────────────────
  (initget 1 "R P S")
  (setq stair-type
    (getkword "
סוג גרם מדרגות [R=מגורים / P=ציבורי / S=שירות]: "))

  ;;; ── Measure riser height ──────────────────────────────
  (prompt "
מדוד גובה מדרגה (riser) — לחץ נקודת בסיס: ")
  (setq p1 (trans (getpoint) 1 0))
  (prompt "
לחץ נקודת צמרת מדרגה: ")
  (setq p2 (trans (getpoint p1) 1 0))
  ;; ⚠ Take only Z (or Y if plan view) component for height
  ;; If points are in 2D plan view, use Y for elevation
  (setq riser (* unit-fac (abs (- (cadr p2) (cadr p1)))))
  (if (zerop riser)
    (setq riser (* unit-fac (abs (- (caddr p2) (caddr p1))))))  ; Z fallback

  ;;; ── Measure tread depth ───────────────────────────────
  (prompt "
מדוד עומק מדרגה (tread/going) — נקודת קצה קדמי: ")
  (setq p3 (trans (getpoint) 1 0))
  (prompt "
נקודת קצה אחורי: ")
  (setq p4 (trans (getpoint p3) 1 0))
  ;; ⚠ Tread = HORIZONTAL projection (going), not slope face
  ;; In 2D plan view this is the X component
  (setq tread (* unit-fac
    (sqrt (+ (expt (- (car p4) (car p3)) 2)
             (expt (- (cadr p4) (cadr p3)) 2)))))  ; 2D distance

  ;;; ── Measure stair width ───────────────────────────────
  (prompt "
מדוד רוחב גרם מדרגות (clear): ")
  (setq p5 (trans (getpoint) 1 0))
  (setq p6 (trans (getpoint p5) 1 0))
  (setq stair-width (* unit-fac (distance p5 p6)))

  ;;; ── Blondel formula ───────────────────────────────────
  ;; Proven formula: 2×riser + tread must = 63±3 cm
  ;; Source: Building regulations worldwide, Blondel 1675
  (setq blondel (+ (* 2 riser) tread))

  ;;; ── Check against regulations ─────────────────────────
  (setq riser-max 17.5  ; cm — Israel building regs
        tread-min-res  27.5  ; residential
        tread-min-pub  28.0  ; public
        tread-min-svc  24.0  ; service stairs (basement)
        width-min-res  110.0 ; residential cm
        width-min-pub  130.0 ; public cm
        headroom-min   210.0) ; cm

  (setq tread-min
    (cond ((= stair-type "R") tread-min-res)
          ((= stair-type "P") tread-min-pub)
          ((= stair-type "S") tread-min-svc)))
  (setq width-min
    (cond ((= stair-type "R") width-min-res)
          (T width-min-pub)))

  (setq status-r
    (if (<= riser riser-max)
      (strcat "✅ " (rtos riser 2 1) "cm ≤ 17.5cm")
      (strcat "❌ " (rtos riser 2 1) "cm > 17.5cm!")))

  (setq status-t
    (if (>= tread tread-min)
      (strcat "✅ " (rtos tread 2 1) "cm ≥ " (rtos tread-min 2 1) "cm")
      (strcat "❌ " (rtos tread 2 1) "cm < " (rtos tread-min 2 1) "cm!")))

  (setq status-b
    (if (and (>= blondel 60.0) (<= blondel 66.0))
      (strcat "✅ Blondel 2r+t=" (rtos blondel 2 1) "cm (60–66)")
      (strcat "❌ Blondel=" (rtos blondel 2 1) "cm OUT OF RANGE!")))

  (setq status-w
    (if (>= stair-width width-min)
      (strcat "✅ " (rtos stair-width 2 1) "cm ≥ " (rtos width-min 2 1) "cm")
      (strcat "❌ " (rtos stair-width 2 1) "cm < " (rtos width-min 2 1) "cm!")))

  ;;; ── Report ────────────────────────────────────────────
  (alert (strcat
    "══════════════════════════
"
    " בדיקת מדרגות — " stair-type "
"
    "══════════════════════════
"
    " גובה (riser):    " status-r "
"
    " עומק (tread):    " status-t "
"
    " נוסחת Blondel:  " status-b "
"
    " רוחב:           " status-w "
"
    "══════════════════════════"))

  (setvar "CMDECHO" s-echo)
  (princ))

;;; TAMA38-CALCULATOR.LSP v2.0
;;; מחשבון זכויות בנייה — תמ"א 38/1 ופינוי-בינוי
;;; ⚠ תמ"א 38: הופסקה 1.10.2022 — לבקשות קיימות בלבד!
;;; מקור: תמ"א 38 (2005 + תיקון 3, 2012), חוק עידוד חיזוק מבנים 2008
;;;        חוק פינוי ובינוי התשס"ו-2006 + תיקון 2018 (67% הסכמה)
;;;
;;; VERIFIED VALUES (training knowledge — verify before permit use):
;;;   תמ"א 38/1: +25 מ"ר לכל דירה קיימת
;;;              +מרפסת עד 25 מ"ר (חלקית פטורה)
;;;              +ממ"ד 9-12 מ"ר (בד"כ פטור)
;;;              +12.5 מ"ר קומת קרקע לכל דירה קיימת
;;;   פינוי-בינוי: מינ' 24 יחידות, הסכמה 67%, מכפיל 2.5-4×

(defun c:TAMA38 (/ *error* s-echo
                   num-units existing-area
                   track result)

  (defun *error* (msg)
    (setvar "CMDECHO" s-echo)
    (if (not (wcmatch msg "Function cancelled,quit / exit abort"))
      (alert msg))
    (princ))

  (setq s-echo (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)

  ;;; ── Warning about termination ─────────────────────────
  (initget 1 "38 PB")
  (setq track (getkword
    "
בחר מסלול [38=תמ"א 38/1 (בקשות קיימות בלבד!) / PB=פינוי-בינוי]: "))

  ;;; ── Get inputs ────────────────────────────────────────
  (setq num-units (getint "
מספר דירות קיימות: "))
  (if (<= num-units 0) (progn (alert "מספר דירות חייב להיות חיובי") (exit)))

  (setq existing-area (getreal "
שטח עיקרי ממוצע לדירה קיימת (מ"ר): "))

  (cond
    ;;; ── TAMA 38/1 ─────────────────────────────────────
    ((= track "38")
     ;; ⚠ TERMINATED since 1.10.2022 — legacy projects only!
     ;; Source: תמ"א 38 תיקון 3 (2012) + חוק עידוק חיזוק מבנים
     (let* (
       ;; Per-unit additions (תמ"א 38/1):
       (per-unit-main    25.0)   ; מ"ר עיקרי לכל דירה
       (per-unit-balcony 25.0)   ; מרפסת (חלקית פטורה ממניין)
       (per-unit-mamad   9.0)    ; ממ"ד (בד"כ פטור)
       ;; Ground floor expansion:
       (ground-per-unit  12.5)   ; מ"ר לכל דירה קיימת

       ;; Calculated totals:
       (total-main-add   (* num-units per-unit-main))
       (total-ground-add (* num-units ground-per-unit))
       (total-existing   (* num-units existing-area))
       (new-main         (+ total-existing total-main-add))
       (num-new-units    ; approx new units developer gets
         (fix (/ total-main-add existing-area)))

       ;; Area schedule per תקנות חישוב שטחים 1992:
       ;; (NOT IS 1498 — that standard doesn't exist!)
       )

       (alert (strcat
         "══════════════════════════════════
"
         "  תמ"'"'"'א 38/1 — זכויות בנייה
"
         "  ⚠ מסלול זה הופסק 1.10.2022!
"
         "══════════════════════════════════
"
         "  דירות קיימות:      " (itoa num-units) " יחידות
"
         "  שטח קיים:          " (rtos total-existing 2 0) " מ"ר
"
         "──────────────────────────────────
"
         "  תוספת לכל דירה:    25 מ"ר עיקרי
"
         "  סה"כ תוספת עיקרי: " (rtos total-main-add 2 0) " מ"ר
"
         "  תוספת קרקע:        " (rtos total-ground-add 2 0) " מ"ר
"
         "  שטח חדש סה"כ:      " (rtos new-main 2 0) " מ"ר
"
         "  יחידות חדשות (קיר):" (itoa num-new-units) " יחידות
"
         "══════════════════════════════════
"
         "  בדוק ועדה מקומית לתנאים ספציפיים!"))))

    ;;; ── Pinui-Binui ───────────────────────────────────
    ((= track "PB")
     ;; Source: חוק פינוי ובינוי התשס"ו-2006 + תיקון 2018
     ;; Min 24 units for tax track, 67% consent threshold
     (if (< num-units 24)
       (prompt (strcat "
⚠ פינוי-בינוי: מינ' 24 יחידות! (יש לכם " (itoa num-units) ")")))

     (setq density-mult (getreal "
מכפיל צפיפות מאושר על-ידי ועדה מקומית (למשל 2.5-4.0): "))
     (setq new-total (* total-existing density-mult))
     (setq new-units-approx (fix (/ new-total (+ existing-area 25.0))))  ; with 25m² bonus each

     (alert (strcat
       "══════════════════════════════════
"
       "  פינוי-בינוי — זכויות בנייה
"
       "══════════════════════════════════
"
       "  דירות קיימות:      " (itoa num-units) " יחידות
"
       (if (< num-units 24)
         "  ⚠ פחות מ-24! בדוק מסלול חלופי
" "")
       "  הסכמה נדרשת:      67% (תיקון 2018)
"
       "  מכפיל צפיפות:     " (rtos density-mult 2 1) "×
"
       "  שטח חדש מוערך:    " (rtos new-total 2 0) " מ"ר
"
       "  יחידות חדשות:     ~" (itoa new-units-approx) "
"
       "──────────────────────────────────
"
       "  1 דונם = 1,000 מ"ר בדיוק
"
       "  שטח הקרקע בדונם: " (rtos (/ (* num-units existing-area) 1000.0) 2 2) " דונם (שטח בנוי בלבד!)
"
       "══════════════════════════════════
"
       "  מכפיל ספציפי לאתר — בדוק ועדה מקומית!")))))

  (setvar "CMDECHO" s-echo)
  (princ))