网站找到的 帮忙改改 圆分色按大小填标记号

lzg8877

程序是由内到外的分色 能否给改改为： 由外到内的 反个方向 请求会的出个手 谢谢!学习 等~
;圆分色按大小填标记号 明经 ZZXXQQ 2008.1.19
(defun c:vv ()
(setvar "CMDECHO" 0)
(if (setq ss (ssget '((0 . "CIRCLE")))) (progn
  (command ".UNDO" "BE")
  (setq i -1  cirlst (list))
  (repeat (sslength ss)
   (setq r (cdr (assoc 40 (entget (setq en (ssname ss (setq i (1+ i))))))))
   (if (assoc r cirlst)
(setq cirlst (subst (cons r (1+ (cdr (assoc r cirlst)))) (assoc r cirlst) cirlst))
    (setq cirlst (cons (cons r 1) cirlst))
   )
  )
  (setq i -1 cirlst (reverse cirlst))
  (setq dwglst (list "1" "2" "3" "4" "5" "9" "10" "11" "18" "20" "24" "25" "26" "28" "31" "32"
      "34" "35" "38" "39" "40" "41" "42" "44"))
  (setq cirlst (vl-sort cirlst (function (lambda (e1 e2) (< (car e1) (car e2))))))
  (repeat (length cirlst)
   (setq r (car (nth (setq i (1+ i)) cirlst)))
   (command "select" ss "")
   (setq ss1 (ssget "P" (list (cons 0 "CIRCLE") (cons 40 r))))
   (command "chprop" ss1 "" "C" (itoa (1+ i)) "")
   (if (setq bnm (findfile (strcat (nth i dwglst) ".dwg"))) (progn
    (setq j 0)
(setq pc (cdr(assoc 10 (entget(ssname ss1 0)))))
(command "-insert" bnm pc "" "" "" "chprop" "l" "" "C" (itoa (1+ i)) "")
(setq bnm (nth i dwglst))
    (repeat (1- (sslength ss1))
     (setq pc (cdr (assoc 10 (entget(ssname ss1 (setq j (1+ j)))))))
  (command "-insert" bnm pc "" "" "" "chprop" "l" "" "C" (itoa (1+ i)) "")
    )
   ))
  )
  (command ".UNDO" "E")
))
(setvar "CMDECHO" 1)
(princ)
)

lzg8877

帮我顶哈 谢谢

xyp1964

2. ;; 圆按大→小分色
   
3. (defun c:tt ()
   
4.   (if (setq ss (ssget '((0 . "CIRCLE"))))
   
5.     (progn
   
6.       (setq i        -1
   
7.             lst        '()
   
8.       )
   
9.       (while (setq s1 (ssname ss (setq i (1+ i))))
   
10.         (setq r          (cdr (assoc 40 (entget s1)))
    
11.               lst (if (member r lst)
    
12.                     lst
    
13.                     (cons r lst)
    
14.                   )
    
15.         )
    
16.       )
    
17.       (setq lst        (vl-sort lst '>)
    
18.             i        0
    
19.       )
    
20.       (foreach r lst
    
21.         (command "select" ss "")
    
22.         (setq ss1 (ssget "P" (list '(0 . "CIRCLE") (cons 40 r))))
    
23.         (command "chprop" ss1 "" "C" (itoa (1+ i)) "")
    
24.         (setq i (1+ i))
    
25.       )
    
26.     )
    
27.   )
    
28.   (princ)
    
29. )

;; 圆按大→小分色<br /> (defun c:tt ()<br />   (if (setq ss (ssget '((0 . "CIRCLE"))))<br />     (progn<br />       (setq i        -1<br />             lst        '()<br />       )<br />       (while (setq s1 (ssname ss (setq i (1+ i))))<br />         (setq r          (cdr (assoc 40 (entget s1)))<br />               lst (if (member r lst)<br />                     lst<br />                     (cons r lst)<br />                   )<br />         )<br />       )<br />       (setq lst        (vl-sort lst '>)<br />             i        0<br />       )<br />       (foreach r lst<br />         (command "select" ss "")<br />         (setq ss1 (ssget "P" (list '(0 . "CIRCLE") (cons 40 r))))<br />         (command "chprop" ss1 "" "C" (itoa (1+ i)) "")<br />         (setq i (1+ i))<br />       )<br />     )<br />   )<br />   (princ)<br /> )

lzg8877

夜了回家   
xyp1964
版主
谢谢呀