按指定字母顺序排列

xyz2009xyz

按指定字母顺序排列：
比如如下图片中：按指定字母顺序T,P,F排序，只取首字母即可，不知道有没有高手写过这样的代码，能否指导一下！

xyz2009xyz

上面的是按照A-Z字母序排列的，采用的ZML大虾排序函数：按组码内容排序的
;;;===================================================================================================
;; 通用函数 选择集按照给定的组码值进行排序
;;程序来自网络，版权归作者zml84所有
;|参数说明：  
              SE  ----要排序的选择集                                                                  
              DXF ----排序依据的组码号                                                                 
              INT ----如果组码值为一个表，则INT指出使用第几个；否则nil                                 
              FUZZ----允许偏差；若无为nil                                                              
              K   ----T表示从大到小，nil表示从小到大                                                   
    返回值：排序后的选择集                                                                             
    示例：(SORT-SE SS 10 0   5.0 T  )  表示按照10组码的X坐标值进行排序，允许偏差值为5.0，顺序为从大到小
          (SORT-SE SS 10 1   3.0 NIL)  表示按照10组码的Y坐标值进行排序，允许偏差值为3.0，顺序为从小到大
          (SORT-SE SS 8  NIL NIL NIL)  表示按照8组码值（图层名称）进行排序，顺序为从小到大            
|;
;;;===================================================================================================
(defun SORT-SE (SE DXF INT FUZZ K / ENT INDEX LST NEWLST NEWSE TMP)
    (vl-load-com)
    ;;建立排序列表
    (setq LST '()
   INDEX 0
    )
    (repeat (sslength SE)
(setq ENT (entget (ssname SE INDEX))
       TMP (cdr (assoc DXF ENT))
)
(if (and INT
   (= (type INT) 'INT)
   (= (type TMP) 'list)
   (< INT (length TMP))
     )
     (setq TMP (nth INT TMP))
)
(setq LST (cons
        (list TMP (cdr (assoc 5 ENT)))
        LST
    )
)
(setq INDEX (1+ INDEX))
    )
    ;;排序操作
    (if (and FUZZ
      (or
   (= (type FUZZ) 'INT)
   (= (type FUZZ) 'REAL)
      )
      (or
   (= (type TMP) 'INT)
   (= (type TMP) 'REAL)
      )
)
(setq NEWLST
   (vl-sort LST
     (function (lambda (E1 E2)
     (< (+ (car E1) FUZZ) (car E2))
        )
     )
   )
)
(setq NEWLST
   (vl-sort LST
     (function (lambda (E1 E2)
     (< (car E1) (car E2))
        )
     )
   )
)
    )
    ;;如果K为T，则倒置
    (if K
(setq NEWLST (reverse NEWLST))
    )
    ;;组织排序后的选择集
    (setq NEWSE (ssadd))
    (foreach TMP NEWLST
(setq NEWSE (ssadd (handent (cadr TMP)) NEWSE))
    )
    ;;返回值
    NEWSE
) ;_结束defun

能否修改成“按组码内容+如果设定按指定字母排序则取首字母排序两种组合，没有指定则按组码内容排序”?

xyp1964

2. 
   
3. ;; 文本排序变色
   
4. (defun c:tt ()
   
5.   (setq ss  (ssget '((0 . "TEXT") (1 . "T*,P*,F*")))
   
6.            lst '()
   
7.            i   -1
   
8.   )
   
9.   (while (setq s1 (ssname ss (setq i (1+ i))))
   
10.     (setq lst (cons s1 lst))
    
11.   )
    
12.   (setq lst (vl-sort lst
    
13.                '(lambda (x y)
    
14.          (< (vla-get-textstring (vlax-ename->vla-object x))
    
15.                          (vla-get-textstring (vlax-ename->vla-object y))
    
16.                   )))
    
17.         i   1
    
18.   )
    
19.   (foreach a lst
    
20.     (vla-put-color (vlax-ename->vla-object a) i)
    
21.     (setq i (1+ i))
    
22.   )
    
23.   (princ)
    
24. )
    

<br /> ;; 文本排序变色<br /> (defun c:tt ()<br />   (setq ss  (ssget '((0 . "TEXT") (1 . "T*,P*,F*")))<br />            lst '()<br />            i   -1<br />   )<br />   (while (setq s1 (ssname ss (setq i (1+ i))))<br />     (setq lst (cons s1 lst))<br />   )<br />   (setq lst (vl-sort lst<br />                '(lambda (x y)<br />          (< (vla-get-textstring (vlax-ename->vla-object x))<br />                          (vla-get-textstring (vlax-ename->vla-object y))<br />                   )))<br />         i   1<br />   )<br />   (foreach a lst<br />     (vla-put-color (vlax-ename->vla-object a) i)<br />     (setq i (1+ i))<br />   )<br />   (princ)<br /> )<br />

461045462

xyp1964 发表于 2012-7-11 22:11

谢谢斑竹的分享！
下载收藏学习学习。
谢谢！

革天明

牛人很多啊

xyz2009xyz

xyp1964 发表于 2012-7-11 22:11

可能是我表述不清楚：要实现排序效果如下图附件示例

xyz2009xyz

再顶一下，有没有高手！