;;; 图层特性信息表【CADCHAJIAN.COM】 - 增强版
;;;部分代码来源于网络，在此表示感谢。
;;; 功能：列出所有图层信息，包括图层名、线型、线宽、颜色、线型实例、
;;;       以及锁定、打印、冻结、关闭状态

(defun c:tcb (/ AcObj ActDoc Cntr Pnt0 e l Pnt1 Pnt2 Pnt3 Pnt4 Pnt5 Pnt6 Pnt7 Pnt8 Pnt9 Pnt10
               LyrName LyrLType LyrClr LyrLock LyrPrint LyrFrozen LyrOff
               col1 col2 col3 col4 col5 col6 col7 col8)

  (princ "\n图层特性信息列表【CADCHAJIAN.COM】 - 增强版")
  (vl-load-com)
  
  ;; 错误处理
  (defun *error* (msg)
    (if ActDoc (vla-EndUndoMark ActDoc))
    (if (and msg (not (wcmatch msg "*取消*")))
      (princ (strcat "\n错误: " msg))
    )
    (princ)
  )
  
  (setq AcObj (vlax-get-Acad-Object))
  (setq ActDoc (vla-get-ActiveDocument AcObj))
  (setq ActLayers (vla-get-Layers ActDoc))
  
  (vla-EndUndoMark ActDoc)
  (vla-StartUndoMark ActDoc)

  ;; 获取视图参数，用于计算文字方向
  (setq c03 (getvar "viewctr")
        c03 (trans c03 1 2)
        c08 (getvar "viewsize")
        c04 (getvar "screensize")
        c07 (car c04)
        c06 (cadr c04)
        c09 (/ (* c08 c07) c06)
        c010 (list (- (car c03) (* 0.5 c09)) (- (cadr c03) (* 0.5 c08)))
        c020 (list (+ (car c03) (* 0.5 c09)) (- (cadr c03) (* 0.5 c08)))
        c010 (trans c010 2 0)
        c020 (trans c020 2 0)
  )
  (setq ang (angle c010 c020))
  
  ;; 获取基点
  (if (setq Pnt0 (lay_get_pt))
    (progn
      (setq Pnt0 (trans Pnt0 1 0))
  ;; 先遍历一次所有图层，获取最长的图层名
(setq layer_list '())
(setq Lyr nil)
(while (setq Lyr (tblnext "LAYER" (null Lyr)))
  (setq LyrName (cdr (assoc 2 Lyr)))
  (setq layer_list (cons LyrName layer_list))
)

;; 计算最长图层名的字符数
(setq max_len 0)
(foreach name layer_list
  (if (> (strlen name) max_len)
    (setq max_len (strlen name))
  )
)

;; 如果最长图层名小于5个字符，按5个字符计算（保证最小间距）
(if (< max_len 5) (setq max_len 5))
      
      ;; 列间距定义
      (setq col1 (* lh (* max_len 0.85)))    ; 图层名（根据最长文字长度 × 0.85倍字高）
      (setq col2 (* lh 16))    ; 线型名（原10，加大为16）
      (setq col3 (* lh 6))     ; 线宽（保持不变）
      (setq col4 (* lh 6))     ; 颜色（保持不变）
      (setq col5 (* lh 6))     ; 锁定（保持不变）
      (setq col6 (* lh 6))     ; 打印（保持不变）
      (setq col7 (* lh 6))     ; 冻结（保持不变）
      (setq col8 (* lh 6))    ; 线型实例（保持不变）
      
      ;; 计算各列位置
      (setq Pnt1 (polar Pnt0 ang col1))
      (setq Pnt2 (polar Pnt1 ang col2))
      (setq Pnt3 (polar Pnt2 ang col3))
      (setq Pnt4 (polar Pnt3 ang col4))
      (setq Pnt5 (polar Pnt4 ang col5))
      (setq Pnt6 (polar Pnt5 ang col6))
      (setq Pnt7 (polar Pnt6 ang col7))
      (setq Pnt8 (polar Pnt7 ang col8))
      
      ;;----- 绘制表头 -----
      (entmakex (list (cons 0 "TEXT")
                      (cons 1 "图层名")
                      (cons 8 "0")
                      (cons 10 Pnt0)
                      (cons 40 (* lh 1.2))
                      (cons 50 ang)
                      (cons 62 10)
                      (cons 7 (getvar "TEXTSTYLE"))))
      
      (entmakex (list (cons 0 "TEXT")
                      (cons 1 "线型名")
                      (cons 8 "0")
                      (cons 10 Pnt1)
                      (cons 40 (* lh 1.2))
                      (cons 50 ang)
                      (cons 62 22)
                      (cons 7 (getvar "TEXTSTYLE"))))
      
      (entmakex (list (cons 0 "TEXT")
                      (cons 1 "线宽")
                      (cons 8 "0")
                      (cons 10 Pnt2)
                      (cons 40 (* lh 1.2))
                      (cons 50 ang)
                      (cons 62 34)
                      (cons 7 (getvar "TEXTSTYLE"))))
      
      (entmakex (list (cons 0 "TEXT")
                      (cons 1 "颜色")
                      (cons 8 "0")
                      (cons 10 Pnt3)
                      (cons 40 (* lh 1.2))
                      (cons 50 ang)
                      (cons 62 46)
                      (cons 7 (getvar "TEXTSTYLE"))))
      
      (entmakex (list (cons 0 "TEXT")
                      (cons 1 "锁定")
                      (cons 8 "0")
                      (cons 10 Pnt4)
                      (cons 40 (* lh 1.2))
                      (cons 50 ang)
                      (cons 62 58)
                      (cons 7 (getvar "TEXTSTYLE"))))
      
      (entmakex (list (cons 0 "TEXT")
                      (cons 1 "打印")
                      (cons 8 "0")
                      (cons 10 Pnt5)
                      (cons 40 (* lh 1.2))
                      (cons 50 ang)
                      (cons 62 70)
                      (cons 7 (getvar "TEXTSTYLE"))))
      
      (entmakex (list (cons 0 "TEXT")
                      (cons 1 "冻结")
                      (cons 8 "0")
                      (cons 10 Pnt6)
                      (cons 40 (* lh 1.2))
                      (cons 50 ang)
                      (cons 62 82)
                      (cons 7 (getvar "TEXTSTYLE"))))
      
      (entmakex (list (cons 0 "TEXT")
                      (cons 1 "关闭")
                      (cons 8 "0")
                      (cons 10 Pnt7)
                      (cons 40 (* lh 1.2))
                      (cons 50 ang)
                      (cons 62 94)
                      (cons 7 (getvar "TEXTSTYLE"))))
      
      (entmakex (list (cons 0 "TEXT")
                      (cons 1 "线型实例")
                      (cons 8 "0")
                      (cons 10 Pnt8)
                      (cons 40 (* lh 1.2))
                      (cons 50 ang)
                      (cons 62 106)
                      (cons 7 (getvar "TEXTSTYLE"))))
      
      ;; 表头下方空一行
      (setq Pnt0 (polar Pnt0 (- ang (/ pi 2.0)) (* lh 3)))
      
      ;;----- 遍历所有图层 -----
      (setq Lyr nil)
      (while (setq Lyr (tblnext "LAYER" (null Lyr)))
        (setq LyrName (cdr (assoc 2 Lyr)))
        (setq LyrLType (cdr (assoc 6 Lyr)))
        (setq LyrClr (cdr (assoc 62 Lyr)))
        
        ;; 处理颜色负值（-1=随块，-2=随层）
        (if (< LyrClr 0) (setq LyrClr 7))
        
        ;; 获取图层状态信息
        (setq LyrObj (vla-item ActLayers LyrName))
        (setq LyrLock (vla-get-Lock LyrObj))        ; T=锁定
        (setq LyrPrint (vla-get-Plottable LyrObj))  ; T=可打印
        (setq LyrFrozen (vla-get-Freeze LyrObj))    ; T=冻结
        (setq LyrOff (vla-get-LayerOn LyrObj))      ; T=打开
        
        ;; 转换为中文显示
        (setq lock_str (if (= LyrLock :vlax-true) "锁定" "否"))
        (setq print_str (if (= LyrPrint :vlax-true) "打印" "不打印"))
        (setq frozen_str (if (= LyrFrozen :vlax-true) "冻结" "否"))
        (setq off_str (if (= LyrOff :vlax-true) "打开" "关闭"))
        
        ;; 计算当前行各列位置
        (setq Pnt1 (polar Pnt0 ang col1))
        (setq Pnt2 (polar Pnt1 ang col2))
        (setq Pnt3 (polar Pnt2 ang col3))
        (setq Pnt4 (polar Pnt3 ang col4))
        (setq Pnt5 (polar Pnt4 ang col5))
        (setq Pnt6 (polar Pnt5 ang col6))
        (setq Pnt7 (polar Pnt6 ang col7))
        (setq Pnt8 (polar Pnt7 ang col8))
        
        ;; 线型实例的起点和终点
        (setq Pnt9 (polar Pnt8 (+ ang (/ pi 2.0)) (/ lh 2.0)))
        (setq Pnt10 (polar Pnt9 ang (* lh 12)))  ; 线型实例长度
        
        (if (and Pnt0 Pnt1 Pnt2 Pnt3 Pnt4 Pnt5 Pnt6 Pnt7)
          (progn
            ;; 图层名
            (entmakex (list (cons 0 "TEXT")
                            (cons 1 LyrName)
                            (cons 8 LyrName)
                            (cons 10 Pnt0)
                            (cons 40 lh)
                            (cons 50 ang)
                            (cons 62 LyrClr)
                            (cons 7 (getvar "TEXTSTYLE"))))
            
            ;; 线型名
            (entmakex (list (cons 0 "TEXT")
                            (cons 1 LyrLType)
                            (cons 8 LyrName)
                            (cons 10 Pnt1)
                            (cons 40 lh)
                            (cons 50 ang)
                            (cons 62 LyrClr)
                            (cons 7 (getvar "TEXTSTYLE"))))
            
            ;; 线宽
            (entmakex (list (cons 0 "TEXT")
                            (cons 1 (rtos (ark_layer-lw LyrName) 2 2))
                            (cons 8 LyrName)
                            (cons 10 Pnt2)
                            (cons 40 lh)
                            (cons 50 ang)
                            (cons 62 LyrClr)
                            (cons 7 (getvar "TEXTSTYLE"))))
            
            ;; 颜色
            (entmakex (list (cons 0 "TEXT")
                            (cons 1 (itoa LyrClr))
                            (cons 8 LyrName)
                            (cons 10 Pnt3)
                            (cons 40 lh)
                            (cons 50 ang)
                            (cons 62 LyrClr)
                            (cons 7 (getvar "TEXTSTYLE"))))
            
            ;; 锁定状态
            (entmakex (list (cons 0 "TEXT")
                            (cons 1 lock_str)
                            (cons 8 LyrName)
                            (cons 10 Pnt4)
                            (cons 40 lh)
                            (cons 50 ang)
                            (cons 62 LyrClr)
                            (cons 7 (getvar "TEXTSTYLE"))))
            
            ;; 打印状态
            (entmakex (list (cons 0 "TEXT")
                            (cons 1 print_str)
                            (cons 8 LyrName)
                            (cons 10 Pnt5)
                            (cons 40 lh)
                            (cons 50 ang)
                            (cons 62 LyrClr)
                            (cons 7 (getvar "TEXTSTYLE"))))
            
            ;; 冻结状态
            (entmakex (list (cons 0 "TEXT")
                            (cons 1 frozen_str)
                            (cons 8 LyrName)
                            (cons 10 Pnt6)
                            (cons 40 lh)
                            (cons 50 ang)
                            (cons 62 LyrClr)
                            (cons 7 (getvar "TEXTSTYLE"))))
            
            ;; 关闭状态
            (entmakex (list (cons 0 "TEXT")
                            (cons 1 off_str)
                            (cons 8 LyrName)
                            (cons 10 Pnt7)
                            (cons 40 lh)
                            (cons 50 ang)
                            (cons 62 LyrClr)
                            (cons 7 (getvar "TEXTSTYLE"))))
            
            ;; 线型实例（多段线）
            (entmake (list '(0 . "LWPOLYLINE")
                           '(100 . "AcDbEntity")
                           '(100 . "AcDbPolyline")
                           (cons 8 LyrName)
                           (cons 6 LyrLType)
                           (cons 90 2)
                           (cons 10 Pnt9)
                           (cons 10 Pnt10)
                           (cons 62 LyrClr)
                           (cons 40 (ark_layer-lw LyrName))
                           (cons 41 (ark_layer-lw LyrName))
                           (cons 43 (ark_layer-lw LyrName))
                           (cons 48 1.0)))  ; 固定线型比例
            
            ;; 移动到下一行
            (setq Pnt0 (polar Pnt0 (- ang (/ pi 2.0)) (* lh 2.5)))
          )
        )
      )
      (vla-EndUndoMark ActDoc)
      ;; 显示最长图层名信息
      (princ (strcat "\n最长图层名: " (itoa max_len) " 个字符"))
      (princ (strcat "\n共列出 " (itoa (vla-get-Count ActLayers)) " 个图层信息"))
    )
  )
  (princ)
)

;;; 获取图层线宽（单位：毫米）
(defun ark_layer-lw (lay / lw)
  (setq lw (vla-get-lineweight
             (vla-item (vla-get-layers
                         (vla-get-activedocument (vlax-get-acad-object)))
                       lay)))
  (if (= lw -3)
    (setq lw (/ (getvar 'LWDEFAULT) 100.0))
    (setq lw (/ lw 100.0))
  )
  lw
)

;;; 获取用户输入的基点
(defun lay_get_pt (/ GETR pt0)
  (defun GETR (val msg / tm)
    (setq tm (getreal (strcat msg " <" (rtos val 2 2) ">: ")))
    (cond ((= (type tm) 'REAL) tm)
          ((= tm nil) val)
          (t (princ "\007 *错误* 不是一个实数") val)
    )
  )
  
  ;; 设置默认文字高度
  (if (null lh)
    (setq lh (* (getvar "DIMTXT") (getvar "DIMSCALE")))
  )
  
  (setq pt0 "A")
  (while (= "0"
            (progn
              (initget 128 "0")
              (setq pt0 (getpoint (strcat "\n请指定基点【文字高度为 "
                                          (rtos lh 2 2)
                                          "，0 设置】: ")))
            ))
    (if (= "0" pt0)
      (setq lh (GETR lh "\n输入文字高度:"))
    )
  )
  pt0
)

(princ "\n图层信息列表命令: TCb")
(princ)