技术无价，但请帮忙：范围选数改色升级，字符串中数值取大值
运行SZFW,运行后达到图片的功能。下面的代码可以找出普通数值的大值，但如果最大值在中部或者在尾部，则不行。请大虾帮改一下。(defun c:szfw(/ r_min r_max co ss n en ent s)
(setq layer_bk (getvar "clayer"))
(setvar "cmdecho" 0)
(setq osmode_backup (getvar "osmode"))
(setvar "OSMODE" 0)
(if (setq r_min (getreal "\n请输入变色改层数字下限(不包含)<1.1>:")) nil (setq r_min 1.1))
(if (setq r_max (getreal "\n请输入变色改层数字上限(不包含)<9.99>:")) nil (setq r_max 9.99))
(setq co (acad_colordlg 1))
;-----------------------------------------------------------------------------
(if (= (tblobjname "LAYER" "JGLS-1临时图层") nil)
(progn
(entmake (list
'(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
'(6 . "CONTINUOUS")
'(62 . 1)
'(70 . 0)
(cons 2 "JGLS-1临时图层")
)
)
)
)
(setvar "clayer" "JGLS-1临时图层")
(command "color" "bylayer")
;-----------------------------------------------------------------------------
(setq ss (ssget'((0 . "TEXT")(-4 . "<AND")(1 . "~*[~!-~]*")(1 . "~*@*")(1 . "*#*")(-4 . "AND>"))))
(repeat (setq n (sslength ss))
(setq en (ssname ss (setq n (1- n))))
(setq ent (entget en))
(setq s (atof (cdr (assoc 1 ent))))
(if (and (> s r_min) (< s r_max))
(if (assoc 8 ent) (setq ent (subst (cons 8 "JGLS-1临时图层") (assoc 8 ent) ent))
(setq ent (cons (cons 8 "JGLS-1临时图层") ent))
) ;end if 1
);end if 2
(if (and (> s r_min) (< s r_max))
(if (assoc 62 ent) (setq ent (subst (cons 62 co) (assoc 62 ent) ent))
(setq ent (cons (cons 62 co) ent))
) ;end if 1
);end if 2
(entmod ent)
) ;end repeat
(setvar "clayer" layer_bk)
(setvar "OSMODE" osmode_backup)
(princ)
)
联系我QQ496968041 这个好弄， 强力围观一下， 本帖最后由 437271963 于 2016-2-28 09:03 编辑
(defun c:szfw(/ r_min r_max co ss n en ent s)
(setq layer_bk (getvar "clayer"))
(setvar "cmdecho" 0)
(setq osmode_backup (getvar "osmode"))
(setvar "OSMODE" 0)
(if (null vlax-dump-object) (vl-load-com) )
(if (setq r_min (getreal "\n请输入变色改层数字下限(不包含)<1.1>:")) nil (setq r_min 1.1))
(if (setq r_max (getreal "\n请输入变色改层数字上限(不包含)<9.99>:")) nil (setq r_max 9.99))
(setq co (acad_colordlg 1))
;-----------------------------------------------------------------------------
(if (= (tblobjname "LAYER" "JGLS-1临时图层") nil)
(progn
(entmake (list
'(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
'(6 . "CONTINUOUS")
'(62 . 1)
'(70 . 0)
(cons 2 "JGLS-1临时图层")
)
)
)
)
(setvar "clayer" "JGLS-1临时图层")
(command "color" "bylayer")
;-----------------------------------------------------------------------------
(setq ss (ssget'((0 . "TEXT")(-4 . "<AND")(1 . "~*[~!-~]*")(1 . "~*@*")(1 . "*#*")(-4 . "AND>"))))
(repeat (setq n (sslength ss))
(setq en (ssname ss (setq n (1- n))))
(setq ent (entget en) en (vlax-ename->vla-object en))
(setq s (cdr (assoc 1 ent)))
(setq s (lsp201602281 s))
(if (and s (> s r_min) (< s r_max))
(progn
(vla-put-layer en "JGLS-1临时图层");改变图层
(vla-put-color en co);改变颜色
)
)
) ;end repeat
(setvar "clayer" layer_bk)
(setvar "OSMODE" osmode_backup)
(princ)
)
(defun lsp201602281 (&a1 / &a1 &a2 &n1 &ss1);拆开文字内容
(setq &ss1 '())
(while (/= &a1 "")
(setq &a2 (substr &a1 1 1) &n1 (ascii &a2))
(if (< &n1 128)
(setq &a1 (substr &a1 2))
(progn
(setq &a2 (substr &a1 1 2) &a1 (substr &a1 3))
)
)
(setq &ss1 (cons &a2 &ss1))
);while
(if (> (length &ss1) 0) (lsp201602282 &ss1) nil)
)
(defun lsp201602282 (&ss1 / &s1 &ss1 &ss2 &ss3 &ss5 x1 y1);提取文字内容最大值
(setq &ss2 '() &ss3 '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "."))
(while &ss1
(setq &s1 (car &ss1) &ss5 '())
(while &s1
(setq &ss1 (cdr &ss1))
(if (member &s1 &ss3) (progn (setq &ss5 (cons &s1 &ss5) &s1 (car &ss1)) ) (setq &s1 nil) )
);while;2
(if (> (length &ss5) 0)
(progn
(setq &ss5 (atof (apply 'strcat &ss5)) &ss2 (cons &ss5 &ss2))
)
);if
);while;1
(if (> (length &ss2) 0) (car (vl-sort &ss2 (function (lambda (x1 y1) (> x1 y1))))) nil)
) 这应该是结构专业的梁配筋率改色，目前已有成熟的插件。 http://atlisp.cn/static/videos/@math-select-number.mp4
在 @lisp 数学工具中。
页:
[1]