[编程交流] 需要一个lisp例程来处理

[b][color=BLACK]([/color][/b]defun ent2clay [b][color=FUCHSIA]([/color][/b]/ ss en ed[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]and [b][color=NAVY]([/color][/b]setq ss [b][color=MAROON]([/color][/b]ssget[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
      [b][color=NAVY]([/color][/b]while [b][color=MAROON]([/color][/b]setq en [b][color=GREEN]([/color][/b]ssname ss 0[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]setq ed [b][color=GREEN]([/color][/b]entget en[b][color=GREEN])[/color][/b]
                   cl [b][color=GREEN]([/color][/b]if [b][color=BLUE]([/color][/b]assoc 62 ed[b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]cdr [b][color=RED]([/color][/b]assoc 62 ed[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b] 256[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]entmod [b][color=GREEN]([/color][/b]subst [b][color=BLUE]([/color][/b]cons 8 [b][color=RED]([/color][/b]itoa cl[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]assoc 8 ed[b][color=BLUE])[/color][/b] ed[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]ssdel en ss[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

(defun c:test (/ ss j vl Nme co)
 ; Tharwat 08. 06. 2011
 (vl-load-com)
 (if (setq ss (ssget "_:L"))
   (repeat (setq j (sslength ss))
     (setq sset (ssname ss (setq j (1- j))))
     (setq vl (vlax-ename->vla-object sset))
     (if
       (not
         (tblsearch "LAYER"
                    (setq Nme (rtos (setq co (vla-get-color vl)) 2 0))
         )
       )
        (progn
          (entmakex (list (cons 0 "LAYER")
                          (cons 100 "AcDbSymbolTableRecord")
                          (cons 100 "AcDbLayerTableRecord")
                          (cons 2 Nme)
                          (cons 70 0)
                          (cons 62 co)
                    )
          )
          (vla-put-layer vl Nme)
        )
     )
     (if (not (eq (atoi (vla-get-layer vl)) (vla-get-color vl)))
       (vla-put-layer vl co)
     )
   )
   (princ)
 )
 (princ)
)

(defun c:LayerByColor (/ ss i d)
 (if (setq ss (ssget "_X" '((-4 . "<") (62 . 256))))
   (repeat (setq i (sslength ss))
     (entmod (subst (cons 8 (itoa (cdr (assoc 62 (setq d (entget (ssname ss (setq i (1- i)))))))))
                    (assoc 8 d)
                    d
             )
     )
   )
 )
 (princ)
)