技术无价，但请帮忙：范围选数改色升级，字符串中数值取大值

doremidai

运行SZFW,运行后达到图片的功能。下面的代码可以找出普通数值的大值，但如果最大值在中部或者在尾部，则不行。请大虾帮改一下。

2. (defun c:szfw(/ r_min r_max co ss n en ent s)
   
3. 
   
4. (setq layer_bk (getvar "clayer"))
   
5. (setvar "cmdecho" 0)
   
6. (setq osmode_backup (getvar "osmode"))
   
7. (setvar "OSMODE" 0)
   
8.   
   
9.   (if (setq r_min (getreal "\n请输入变色改层数字下限(不包含)<1.1>:")) nil (setq r_min 1.1))
   
10.   (if (setq r_max (getreal "\n请输入变色改层数字上限(不包含)<9.99>:")) nil (setq r_max 9.99))
    
11.    
    
12.   (setq co (acad_colordlg 1))
    
13. 
    
14. ;-----------------------------------------------------------------------------
    
15. (if (= (tblobjname "LAYER" "JGLS-1临时图层") nil)
    
16. (progn
    
17. (entmake (list
    
18.     '(0 . "LAYER")
    
19.     '(100 . "AcDbSymbolTableRecord")
    
20.     '(100 . "AcDbLayerTableRecord")
    
21.     '(6 . "CONTINUOUS")
    
22.     '(62 . 1)
    
23.     '(70 . 0)
    
24.     (cons 2 "JGLS-1临时图层")
    
25.    )
    
26. )
    
27. )
    
28. )
    
29. (setvar "clayer" "JGLS-1临时图层")
    
30. (command "color" "bylayer")
    
31. ;-----------------------------------------------------------------------------
    
32.   (setq ss (ssget  '((0 . "TEXT")(-4 . "<AND")(1 . "~*&#91;~!-~&#93;*")(1 . "~*@*")(1 . "*#*")(-4 . "AND>"))))
    
33.     (repeat (setq n (sslength ss))
    
34.     (setq en (ssname ss (setq n (1- n))))
    
35.     (setq ent (entget en))
    
36.     (setq s (atof (cdr (assoc 1 ent))))
    
37.       (if (and (> s r_min) (< s r_max))
    
38. 
    
39.          (if (assoc 8 ent) (setq ent (subst (cons 8 "JGLS-1临时图层") (assoc 8 ent) ent))
    
40.           (setq ent (cons (cons 8 "JGLS-1临时图层") ent))
    
41.          ) ;end if 1
    
42.         
    
43.        )  ;end if   2
    
44. 
    
45.      (if (and (> s r_min) (< s r_max))
    
46. 
    
47.          (if (assoc 62 ent) (setq ent (subst (cons 62 co) (assoc 62 ent) ent))
    
48.           (setq ent (cons (cons 62 co) ent))
    
49.          ) ;end if 1
    
50.         
    
51.        )  ;end if   2
    
52. 
    
53.       (entmod ent)
    
54.       
    
55.     ) ;end repeat
    
56.    (setvar "clayer" layer_bk)
    
57.    (setvar "OSMODE" osmode_backup)
    
58.    
    
59.   (princ)
    
60.   )
    

(defun c:szfw(/ r_min r_max co ss n en ent s)<br /> <br /> (setq layer_bk (getvar "clayer"))<br /> (setvar "cmdecho" 0)<br /> (setq osmode_backup (getvar "osmode"))<br /> (setvar "OSMODE" 0)<br />   <br />   (if (setq r_min (getreal "\n请输入变色改层数字下限(不包含)<1.1>:")) nil (setq r_min 1.1))<br />   (if (setq r_max (getreal "\n请输入变色改层数字上限(不包含)<9.99>:")) nil (setq r_max 9.99))<br />    <br />   (setq co (acad_colordlg 1))<br /> <br /> ;-----------------------------------------------------------------------------<br /> (if (= (tblobjname "LAYER" "JGLS-1临时图层") nil)<br /> (progn<br /> (entmake (list<br />     '(0 . "LAYER")<br />     '(100 . "AcDbSymbolTableRecord")<br />     '(100 . "AcDbLayerTableRecord")<br />     '(6 . "CONTINUOUS")<br />     '(62 . 1)<br />     '(70 . 0)<br />     (cons 2 "JGLS-1临时图层")<br />    )<br /> )<br /> )<br /> )<br /> (setvar "clayer" "JGLS-1临时图层")<br /> (command "color" "bylayer")<br /> ;-----------------------------------------------------------------------------<br />   (setq ss (ssget  '((0 . "TEXT")(-4 . "<AND")(1 . "~*&#91;~!-~&#93;*")(1 . "~*@*")(1 . "*#*")(-4 . "AND>"))))<br />     (repeat (setq n (sslength ss))<br />     (setq en (ssname ss (setq n (1- n))))<br />     (setq ent (entget en))<br />     (setq s (atof (cdr (assoc 1 ent))))<br />       (if (and (> s r_min) (< s r_max))<br /> <br />          (if (assoc 8 ent) (setq ent (subst (cons 8 "JGLS-1临时图层") (assoc 8 ent) ent))<br />           (setq ent (cons (cons 8 "JGLS-1临时图层") ent))<br />          ) ;end if 1<br />         <br />        )  ;end if   2<br /> <br />      (if (and (> s r_min) (< s r_max))<br /> <br />          (if (assoc 62 ent) (setq ent (subst (cons 62 co) (assoc 62 ent) ent))<br />           (setq ent (cons (cons 62 co) ent))<br />          ) ;end if 1<br />         <br />        )  ;end if   2<br /> <br />       (entmod ent) <br />       <br />     ) ;end repeat<br />    (setvar "clayer" layer_bk)<br />    (setvar "OSMODE" osmode_backup)<br />    <br />   (princ)<br />   )<br />

wau2000022

联系我QQ496968041

陨落

这个好弄，

强力打酱油

强力围观一下，

437271963

2. (defun c:szfw(/ r_min r_max co ss n en ent s)
   
3. 
   
4. (setq layer_bk (getvar "clayer"))
   
5. (setvar "cmdecho" 0)
   
6. (setq osmode_backup (getvar "osmode"))
   
7. (setvar "OSMODE" 0)
   
8. (if (null vlax-dump-object) (vl-load-com) )
   
9. 
   
10.   (if (setq r_min (getreal "\n请输入变色改层数字下限(不包含)<1.1>:")) nil (setq r_min 1.1))
    
11.   (if (setq r_max (getreal "\n请输入变色改层数字上限(不包含)<9.99>:")) nil (setq r_max 9.99))
    
12.    
    
13.   (setq co (acad_colordlg 1))
    
14. 
    
15. ;-----------------------------------------------------------------------------
    
16. (if (= (tblobjname "LAYER" "JGLS-1临时图层") nil)
    
17. (progn
    
18. (entmake (list
    
19.     '(0 . "LAYER")
    
20.     '(100 . "AcDbSymbolTableRecord")
    
21.     '(100 . "AcDbLayerTableRecord")
    
22.     '(6 . "CONTINUOUS")
    
23.     '(62 . 1)
    
24.     '(70 . 0)
    
25.     (cons 2 "JGLS-1临时图层")
    
26.    )
    
27. )
    
28. )
    
29. )
    
30. (setvar "clayer" "JGLS-1临时图层")
    
31. (command "color" "bylayer")
    
32. ;-----------------------------------------------------------------------------
    
33.   (setq ss (ssget  '((0 . "TEXT")(-4 . "<AND")(1 . "~*&#91;~!-~&#93;*")(1 . "~*@*")(1 . "*#*")(-4 . "AND>"))))
    
34.    (repeat (setq n (sslength ss))
    
35.     (setq en (ssname ss (setq n (1- n))))
    
36.     (setq ent (entget en) en (vlax-ename->vla-object en))
    
37.     (setq s (cdr (assoc 1 ent)))
    
38.     (setq s (lsp201602281 s))
    
39.     (if (and s (> s r_min) (< s r_max))
    
40.      (progn
    
41.       (vla-put-layer en "JGLS-1临时图层");改变图层
    
42.       (vla-put-color en co);改变颜色
    
43.      )
    
44.     )
    
45.       
    
46.    ) ;end repeat
    
47.    (setvar "clayer" layer_bk)
    
48.    (setvar "OSMODE" osmode_backup)
    
49.    
    
50.   (princ)
    
51.   )
    
52.   
    
53. (defun lsp201602281 (&a1 / &a1 &a2 &n1 &ss1);拆开文字内容
    
54. (setq &ss1 '())
    
55. (while (/= &a1 "")
    
56.   (setq &a2 (substr &a1 1 1) &n1 (ascii &a2))
    
57.   (if (< &n1 128)
    
58.    (setq &a1 (substr &a1 2))
    
59.    (progn
    
60.     (setq &a2 (substr &a1 1 2) &a1 (substr &a1 3))
    
61.    )
    
62.   )
    
63.   (setq &ss1 (cons &a2 &ss1))
    
64. );while
    
65. (if (> (length &ss1) 0) (lsp201602282 &ss1) nil)
    
66. )
    
67. 
    
68. (defun lsp201602282 (&ss1 / &s1 &ss1 &ss2 &ss3 &ss5 x1 y1);提取文字内容最大值
    
69. (setq &ss2 '() &ss3 '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "."))
    
70. (while &ss1
    
71.   (setq &s1 (car &ss1) &ss5 '())
    
72.   (while &s1
    
73.    (setq &ss1 (cdr &ss1))
    
74.    (if (member &s1 &ss3) (progn (setq &ss5 (cons &s1 &ss5) &s1 (car &ss1)) ) (setq &s1 nil) )
    
75.   );while;2
    
76.   (if (> (length &ss5) 0)
    
77.    (progn
    
78.     (setq &ss5 (atof (apply 'strcat &ss5)) &ss2 (cons &ss5 &ss2))
    
79.    )
    
80.   );if
    
81. );while;1
    
82. (if (> (length &ss2) 0) (car (vl-sort &ss2 (function (lambda (x1 y1) (> x1 y1))))) nil)
    
83. )

(defun c:szfw(/ r_min r_max co ss n en ent s)<br /> <br /> (setq layer_bk (getvar "clayer"))<br /> (setvar "cmdecho" 0)<br /> (setq osmode_backup (getvar "osmode"))<br /> (setvar "OSMODE" 0)<br /> (if (null vlax-dump-object) (vl-load-com) )<br /> <br />   (if (setq r_min (getreal "\n请输入变色改层数字下限(不包含)<1.1>:")) nil (setq r_min 1.1))<br />   (if (setq r_max (getreal "\n请输入变色改层数字上限(不包含)<9.99>:")) nil (setq r_max 9.99))<br />    <br />   (setq co (acad_colordlg 1))<br /> <br /> ;-----------------------------------------------------------------------------<br /> (if (= (tblobjname "LAYER" "JGLS-1临时图层") nil)<br /> (progn<br /> (entmake (list<br />     '(0 . "LAYER")<br />     '(100 . "AcDbSymbolTableRecord")<br />     '(100 . "AcDbLayerTableRecord")<br />     '(6 . "CONTINUOUS")<br />     '(62 . 1)<br />     '(70 . 0)<br />     (cons 2 "JGLS-1临时图层")<br />    )<br /> )<br /> )<br /> )<br /> (setvar "clayer" "JGLS-1临时图层")<br /> (command "color" "bylayer")<br /> ;-----------------------------------------------------------------------------<br />   (setq ss (ssget  '((0 . "TEXT")(-4 . "<AND")(1 . "~*&#91;~!-~&#93;*")(1 . "~*@*")(1 . "*#*")(-4 . "AND>"))))<br />    (repeat (setq n (sslength ss))<br />     (setq en (ssname ss (setq n (1- n))))<br />     (setq ent (entget en) en (vlax-ename->vla-object en))<br />     (setq s (cdr (assoc 1 ent)))<br />     (setq s (lsp201602281 s))<br />     (if (and s (> s r_min) (< s r_max))<br />      (progn<br />       (vla-put-layer en "JGLS-1临时图层");改变图层<br />       (vla-put-color en co);改变颜色<br />      )<br />     )<br />       <br />    ) ;end repeat<br />    (setvar "clayer" layer_bk)<br />    (setvar "OSMODE" osmode_backup)<br />    <br />   (princ)<br />   )<br />   <br /> (defun lsp201602281 (&a1 / &a1 &a2 &n1 &ss1);拆开文字内容<br /> (setq &ss1 '())<br /> (while (/= &a1 "")<br />   (setq &a2 (substr &a1 1 1) &n1 (ascii &a2))<br />   (if (< &n1 128)<br />    (setq &a1 (substr &a1 2))<br />    (progn<br />     (setq &a2 (substr &a1 1 2) &a1 (substr &a1 3))<br />    )<br />   )<br />   (setq &ss1 (cons &a2 &ss1))<br /> );while<br /> (if (> (length &ss1) 0) (lsp201602282 &ss1) nil)<br /> )<br /> <br /> (defun lsp201602282 (&ss1 / &s1 &ss1 &ss2 &ss3 &ss5 x1 y1);提取文字内容最大值<br /> (setq &ss2 '() &ss3 '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "."))<br /> (while &ss1<br />   (setq &s1 (car &ss1) &ss5 '())<br />   (while &s1<br />    (setq &ss1 (cdr &ss1))<br />    (if (member &s1 &ss3) (progn (setq &ss5 (cons &s1 &ss5) &s1 (car &ss1)) ) (setq &s1 nil) )<br />   );while;2<br />   (if (> (length &ss5) 0)<br />    (progn<br />     (setq &ss5 (atof (apply 'strcat &ss5)) &ss2 (cons &ss5 &ss2))<br />    )<br />   );if<br /> );while;1<br /> (if (> (length &ss2) 0) (car (vl-sort &ss2 (function (lambda (x1 y1) (> x1 y1))))) nil)<br /> )

水沙漠

这应该是结构专业的梁配筋率改色，目前已有成熟的插件。

vitalgg

如果无法播放，请点击此处在新窗口打开

在 @lisp 数学工具中。