[LISP程序]：配置(布局)排序

LUCAS

2. 
   
3. ;;;配置(布局)排序
   
4. ;;;程序设计:赖云龙;;;
   
5. ;;;---------------;;;
   
6. (defun C:LAYOUT_SORT (/ OBJDICT GRPDICT OUTLIST KEY SL N NN BB A3)
   
7.   (setq OBJDICT (namedobjdict))
   
8.   (setq GRPDICT (dictsearch OBJDICT "ACAD_LAYOUT"))
   
9.   (setq KEY (getstring "\n大至小<L>/<小至大>: "))
   
10.   (if (= KEY "")
    
11.     (setq OUTLIST (acad_strlsort (layoutlist)))
    
12.     (setq OUTLIST (reverse (acad_strlsort (layoutlist))))
    
13.   )
    
14.   (setq SL (length OUTLIST))
    
15.   (setq NN 0)
    
16.   (repeat SL
    
17.     (setq BB (nth NN OUTLIST))
    
18.     (setq N 2)
    
19.     (while (/= (cdr (assoc 1
    
20.                            (vl-member-if
    
21.                              '(lambda (X) (= (cdr X) "AcDbLayout"))
    
22.                              (entget (cdr (nth (+ 9 N) GRPDICT)))
    
23.                            )
    
24.                     )
    
25.                )
    
26.                BB
    
27.            )
    
28.       (setq N (+ 2 N))
    
29.     )
    
30.     (setq A3 (entget (cdr (nth (+ 9 N) GRPDICT))))
    
31.     (setq A3 (subst (cons 71 (+ 1 NN)) (assoc 71 A3) A3))
    
32.     (entmod A3)
    
33.     (setq NN (1+ NN))
    
34.   )
    
35.   (command "_.regen")
    
36.   (princ)
    
37. )
    

<br /> ;;;配置(布局)排序<br /> ;;;程序设计:赖云龙;;;<br /> ;;;---------------;;;<br /> (defun C:LAYOUT_SORT (/ OBJDICT GRPDICT OUTLIST KEY SL N NN BB A3)<br />   (setq OBJDICT (namedobjdict))<br />   (setq GRPDICT (dictsearch OBJDICT "ACAD_LAYOUT"))<br />   (setq KEY (getstring "\n大至小<L>/<小至大>: "))<br />   (if (= KEY "")<br />     (setq OUTLIST (acad_strlsort (layoutlist)))<br />     (setq OUTLIST (reverse (acad_strlsort (layoutlist))))<br />   )<br />   (setq SL (length OUTLIST))<br />   (setq NN 0)<br />   (repeat SL<br />     (setq BB (nth NN OUTLIST))<br />     (setq N 2)<br />     (while (/= (cdr (assoc 1<br />                            (vl-member-if<br />                              '(lambda (X) (= (cdr X) "AcDbLayout"))<br />                              (entget (cdr (nth (+ 9 N) GRPDICT)))<br />                            )<br />                     )<br />                )<br />                BB<br />            )<br />       (setq N (+ 2 N))<br />     )<br />     (setq A3 (entget (cdr (nth (+ 9 N) GRPDICT))))<br />     (setq A3 (subst (cons 71 (+ 1 NN)) (assoc 71 A3) A3))<br />     (entmod A3)<br />     (setq NN (1+ NN))<br />   )<br />   (command "_.regen")<br />   (princ)<br /> )<br />

2. 
   
3. ;;;删除空白配置(布局)更新
   
4. ;;;程序设计:赖云龙;;;
   
5. ;;;---------------;;;
   
6. (defun C:LAYOUT_DEL (/ HOLDECHO OUTLIST SL N LAYOUT_NAME A)
   
7.   (setq HOLDECHO (getvar "CMDECHO"))
   
8.   (setvar "CMDECHO" 0)
   
9.   (setq OUTLIST (LAYOUTLIST))
   
10.   (setq SL (length OUTLIST))
    
11.   (setq N 0)
    
12.   (repeat SL
    
13.     (setq LAYOUT_NAME (nth N OUTLIST))
    
14.     (setq A (ssget "X" (list (cons 410 LAYOUT_NAME))))
    
15.     (if        (or (= NIL A) (= (sslength A) 1))
    
16.       (command "_.layout" "delete" LAYOUT_NAME)
    
17.     )
    
18.     (setq N (1+ N))
    
19.   )
    
20.   (setvar "CMDECHO" HOLDECHO)
    
21.   (princ)
    
22. )
    

<br /> ;;;删除空白配置(布局)更新<br /> ;;;程序设计:赖云龙;;;<br /> ;;;---------------;;;<br /> (defun C:LAYOUT_DEL (/ HOLDECHO OUTLIST SL N LAYOUT_NAME A)<br />   (setq HOLDECHO (getvar "CMDECHO"))<br />   (setvar "CMDECHO" 0)<br />   (setq OUTLIST (LAYOUTLIST))<br />   (setq SL (length OUTLIST))<br />   (setq N 0)<br />   (repeat SL<br />     (setq LAYOUT_NAME (nth N OUTLIST))<br />     (setq A (ssget "X" (list (cons 410 LAYOUT_NAME))))<br />     (if        (or (= NIL A) (= (sslength A) 1))<br />       (command "_.layout" "delete" LAYOUT_NAME)<br />     )<br />     (setq N (1+ N))<br />   )<br />   (setvar "CMDECHO" HOLDECHO)<br />   (princ)<br /> )<br />

li809

ACAD本身就能实现这样的功能