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

13579

正像楼主说的，结构圈早就有成熟的程序，只是没源码。楼主精神可嘉，赞一个。

yanshengjiang

cabinsummer 发表于 2011-10-30 16:19
(setvar "dimzin" 8)可以抑制rtos后面的0
你的做法复杂了，用inpos将每个G开头的字符串按-分割成两段， ...

(defun subs(fengefu str)
       (while (vl-string-search fengefu str)
         (setq str(vl-string-subst " " fengefu str))
         )
  (Setq str(read(strcat "("  str  ")" )))
  str
  )
;(subs "-" "ming-jing-tong-dao-5-2-0")======(MING JING TONG DAO 5 2 0)
;(subs "v" "明经通v道v我嗳你")              (明经 通道 我嗳你)

yjr111

灌水一下，请版主见谅！

yjr111

顶满50楼，在此灌水，请版主不要扣我钱！

x_s_s_1

不好意思前段时间出差了，刚刚回来，看了yanshengjiang 兄的帖子灰常给力，谢谢了，谢谢YJR111兄的顶帖

yjr111

难道大伙就这样让飞诗的源码压在箱底？

夏生生

绞尽脑汁，搞不定第36楼的例题，厚颜顶起，坐等飞版源码，看是否可以给予启发。（我是马甲）

xiaxiang

飞诗(fsxm) 发表于 2011-10-31 20:03
我也过来练练手哦！
先占下本楼备用！
下班后上传程序！

来凑热闹了，好像已经到50楼了。。。

仲文玉

49楼建设，迎接飞诗

飞诗(fsxm)

俺占楼备用哈！
上源码！本程序只针对一楼只有一列的情况哦！
多列的还得另修改哈！就是我在程序中用＝＝＝＝双横线夹着的中间“分组”部分！

1. 
   
2. ;;几个常用的全局变量
   
3. (vl-load-com)
   
4. (setq *acad* (vlax-get-acad-object))
   
5. (setq *doc* (vla-get-ActiveDocument *acad*))
   
6. ;;无声退出
   
7. (defun fsxm-silenceexit (/ *error*)
   
8.   (t (setq *error* strcat))
   
9. )
   
10. ;;连结表中字符串
    
11. (defun Fsxm-join (lst str)
    
12.   (substr (apply 'strcat
    
13.    (mapcar (function (lambda (a) (strcat str a))) lst)
    
14.    )
    
15.    (1+ (strlen str))
    
16.   )
    
17. )
    
18. ;;左下角Y坐标
    
19. (defun GetMinY (obj)
    
20.   (vla-GetBoundingBox obj 'Minp 'Maxp)
    
21.   (cadr (vlax-safearray->list Minp))
    
22. )
    
23. ;;分离字母前缀(GetSYM "VH12-5-6")
    
24. (defun GetSYM (str / cur n nstr nums)
    
25.   (setq n 1)
    
26.   (while (not (wcmatch (substr str n 1) "#"))
    
27.     (setq n (1+ n))
    
28.   )
    
29.   (setq nums (vl-string-translate "-" " " (substr str n)))
    
30.   (list (substr str 1 (1- n)) (read (strcat "(" nums ")")))
    
31. )
    
32. ;;
    
33. (defun Obj->List (obj)
    
34.   (cons obj (GetSYM (vla-get-TextString obj)))
    
35. )
    
36. ;;处得一组最大值文字
    
37. (defun GetMaxStr (lst / bodystr maxnums sym)
    
38.   (setq maxNums
    
39.   (apply 'mapcar
    
40.   (cons 'max (vl-remove nil (mapcar 'last lst)))
    
41.   )
    
42.   )
    
43.   (setq BodyStr (fsxm-join (mapcar 'itoa maxNums) "-")) ;主体
    
44.   (setq sym (cadar   ;前缀
    
45.        (vl-member-if
    
46.   (function (lambda (a) (= (caaddr a) (car maxNums))))
    
47.   lst
    
48.        )
    
49.      )
    
50.   )
    
51.   (strcat sym bodyStr)
    
52. )
    
53. 
    
54. ;;主程序
    
55. (defun c:test (/      copy   grp    grplen lasty  miny  n obj
    
56.         objs   objs2  objs3  pt    pt0   ss  str strlst
    
57.         texthx2      tmp
    
58.        )
    
59.   (setq ss (ssget '((0 . "text"))))
    
60.   (or ss (fsxm-silenceexit))
    
61. 
    
62.   ;;分组=======================================================
    
63.   ;;(setq objs nil)
    
64.   (vlax-for obj (vla-get-ActiveSelectionSet *doc*)
    
65.     (setq objs (cons (list (GetminY obj) obj) objs))
    
66.   )
    
67.   (setq objs (vl-sort objs
    
68.         (function (lambda (a b) (> (car a) (car b))))
    
69.       )
    
70.   )
    
71.   (setq TextHx2 (* 2.0 (vla-get-Height (cadar objs))))
    
72.   (setq lastY (caar objs))
    
73.   (setq objs2 nil)
    
74.   (setq tmp (list (Obj->List (cadar objs))))
    
75.   (foreach obj (cdr objs)
    
76.     (setq minY (car obj))
    
77.     (if (equal lastY minY TextHx2)
    
78.       (setq tmp (cons (Obj->List (cadr obj)) tmp))
    
79.       (setq objs2 (cons (reverse tmp) objs2)
    
80.      tmp   (list (Obj->List (cadr obj)))
    
81.       )
    
82.     )
    
83.     (setq lastY minY)
    
84.   )
    
85.   (setq objs2 (reverse (cons (reverse tmp) objs2)))
    
86.   (setq GrpLen (apply 'max (mapcar 'length objs2)))
    
87.   ;;(setq objs3 nil)
    
88.   (setq n 0)
    
89.   (repeat GrpLen
    
90.     (setq objs3 (cons (mapcar (function (lambda (a) (nth n a))) objs2)
    
91.         objs3
    
92.   )
    
93.    n (1+ n)
    
94.     )
    
95.   )
    
96.   ;;分组end=====================================================
    
97. 
    
98.   ;;生成结果文字
    
99.   (setq strLst (mapcar 'GetMaxStr (reverse objs3)))
    
100.   (setq grp (mapcar
     
101.        'car
     
102.        (car
     
103.   (vl-member-if
     
104.     (function (lambda (a) (= (length a) GrpLen)))
     
105.     objs2
     
106.   )
     
107.        )
     
108.      )
     
109.   )
     
110.   (setq pt (getpoint "\n放置结果:"))
     
111.   (or pt (fsxm-silenceexit))
     
112.   (setq pt (trans pt 1 0))
     
113.   (setq pt0 (vlax-get (last grp) 'InsertionPoint))
     
114.   (mapcar '(lambda (obj str)
     
115.       (setq copy (vla-copy obj))
     
116.       (vla-put-TextString copy str)
     
117.       (vlax-invoke copy 'Move pt0 pt)
     
118.     )
     
119.    grp
     
120.    strLst
     
121.   )
     
122.   (princ)
     
123. )
     

<br /> ;;几个常用的全局变量<br /> (vl-load-com)<br /> (setq *acad* (vlax-get-acad-object))<br /> (setq *doc* (vla-get-ActiveDocument *acad*))<br /> ;;无声退出<br /> (defun fsxm-silenceexit (/ *error*)<br />   (t (setq *error* strcat))<br /> )<br /> ;;连结表中字符串<br /> (defun Fsxm-join (lst str)<br />   (substr (apply 'strcat<br />    (mapcar (function (lambda (a) (strcat str a))) lst)<br />    )<br />    (1+ (strlen str))<br />   )<br /> )<br /> ;;左下角Y坐标<br /> (defun GetMinY (obj)<br />   (vla-GetBoundingBox obj 'Minp 'Maxp)<br />   (cadr (vlax-safearray->list Minp))<br /> )<br /> ;;分离字母前缀(GetSYM "VH12-5-6")<br /> (defun GetSYM (str / cur n nstr nums)<br />   (setq n 1)<br />   (while (not (wcmatch (substr str n 1) "#"))<br />     (setq n (1+ n))<br />   )<br />   (setq nums (vl-string-translate "-" " " (substr str n)))<br />   (list (substr str 1 (1- n)) (read (strcat "(" nums ")")))<br /> )<br /> ;;<br /> (defun Obj->List (obj)<br />   (cons obj (GetSYM (vla-get-TextString obj)))<br /> )<br /> ;;处得一组最大值文字<br /> (defun GetMaxStr (lst / bodystr maxnums sym)<br />   (setq maxNums<br />   (apply 'mapcar<br />   (cons 'max (vl-remove nil (mapcar 'last lst)))<br />   )<br />   )<br />   (setq BodyStr (fsxm-join (mapcar 'itoa maxNums) "-")) ;主体<br />   (setq sym (cadar   ;前缀<br />        (vl-member-if<br />   (function (lambda (a) (= (caaddr a) (car maxNums))))<br />   lst<br />        )<br />      )<br />   )<br />   (strcat sym bodyStr)<br /> )<br /> <br /> ;;主程序<br /> (defun c:test (/      copy   grp    grplen lasty  miny  n obj<br />         objs   objs2  objs3  pt    pt0   ss  str strlst<br />         texthx2      tmp<br />        )<br />   (setq ss (ssget '((0 . "text"))))<br />   (or ss (fsxm-silenceexit))<br /> <br />   ;;分组=======================================================<br />   ;;(setq objs nil)<br />   (vlax-for obj (vla-get-ActiveSelectionSet *doc*)<br />     (setq objs (cons (list (GetminY obj) obj) objs))<br />   )<br />   (setq objs (vl-sort objs<br />         (function (lambda (a b) (> (car a) (car b))))<br />       )<br />   )<br />   (setq TextHx2 (* 2.0 (vla-get-Height (cadar objs))))<br />   (setq lastY (caar objs))<br />   (setq objs2 nil)<br />   (setq tmp (list (Obj->List (cadar objs))))<br />   (foreach obj (cdr objs)<br />     (setq minY (car obj))<br />     (if (equal lastY minY TextHx2)<br />       (setq tmp (cons (Obj->List (cadr obj)) tmp))<br />       (setq objs2 (cons (reverse tmp) objs2)<br />      tmp   (list (Obj->List (cadr obj)))<br />       )<br />     )<br />     (setq lastY minY)<br />   )<br />   (setq objs2 (reverse (cons (reverse tmp) objs2)))<br />   (setq GrpLen (apply 'max (mapcar 'length objs2)))<br />   ;;(setq objs3 nil)<br />   (setq n 0)<br />   (repeat GrpLen<br />     (setq objs3 (cons (mapcar (function (lambda (a) (nth n a))) objs2)<br />         objs3<br />   )<br />    n (1+ n)<br />     )<br />   )<br />   ;;分组end=====================================================<br /> <br />   ;;生成结果文字<br />   (setq strLst (mapcar 'GetMaxStr (reverse objs3)))<br />   (setq grp (mapcar<br />        'car<br />        (car<br />   (vl-member-if<br />     (function (lambda (a) (= (length a) GrpLen)))<br />     objs2<br />   )<br />        )<br />      )<br />   )<br />   (setq pt (getpoint "\n放置结果:"))<br />   (or pt (fsxm-silenceexit))<br />   (setq pt (trans pt 1 0))<br />   (setq pt0 (vlax-get (last grp) 'InsertionPoint))<br />   (mapcar '(lambda (obj str)<br />       (setq copy (vla-copy obj))<br />       (vla-put-TextString copy str)<br />       (vlax-invoke copy 'Move pt0 pt)<br />     )<br />    grp<br />    strLst<br />   )<br />   (princ)<br /> )<br />