[LISP程序]：请高手解释一下

qqppx

小弟初学不久,搞不懂,请高手解释一下从(repeat....以下的程式是什么意思;另外,这个程式如果最后能将不同的图层改成不同的顏色就好了.

(defun c:disCir( / ss ent ents lay i r rs item zin)
  (setq zin (getvar "dimzin"))
  (setvar "dimzin" 0)
  (setvar "cmdecho" 0)
  (command "_.purge" "la" "*" "n")
  (setq ss (ssget "x" '((0 . "CIRCLE"))))
  (setq i 0)
  (setq lay 0)
  (repeat (sslength ss)
    (setq ent (ssname ss i))
    (setq ents (entget ent))
    (setq r (cdr (assoc 40 ents)))
    (if (assoc r rs)
      (progn
(setq item (reverse (assoc r rs)))
(setq item (reverse (cons (1+ (car item)) (cdr item))))
(setq rs (subst item (assoc r rs) rs))
      )
      (progn
(setq rs (append rs (list (list r (strcat "mylayer_" (rtos lay 2 0)) 1))))
(command "_.layer" "m" (strcat "mylayer_" (rtos lay 2 0)) "")
(setq lay (1+ lay))
  
      )
    )   
    (command "_.change" ent "" "p" "la" (cadr (assoc r rs)) "")   
    (setq i (1+ i))
  )
  (princ "\n图层\t\t直径\t\t孔数")
  (princ "\n------------------------------")
  (mapcar '(lambda(e) (princ (strcat "\n" (rtos (car e) 2 2) "\t" (cadr e) "\t" (rtos (last e) 2 0)))) rs)
  (setvar "dimzin" zin)
  (textscr)
  (princ)
)

----------------------在此多谢了----------------------

xyp1964

修改如下：

2. [FONT=courier new](defun c:test (/ ss i lay s1 es r lnm rs item)
   
3.   (setvar "dimzin" 0)
   
4.   (setvar "cmdecho" 0)
   
5.   (command "_.purge" "la" "*" "n")
   
6.   (setq        ss  (ssget "x" '((0 . "CIRCLE")))
   
7.         i   -1
   
8.         lay 0
   
9.   )
   
10.   (command "undo" "be")
    
11.   (repeat (sslength ss)
    
12.     (setq lay (1+ lay)
    
13.           s1  (ssname ss (setq i (1+ i)))
    
14.           es  (entget s1)
    
15.           r   (cdr (assoc 40 es))
    
16.           lnm (strcat "mylayer_" (rtos lay 2 0))
    
17.     )
    
18.     (if        (assoc r rs)
    
19.       (progn
    
20.         (setq item (reverse (assoc r rs))
    
21.               item (reverse (cons (1+ (car item)) (cdr item)))
    
22.               rs   (subst item (assoc r rs) rs)
    
23.         )
    
24.         (command "_.layer" "m" lnm "c" lay lnm "")
    
25.       )
    
26.       (progn
    
27.         (setq rs
    
28.                (append rs
    
29.                        (list (list r lnm 1))
    
30.                )
    
31.         )
    
32.         (command "_.layer" "m" lnm "c" lay lnm "")
    
33.       )
    
34.     )
    
35.     (command "_.change" s1 "" "p" "la" (cadr (assoc r rs)) "c" lay "")
    
36.   )
    
37.   (command "undo" "e")
    
38.   (princ "\n图层\t\t直径\t\t孔数")
    
39.   (princ "\n------------------------------")
    
40.   (mapcar '(lambda (e)
    
41.              (princ (strcat "\n"
    
42.                             (rtos (car e) 2 2)
    
43.                             "\t"
    
44.                             (cadr e)
    
45.                             "\t"
    
46.                             (rtos (last e) 2 0)
    
47.                     )
    
48.              )
    
49.            )
    
50.           rs
    
51.   )
    
52.   (textscr)
    
53.   (princ)
    
54. )[/FONT]

[FONT=courier new](defun c:test (/ ss i lay s1 es r lnm rs item)<br />   (setvar "dimzin" 0)<br />   (setvar "cmdecho" 0)<br />   (command "_.purge" "la" "*" "n")<br />   (setq        ss  (ssget "x" '((0 . "CIRCLE")))<br />         i   -1<br />         lay 0<br />   )<br />   (command "undo" "be")<br />   (repeat (sslength ss)<br />     (setq lay (1+ lay)<br />           s1  (ssname ss (setq i (1+ i)))<br />           es  (entget s1)<br />           r   (cdr (assoc 40 es))<br />           lnm (strcat "mylayer_" (rtos lay 2 0))<br />     )<br />     (if        (assoc r rs)<br />       (progn<br />         (setq item (reverse (assoc r rs))<br />               item (reverse (cons (1+ (car item)) (cdr item)))<br />               rs   (subst item (assoc r rs) rs)<br />         )<br />         (command "_.layer" "m" lnm "c" lay lnm "")<br />       )<br />       (progn<br />         (setq rs<br />                (append rs<br />                        (list (list r lnm 1))<br />                )<br />         )<br />         (command "_.layer" "m" lnm "c" lay lnm "")<br />       )<br />     )<br />     (command "_.change" s1 "" "p" "la" (cadr (assoc r rs)) "c" lay "")<br />   )<br />   (command "undo" "e")<br />   (princ "\n图层\t\t直径\t\t孔数")<br />   (princ "\n------------------------------")<br />   (mapcar '(lambda (e)<br />              (princ (strcat "\n"<br />                             (rtos (car e) 2 2)<br />                             "\t"<br />                             (cadr e)<br />                             "\t"<br />                             (rtos (last e) 2 0)<br />                     )<br />              )<br />            )<br />           rs<br />   )<br />   (textscr)<br />   (princ)<br /> )[/FONT]

qqppx

楼上的朋友将同一层上的圆又改成不同的顏色了,能不能一个层只用一种顏色啊

xyp1964

这样：
[php](defun c:test (/ ss i lay s1 es r lnm rs item)
  (setvar "dimzin" 0)
  (setvar "cmdecho" 0)
  (command "_.purge" "la" "*" "n")
  (setq        ss  (ssget "x" '((0 . "CIRCLE")))
        i   -1
        lay 0
  )
  (command "undo" "be")
  (repeat (sslength ss)
    (setq lay (1+ lay)
          s1  (ssname ss (setq i (1+ i)))
          es  (entget s1)
          r   (cdr (assoc 40 es))
          lnm (strcat "mylayer_" (rtos lay 2 0))
    )
    (if        (assoc r rs)
      (progn
        (setq item (reverse (assoc r rs))
              item (reverse (cons (1+ (car item)) (cdr item)))
              rs   (subst item (assoc r rs) rs)
        )
        (command "_.layer" "m" lnm "c" lay lnm "")
      )
      (progn
        (setq rs
               (append rs
                       (list (list r lnm 1))
               )
        )
        (command "_.layer" "m" lnm "c" lay lnm "")
      )
    )
    ;(command "_.change" s1 "" "p" "la" (cadr (assoc r rs)) "c" lay "");;修改此处
    (command "_.change" s1 "" "p" "la" (cadr (assoc r rs)) "")
  )
  (command "undo" "e")
  (princ "\n图层\t\t直径\t\t孔数")
  (princ "\n------------------------------")
  (mapcar '(lambda (e)
             (princ (strcat "\n"
                            (rtos (car e) 2 2)
                            "\t"
                            (cadr e)
                            "\t"
                            (rtos (last e) 2 0)
                    )
             )
           )
          rs
  )
  (textscr)
  (princ)
)[/php]

qqppx

非常感谢楼上的朋友.
能否解释下面的是什么意思
(repeat (sslength ss)
    (setq lay (1+ lay)
      s1  (ssname ss (setq i (1+ i)))
      es  (entget s1)
      r   (cdr (assoc 40 es))
      lnm (strcat "mylayer_" (rtos lay 2 0))
    )
    (if    (assoc r rs)
      (progn
    (setq item (reverse (assoc r rs))
          item (reverse (cons (1+ (car item)) (cdr item)))
          rs   (subst item (assoc r rs) rs)
    )
    (command "_.layer" "m" lnm "c" lay lnm "")
      )
      (progn
    (setq rs
           (append rs
               (list (list r lnm 1))
           )
    )

fuweihua

太深奥，一点都不懂。要再研究研究。