[编程交流] [需要Lisp程序]放置所有对象

[color="lime"][color="#2e8b57"](setq xcol "1")
(setq xlay "NEW")
(defun c:test(/ cnt xset ent enlist)
 (defun FilterClrNumbX(xset valu)
   (setq valu(atoi valu) layerList(list))
   (setq tbl(tblnext "LAYER" T))
   (if(= valu (cdr(assoc 62 tbl)))
     (setq layerList(append layerList (list (cdr(assoc 2 tbl)))))
   )
   (while(setq tbl(tblnext "LAYER"))
     (if(= valu (cdr(assoc 62 tbl)))
       (setq layerList(append layerList (list (cdr(assoc 2 tbl)))))
     )
   )
   (setq cnt 0 newSet(ssadd))
   (while(< cnt (sslength xset))
     (setq ent(ssname xset cnt))
     (setq enlist(entget ent))
     (if (assoc 62 enlist)
       (if(= valu (cdr(assoc 62 enlist)))
         (ssadd ent newSet)
       )
       (if(member (cdr(assoc 8 enlist)) layerList)
         (ssadd ent newSet)
       )
     )
     (setq cnt(+ cnt 1))
   )
   newSet
 )
 (setvar "cmdecho" 0)
(setq xcoll (getstring (strcat "\nEnter Color Numer, <" xcol ">: ")))
(if (= 1lay "")
   (setq xcoll xcol)
   (setq xcol xcoll)
)
(setq 1lay (getstring (strcat "\nEnter Layer Name, <" xlay ">: ")))
(if (= 1lay "")
   (setq 1lay xlay)
   (setq xlay 1lay)
)
 (setq xset
   (ssget"X" 
     (list 
       (cons -4 "<OR")
         (cons 0 "ARC")
         (cons 0 "CIRCLE")
         (cons 0 "ELLIPSE")
         (cons 0 "IMAGE")
         (cons 0 "INSERT")
         (cons 0 "LINE")
         (cons 0 "LWPOLYLINE")
         (cons 0 "MLINE")
         (cons 0 "MTEXT")
         (cons 0 "POINT")
         (cons 0 "POLYLINE")
         (cons 0 "SOLID")
         (cons 0 "TEXT")
         (cons 0 "TRACE")
         (cons 0 "XLINE")
       (cons -4 "OR>")
     )
   )
 )
 
 (if(and xset(> (sslength xset) 0))(setq xset(FilterClrNumbX xset xcol)))
 (if (and xset (> (sslength xset) 0))
   (progn
  (command "-layer" "new" xlay "")
  (command "change" xset "" "Properties" "LAyer" xlay "")
   )
 )
 (setvar "cmdecho" 1)
 (princ)
)
(princ "\n Type test")
(princ)[/color][/color]

(if (and xset (> (sslength xset) 0))
   (setq xset (FilterClrNumbX xset xcol))
 )
 (if (and xset (> (sslength xset) 0))
   (progn
     (command "-layer" "new" xlay "")
     (command "change" xset "" "Properties" "LAyer" xlay "")
   )
 )