;;; ============================================================
;;; دستور NUM - شماره‌گذاری خودکار بلوک‌ها
;;; از اولین بلوک به آخرین بلوک (ترتیب کپی)
;;; ============================================================

(defun c:NUM (/ block_ent block_name att_list att_tag prefix 
                base_num all_blocks n ent obj atts new_str 
                total block_list)
  
  (setvar "cmdecho" 0)
  (princ "\n🔹 شماره‌گذاری خودکار بلوک‌ها (از اول به آخر)")
  
  ;; 1- انتخاب یک بلوک مبنا
  (setq block_ent (car (entsel "\n🔹 یک بلوک را انتخاب کنید: ")))
  
  (if (not block_ent)
    (progn
      (princ "\n❌ هیچ بلوکی انتخاب نشد!")
      (exit)
    )
  )
  
  ;; 2- بررسی بلوک بودن
  (if (/= (cdr (assoc 0 (entget block_ent))) "INSERT")
    (progn
      (princ "\n❌ شیء انتخاب شده بلوک نیست!")
      (exit)
    )
  )
  
  (setq block_name (cdr (assoc 2 (entget block_ent))))
  
  ;; 3- دریافت Attribute های بلوک
  (setq att_list (vlax-invoke (vlax-ename->vla-object block_ent) 'GetAttributes))
  
  (if (not att_list)
    (progn
      (princ "\n❌ این بلوک دارای Attribute نیست!")
      (exit)
    )
  )
  
  ;; 4- پیدا کردن Attribute عددی
  (setq found_num nil)
  (foreach att att_list
    (setq att_val (vla-get-TextString att))
    (if (and (not found_num) (wcmatch att_val "*#*"))
      (progn
        ;; جداسازی عدد از انتهای متن
        (setq num_len 0)
        (setq i (strlen att_val))
        (while (and (> i 0) 
                    (<= (ascii (substr att_val i 1)) 57) 
                    (>= (ascii (substr att_val i 1)) 48))
          (setq num_len (1+ num_len))
          (setq i (1- i))
        )
        (setq prefix (substr att_val 1 (- (strlen att_val) num_len)))
        (setq base_num (atoi (substr att_val (- (strlen att_val) num_len -1))))
        (setq att_tag (vla-get-TagString att))
        (setq found_num T)
      )
    )
  )
  
  (if (not found_num)
    (progn
      (princ "\n❌ هیچ Attribute عددی در بلوک یافت نشد!")
      (exit)
    )
  )
  
  ;; 5- پیدا کردن تمام بلوک‌های هم نام در فضای مدل
  (princ (strcat "\n🔍 در حال جستجوی بلوک‌های '" block_name "'..."))
  
  (setq all_blocks (ssget "X" (list (cons 0 "INSERT") 
                                    (cons 2 block_name)
                                    (cons 410 (getvar "CTAB")))))
  
  (if (not all_blocks)
    (progn
      (princ "\n❌ هیچ بلوکی با این نام یافت نشد!")
      (exit)
    )
  )
  
  ;; 6- تبدیل به لیست برای معکوس کردن
  (setq block_list '())
  (setq n 0)
  (repeat (sslength all_blocks)
    (setq ent (ssname all_blocks n))
    (setq block_list (cons ent block_list))
    (setq n (1+ n))
  )
  
  ;; 7- معکوس کردن لیست (آخرین بلوک به اول، اولین بلوک به آخر)
  (setq block_list (append block_list))
  
  ;; 8- شماره‌گذاری به ترتیب (از اول به آخر)
  (setq total (length block_list))
  (setq n 0)
  (setq current_num base_num)
  
  (foreach ent block_list
    ;; ساخت شماره جدید
    (if (< current_num 10)
      (setq new_str (strcat prefix "0" (itoa current_num)))
      (setq new_str (strcat prefix (itoa current_num)))
    )
    
    ;; به‌روزرسانی Attribute
    (setq obj (vlax-ename->vla-object ent))
    (setq atts (vlax-invoke obj 'GetAttributes))
    (foreach att atts
      (if (= (vla-get-TagString att) att_tag)
        (vla-put-TextString att new_str)
      )
    )
    
    (setq current_num (1+ current_num))
  )
  
  ;; 9- نمایش نتیجه
  (princ (strcat "\n✅ " (itoa total) " عدد بلوک شماره‌گذاری شدند."))
  (princ (strcat "\n📌 شماره‌ها از " prefix 
                 (if (< base_num 10) "0" "") (itoa base_num) 
                 " تا " prefix 
                 (if (< (1- current_num) 10) "0" "") (itoa (1- current_num))))
  
  (setvar "cmdecho" 1)
  (princ)
)

;;; ============================================================
;;; راهنمای استفاده:
;;; 1- یک بلوک با Attribute عددی بسازید (مثلاً A-01)
;;; 2- به هر روشی که می‌خواهید از آن کپی بگیرید
;;; 3- دستور NUM را اجرا کنید
;;; 4- یکی از بلوک‌ها را انتخاب کنید
;;; 5- تمام بلوک‌ها از اول به آخر شماره‌گذاری می‌شوند
;;; ============================================================