[分享]：将所选对象改到指定的层，且保留原颜色以及反向程序

zhynt

将所选对象改到指定的层，且保留原颜色并生成图层信息文件。
[php]
(defun c:chlay (/          ch_ss            ch_lay_new                ch_n
                ch_m          ch_ent    CH_name   ch_lay_col
                ch_a          ch_ent_n  id              ch_in
               )
  (setq lay_files (getfiled "保存图元信息" "" "lay" 1))
  (setq lay_file (open lay_files "w"))
  (prompt "\n选择要生成信息文件的图元<all>:")
  (setq lay_se (ssget))
  (if (= lay_se nil)
    (setq lay_se (ssget "all"))
  )
  (setq aaa t)
  (write-line "图层信息:" lay_file)
  (while (setq lay_tab (tblnext "layer" aaa))
    (if        aaa
      (setq aaa nil)
    )
    (setq lay_tab_name (cdr (assoc 2 lay_tab)))
    (setq lay_tab_color (cdr (assoc 62 lay_tab)))
    (write-line
      (strcat lay_tab_name "；" (itoa lay_tab_color))
      lay_file
    )
  )
  (setq lay_se_n (sslength lay_se))
  (setq m 0)
  (write-line "图元名称；句柄；图层；颜色" lay_file)
  (while (/= m lay_se_n)
    (setq lay_ent (entget (ssname lay_se m)))
    (setq lay_0 (cdr (assoc 0 lay_ent)))
    (setq lay_1 (cdr (assoc 1 lay_ent)))
    (setq lay_5 (cdr (assoc 5 lay_ent)))
    (setq lay_8 (cdr (assoc 8 lay_ent)))
    (setq lay_62 (assoc 62 lay_ent))
    (if        (/= lay_62 nil)
      (if (= (setq lay_62_v (cdr lay_62)) 0)
        (setq lay_color "随块")
        (setq lay_color (itoa (cdr lay_62)))
      )
      (setq lay_color "随层")
    )
    (setq lay_name1
           (strcat lay_0 "；" lay_5 "；" lay_8 "；" lay_color)
    )
    (write-line lay_name1 lay_file)
    (setq m (1+ m))
  )
  (close lay_file)
  (setq ch_lay_new (getstring "\n输入图层名:"))
  (ch_color lay_se ch_lay_new)
)
(defun ch_color        (ch_ss ch_lay_new)
  (setq ch_n (sslength ch_ss))
  (setq ch_m 0)
  (repeat ch_n
    (setq ch_ss_name (ssname ch_ss ch_m))
    (setq ch_ent (entget ch_ss_name))
    (setq ch_name (cdr (assoc 0 ch_ent)))
    (setq ch_lay (cdr (assoc 8 ch_ent)))
    (setq ch_lay_col (assoc 62 (tblsearch "LAYER" ch_lay)))
    (setq ch_ent (subst (cons 8 ch_lay_new) (assoc 8 ch_ent) ch_ent))
    (if        (= (assoc 62 ch_ent) nil)
      (if (or (= ch_name "LWPOLYLINE")
              (= ch_name "HATCH")
              (= ch_name "ELLIPSE")
              (= ch_name "POLYLINE")
              (= ch_name "DIMENSION")
              (= ch_name "INSERT")
          )
        (progn
          (setq id t)
          (setq ch_ent_n '())
          (setq ch_ln (- (length ch_ent) 1))
          (while id
            (setq ch_a (nth ch_ln ch_ent))
            (if        (= (car ch_a) 8)
              (setq ch_ent_n (cons ch_lay_col ch_ent_n))
            )
            (setq ch_ent_n (cons ch_a ch_ent_n))
            (setq ch_ln (- ch_ln 1))
            (if        (< ch_ln 0)
              (setq id nil)
            )
          )
          (setq ch_ent ch_ent_n)
        )
        (setq ch_ent (cons ch_lay_col ch_ent))
      )
    )
    (entmod ch_ent)
    (setq ch_m (1+ ch_m))
  )
)
[/php]

反向程序根据前面生成的信息文件恢复原对象。

[php]
(defun c:rlay ()
  (setq lay_file (getfiled "选择用来恢复图元数据的信息文件" "" "lay" 0))
  (setq lay_filed (open lay_file "r"))
  (read-line lay_filed)
  (while (/= (setq lay_name (read-line lay_filed))
             "图元名称；句柄；图层；颜色"
         )
    (setq aa (zhy_string_tok lay_name "；"))
    (setq lay_name (car aa))
    (if        (= (tblobjname "layer" lay_name) nil)
      (progn
        (setq lay_color (atoi (cadr aa)))
        (command "layer" "m" lay_name "c" lay_color "" "")
      )
    )
  )
  (while (setq lay_name (read-line lay_filed))
    (setq aa (zhy_string_tok lay_name "；"))
    (setq lay_0         (car aa)
          lay_5         (cadr aa)
          lay_8         (caddr aa)
          lay_62 (cadddr aa)
    )
    (if        (/= (setq lay_se (handent lay_5)) nil)
      (progn
        (setq lay_ent (entget lay_se))
        (setq lay_ent (subst (cons 8 lay_8) (assoc 8 lay_ent) lay_ent))
        (cond
          ((= lay_62 "随块")
           (setq lay_ent (subst (cons 62 0) (assoc 62 lay_ent) lay_ent))
           (entmod lay_ent)
          )
          ((= lay_62 "随层")
           (setq lay_ent_n (length lay_ent))
           (setq m 0)
           (setq lay_ent_new '())
           (while (/= m lay_ent_n)
             (if (/= (car (setq lay_ent_tmp (nth m lay_ent))) 62)
               (setq lay_ent_new (cons lay_ent_tmp lay_ent_new))
             )
             (setq m (1+ m))
           )
           (setq lay_ent (reverse lay_ent_new))
           (entdel lay_se)
           (entmake lay_ent)
          )
        )
      )
    )
  )
  (close lay_filed)
)
[/php]

dwg001

命令: rlay
错误 : no function definition: ZHY_STRING_TOK

zhynt

[php]
(defun zhy_string_tok (sstring sstr)
  (setq string_list '())
  (setq n1 (strlen sstring))
  (setq n2 (strlen sstr))
  (while (setq m2 (vl-string-search sstr sstring))
    (setq str_1 (substr sstring 1 m2))
    (setq sstring (substr sstring (+ 1 m2 n2)))
    (if (/= str_1 "")
      (setq string_list (cons str_1 string_list))
    )
    (if (= (substr sstring 1 n2) sstr)
      (setq string_list (cons "" string_list))
    )
  )
  (if (/= sstring "")
    (setq string_list (cons sstring string_list))
  )
  (reverse string_list)
)
[/php]