[悬10币求]如何求出多个带分隔符字符串每段的最大值并返回带分隔符最大字符串（具体详

cabinsummer

yjr111 发表于 2011-10-31 22:09
源程序上传，没必要自己留着，就怕自己写得不好，所以不好意思拿出来。。。

可分组max，层次递进也比排序快

yjr111

cabinsummer 发表于 2011-11-1 08:01
可分组max，层次递进也比排序快

谢谢！其实max的用法我是前几天看http://bbs.mjtd.com/thread-90011-1-1.html这个帖子的时候才知道，ZZXXQQ版主用了max，所以没怎么用过，有时间我试试！

gzxl

为了看源码，占层楼

x_s_s_1

大概实现了自己的想法（其实别人早实现了，在结构界都实现烂了，不过不合意，并且无源码修改，都捂的紧，除了无所不及大侠放了点出来，只有自己从头再来了，浪费时间），放到办公室了，早晨上班将源码与测试图形发上来，还有些问题没解决，希望各位大侠支持

cabinsummer

x_s_s_1 发表于 2011-11-2 01:10
大概实现了自己的想法（其实别人早实现了，在结构界都实现烂了，不过不合意，并且无源码修改，都捂的紧，除 ...

适合自己的才是最好的。公布源码会对那些编译的人是个沉重的打击。如果楼主开源、宣传，并且适合多数人使用，会成为行业的事实标准。

x_s_s_1

根据大家的意见及提示做的，和前面的示例不同，问题不好表达，写在新示例中了
希望各位大侠继续指导，代码如下

2. ;;;(setq ss(ssget "x" '((0 . "TEXT"))));构造针对TEXT的选择集
   
3. (defun c:tt (/ ss lst i n lstt bb ang h)
   
4.   (setvar "dimzin" 8)
   
5.   (setvar "osmode" 0)
   
6.   (setq ss (ssget '((0 . "TEXT"))))        ;构造针对TEXT的选择集
   
7.   (command "justifytext" ss "" "c")
   
8.   (SETQ LST (makelsp ss 11));根据特征组码11分类列表
   
9.   (setq i 0)
   
10.   (setq n (length lst))
    
11.   (while (< i n)
    
12.     (setq lstt (nth i lst))
    
13. ;;;(setq bb(mapcar '(lambda (x) (Fsxm-Split x "-")) (cdr lstt)))
    
14.     (setq bb                        ;;;得到数字列表
    
15.            (mapcar
    
16.              '(lambda (x) (Fsxm-Split x "-"))
    
17.              (mapcar '(lambda (x) (cdr (assoc 1 (entget x)))) (cdr lstt))
    
18.            ) ;_ 结束mapcar
    
19.     ) ;_ 结束setq
    
20.     (setq ang (cdr (assoc 50 (entget (car (cdr lstt))))))
    
21.     (setq h (cdr (assoc 40 (entget (car (cdr lstt))))))
    
22.     (if        (wcmatch (car (car bb)) "#")
    
23.       (maketext (for-pj bb) h (car lstt) ang)
    
24.       (if (wcmatch (substr (car (car bb)) 1 1) "G")
    
25.         (maketext (for-g bb) h (car lstt) ang)
    
26.         (maketext (for-vt bb) h (car lstt) ang)
    
27.       ) ;_ 结束if求数字最大值并连接成字符串插入
    
28.     ) ;_ 结束if
    
29.     (setq i (1+ i))
    
30.   ) ;_ 结束while
    
31.   (command "_.erase" ss "");;;删除原有文字
    
32. ) ;_ 结束defun
    
33. ;; ! ***************************************************************************
    
34. ;; ! Fsxm-Split
    
35. ;; ! ***************************************************************************
    
36. ;; ! 功  能  : 用指定的分隔符对字符串分段提取字符.
    
37. ;; ! 参  数  : string字符串，strkey分隔符。
    
38. ;; ! 返回值  : 字符串表
    
39. ;; ! 说  明  : 适用 AutoCAD 2000+
    
40. ;; ! from    : fsxm
    
41. ;; ! Web     : http://bbs.mjtd.com/thread-89969-1-5.html
    
42. ;; ! ****************************************************************************
    
43. (defun Fsxm-Split (string strkey / po strlst xlen)
    
44.   (setq xlen (1+ (strlen strkey)))
    
45.   (while (setq po (vl-string-search strkey string))
    
46.     (setq strlst (cons (substr string 1 po) strlst))
    
47.     (setq string (substr string (+ po xlen)))
    
48.   ) ;_ 结束while
    
49.   (reverse (cons string strlst))
    
50. ) ;_ 结束defun
    
51. ;; ! ***************************************************************************
    
52. ;; ! makelsp
    
53. ;; ! ***************************************************************************
    
54. ;; ! 功  能  : 根据特征组码分类列表.
    
55. ;; ! 参  数  : SS选折集，bk特征组码。
    
56. ;; ! 返回值  : 特征组码值与图元名表
    
57. ;; ! 说  明  : 适用 AutoCAD 2000+
    
58. ;; ! from    : 龙龙仔
    
59. ;; ! Web     : http://bbs.mjtd.com/forum.php?mod=viewthread&tid=45690
    
60. ;; ! ****************************************************************************
    
61. 
    
62. (defun makelsp (ss BK / ENT LST1 LST2 LST3 N NAME)
    
63.   (setq N 0)
    
64.   (if ss
    
65.     (progn
    
66.       (repeat (sslength SS)
    
67.         (setq ENT (ssname SS N))
    
68.         (if (setq LST3
    
69.                    (assoc (setq NAME (cdr (assoc BK (entget ENt)))) LST2)
    
70.             ) ;_ 结束setq
    
71.           (progn
    
72. ;;;            (setq LST1 (append LST3 (list (CDR (assoc 1 (entget ENt))))))
    
73.             (setq LST1 (append LST3 (list ENt)))
    
74.             (setq LST2 (subst LST1 LST3 LST2))
    
75.           ) ;_ 结束progn
    
76. ;;;          (setq LST2 (cons (list NAME (CDR (assoc 1 (entget ENt)))) LST2))
    
77.           (setq LST2 (cons (list NAME ENt) LST2))
    
78.         ) ;_ 结束if
    
79.         (setq N (1+ N))
    
80.       ) ;_ 结束repeat
    
81.     ) ;_ 结束progn
    
82.   ) ;_ 结束if
    
83.   LST2
    
84. ) ;_ 结束defun
    
85. ;;;G字头判断
    
86. (defun for-g (bb /)
    
87.   (strcat
    
88.     "G"
    
89.     (rtos
    
90.       (eval
    
91.         (cons
    
92.           'max
    
93.           (mapcar 'atof
    
94.                   (mapcar '(lambda (x) (vl-string-left-trim "G" x))
    
95.                           (CAR (apply 'mapcar (cons 'list bb)))
    
96.                   ) ;_ 结束mapcar
    
97.           ) ;_ 结束mapcar
    
98.         ) ;_ 结束cons
    
99.       ) ;_ 结束eval
    
100.       2
     
101.       1
     
102.     ) ;_ 结束rtos
     
103.     "-"
     
104.     (rtos (eval
     
105.             (cons 'max
     
106.                   (mapcar 'atof (CADR (apply 'mapcar (cons 'list bb))))
     
107.             ) ;_ 结束cons
     
108.           ) ;_ 结束eval
     
109.           2
     
110.           1
     
111.     ) ;_ 结束rtos
     
112.   ) ;_ 结束strcat
     
113. ) ;_ 结束defun
     
114. ;;;VT字头判断
     
115. (defun for-VT (bb /)
     
116.   (strcat
     
117.     "VT"
     
118.     (rtos
     
119.       (eval
     
120.         (cons
     
121.           'max
     
122.           (mapcar 'atof
     
123.                   (mapcar '(lambda (x) (vl-string-left-trim "VT" x))
     
124.                           (CAR (apply 'mapcar (cons 'list bb)))
     
125.                   ) ;_ 结束mapcar
     
126.           ) ;_ 结束mapcar
     
127.         ) ;_ 结束cons
     
128.       ) ;_ 结束eval
     
129.       2
     
130.       1
     
131.     ) ;_ 结束rtos
     
132.     "-"
     
133.     (rtos (eval
     
134.             (cons 'max
     
135.                   (mapcar 'atof (CADR (apply 'mapcar (cons 'list bb))))
     
136.             ) ;_ 结束cons
     
137.           ) ;_ 结束eval
     
138.           2
     
139.           1
     
140.     ) ;_ 结束rtos
     
141.   ) ;_ 结束strcat
     
142. ) ;_ 结束defun
     
143. ;;;无字头判断
     
144. (defun for-pj (bb /)
     
145.   (strcat
     
146.     (rtos (eval
     
147.             (cons 'max
     
148.                   (mapcar 'atof (CAR (apply 'mapcar (cons 'list bb))))
     
149.             ) ;_ 结束cons
     
150.           ) ;_ 结束eval
     
151.           2
     
152.           1
     
153.     ) ;_ 结束rtos
     
154.     "-"
     
155.     (rtos (eval
     
156.             (cons 'max
     
157.                   (mapcar 'atof (CADR (apply 'mapcar (cons 'list bb))))
     
158.             ) ;_ 结束cons
     
159.           ) ;_ 结束eval
     
160.           2
     
161.           1
     
162.     ) ;_ 结束rtos
     
163.     "-"
     
164.     (rtos (eval
     
165.             (cons 'max
     
166.                   (mapcar 'atof (CADdR (apply 'mapcar (cons 'list bb))))
     
167.             ) ;_ 结束cons
     
168.           ) ;_ 结束eval
     
169.           2
     
170.           1
     
171.     ) ;_ 结束rtos
     
172.   ) ;_ 结束strcat
     
173. ) ;_ 结束defun
     
174. ;;;写文字
     
175. (defun maketext        (textt h pt ang /)
     
176.   (entmake (list '(0 . "text")
     
177.                  '(100 . "AcDbEntity")
     
178.                  '(8 . "0")
     
179.                  '(100 . "AcDbText")
     
180.                  (list 10 (car pt) (car (cdr pt)) 0)
     
181.                  (cons 1 textt)
     
182.                  (cons 40 h)
     
183.                  '(41 . 0.6)
     
184.                  '(7 . "standard")
     
185.                  '(72 . 1)
     
186.                  (list 11 (car pt) (car (cdr pt)) 0)
     
187.                  (cons 50 ang)
     
188.            ) ;_ 结束list
     
189.   ) ;_ 结束entmake
     
190. ) ;_ 结束defun
     

;;;(setq ss(ssget "x" '((0 . "TEXT"))));构造针对TEXT的选择集<br /> (defun c:tt (/ ss lst i n lstt bb ang h)<br />   (setvar "dimzin" 8)<br />   (setvar "osmode" 0)<br />   (setq ss (ssget '((0 . "TEXT"))))        ;构造针对TEXT的选择集<br />   (command "justifytext" ss "" "c")<br />   (SETQ LST (makelsp ss 11));根据特征组码11分类列表<br />   (setq i 0)<br />   (setq n (length lst))<br />   (while (< i n)<br />     (setq lstt (nth i lst))<br /> ;;;(setq bb(mapcar '(lambda (x) (Fsxm-Split x "-")) (cdr lstt)))<br />     (setq bb                        ;;;得到数字列表<br />            (mapcar<br />              '(lambda (x) (Fsxm-Split x "-"))<br />              (mapcar '(lambda (x) (cdr (assoc 1 (entget x)))) (cdr lstt))<br />            ) ;_ 结束mapcar<br />     ) ;_ 结束setq<br />     (setq ang (cdr (assoc 50 (entget (car (cdr lstt))))))<br />     (setq h (cdr (assoc 40 (entget (car (cdr lstt))))))<br />     (if        (wcmatch (car (car bb)) "#")<br />       (maketext (for-pj bb) h (car lstt) ang)<br />       (if (wcmatch (substr (car (car bb)) 1 1) "G")<br />         (maketext (for-g bb) h (car lstt) ang)<br />         (maketext (for-vt bb) h (car lstt) ang)<br />       ) ;_ 结束if求数字最大值并连接成字符串插入<br />     ) ;_ 结束if<br />     (setq i (1+ i))<br />   ) ;_ 结束while<br />   (command "_.erase" ss "");;;删除原有文字<br /> ) ;_ 结束defun<br /> ;; ! ***************************************************************************<br /> ;; ! Fsxm-Split<br /> ;; ! ***************************************************************************<br /> ;; ! 功  能  : 用指定的分隔符对字符串分段提取字符.<br /> ;; ! 参  数  : string字符串，strkey分隔符。<br /> ;; ! 返回值  : 字符串表<br /> ;; ! 说  明  : 适用 AutoCAD 2000+<br /> ;; ! from    : fsxm <br /> ;; ! Web     : http://bbs.mjtd.com/thread-89969-1-5.html<br /> ;; ! ****************************************************************************<br /> (defun Fsxm-Split (string strkey / po strlst xlen)<br />   (setq xlen (1+ (strlen strkey)))<br />   (while (setq po (vl-string-search strkey string))<br />     (setq strlst (cons (substr string 1 po) strlst))<br />     (setq string (substr string (+ po xlen)))<br />   ) ;_ 结束while<br />   (reverse (cons string strlst))<br /> ) ;_ 结束defun<br /> ;; ! ***************************************************************************<br /> ;; ! makelsp<br /> ;; ! ***************************************************************************<br /> ;; ! 功  能  : 根据特征组码分类列表.<br /> ;; ! 参  数  : SS选折集，bk特征组码。<br /> ;; ! 返回值  : 特征组码值与图元名表<br /> ;; ! 说  明  : 适用 AutoCAD 2000+<br /> ;; ! from    : 龙龙仔 <br /> ;; ! Web     : http://bbs.mjtd.com/forum.php?mod=viewthread&tid=45690<br /> ;; ! ****************************************************************************<br /> <br /> (defun makelsp (ss BK / ENT LST1 LST2 LST3 N NAME)<br />   (setq N 0)<br />   (if ss<br />     (progn<br />       (repeat (sslength SS)<br />         (setq ENT (ssname SS N))<br />         (if (setq LST3<br />                    (assoc (setq NAME (cdr (assoc BK (entget ENt)))) LST2)<br />             ) ;_ 结束setq<br />           (progn<br /> ;;;            (setq LST1 (append LST3 (list (CDR (assoc 1 (entget ENt))))))<br />             (setq LST1 (append LST3 (list ENt)))<br />             (setq LST2 (subst LST1 LST3 LST2))<br />           ) ;_ 结束progn<br /> ;;;          (setq LST2 (cons (list NAME (CDR (assoc 1 (entget ENt)))) LST2))<br />           (setq LST2 (cons (list NAME ENt) LST2))<br />         ) ;_ 结束if<br />         (setq N (1+ N))<br />       ) ;_ 结束repeat<br />     ) ;_ 结束progn<br />   ) ;_ 结束if<br />   LST2<br /> ) ;_ 结束defun<br /> ;;;G字头判断<br /> (defun for-g (bb /)<br />   (strcat<br />     "G"<br />     (rtos<br />       (eval<br />         (cons<br />           'max<br />           (mapcar 'atof<br />                   (mapcar '(lambda (x) (vl-string-left-trim "G" x))<br />                           (CAR (apply 'mapcar (cons 'list bb)))<br />                   ) ;_ 结束mapcar<br />           ) ;_ 结束mapcar<br />         ) ;_ 结束cons<br />       ) ;_ 结束eval<br />       2<br />       1<br />     ) ;_ 结束rtos<br />     "-"<br />     (rtos (eval<br />             (cons 'max<br />                   (mapcar 'atof (CADR (apply 'mapcar (cons 'list bb))))<br />             ) ;_ 结束cons<br />           ) ;_ 结束eval<br />           2<br />           1<br />     ) ;_ 结束rtos<br />   ) ;_ 结束strcat<br /> ) ;_ 结束defun<br /> ;;;VT字头判断<br /> (defun for-VT (bb /)<br />   (strcat<br />     "VT"<br />     (rtos<br />       (eval<br />         (cons<br />           'max<br />           (mapcar 'atof<br />                   (mapcar '(lambda (x) (vl-string-left-trim "VT" x))<br />                           (CAR (apply 'mapcar (cons 'list bb)))<br />                   ) ;_ 结束mapcar<br />           ) ;_ 结束mapcar<br />         ) ;_ 结束cons<br />       ) ;_ 结束eval<br />       2<br />       1<br />     ) ;_ 结束rtos<br />     "-"<br />     (rtos (eval<br />             (cons 'max<br />                   (mapcar 'atof (CADR (apply 'mapcar (cons 'list bb))))<br />             ) ;_ 结束cons<br />           ) ;_ 结束eval<br />           2<br />           1<br />     ) ;_ 结束rtos<br />   ) ;_ 结束strcat<br /> ) ;_ 结束defun<br /> ;;;无字头判断<br /> (defun for-pj (bb /)<br />   (strcat<br />     (rtos (eval<br />             (cons 'max<br />                   (mapcar 'atof (CAR (apply 'mapcar (cons 'list bb))))<br />             ) ;_ 结束cons<br />           ) ;_ 结束eval<br />           2<br />           1<br />     ) ;_ 结束rtos<br />     "-"<br />     (rtos (eval<br />             (cons 'max<br />                   (mapcar 'atof (CADR (apply 'mapcar (cons 'list bb))))<br />             ) ;_ 结束cons<br />           ) ;_ 结束eval<br />           2<br />           1<br />     ) ;_ 结束rtos<br />     "-"<br />     (rtos (eval<br />             (cons 'max<br />                   (mapcar 'atof (CADdR (apply 'mapcar (cons 'list bb))))<br />             ) ;_ 结束cons<br />           ) ;_ 结束eval<br />           2<br />           1<br />     ) ;_ 结束rtos<br />   ) ;_ 结束strcat<br /> ) ;_ 结束defun<br /> ;;;写文字<br /> (defun maketext        (textt h pt ang /)<br />   (entmake (list '(0 . "text")<br />                  '(100 . "AcDbEntity")<br />                  '(8 . "0")<br />                  '(100 . "AcDbText")<br />                  (list 10 (car pt) (car (cdr pt)) 0)<br />                  (cons 1 textt)<br />                  (cons 40 h)<br />                  '(41 . 0.6)<br />                  '(7 . "standard")<br />                  '(72 . 1)<br />                  (list 11 (car pt) (car (cdr pt)) 0)<br />                  (cons 50 ang)<br />            ) ;_ 结束list<br />   ) ;_ 结束entmake<br /> ) ;_ 结束defun<br />

yjr111

适合自己的才是好的！

x_s_s_1

yjr111 发表于 2011-11-2 09:30
适合自己的才是好的！

请教一下，以组码11为特征值过滤选择集的话，容差如何设置呢？还是期待飞版的，不知他如何实现的前面的效果

fsxm

................................................

fsxm

先按文字左下角的y坐标排序,
再以两倍字高为容差分组
后面按每组对应位置操作就行了