明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 3080|回复: 6

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

[复制链接]
发表于 2015-4-1 10:41:24 | 显示全部楼层 |阅读模式
运行SZFW,运行后达到图片的功能。下面的代码可以找出普通数值的大值,但如果最大值在中部或者在尾部,则不行。请大虾帮改一下。
  1. (defun c:szfw(/ r_min r_max co ss n en ent s)

  2. (setq layer_bk (getvar "clayer"))
  3. (setvar "cmdecho" 0)
  4. (setq osmode_backup (getvar "osmode"))
  5. (setvar "OSMODE" 0)
  6.   
  7.   (if (setq r_min (getreal "\n请输入变色改层数字下限(不包含)<1.1>:")) nil (setq r_min 1.1))
  8.   (if (setq r_max (getreal "\n请输入变色改层数字上限(不包含)<9.99>:")) nil (setq r_max 9.99))
  9.    
  10.   (setq co (acad_colordlg 1))

  11. ;-----------------------------------------------------------------------------
  12. (if (= (tblobjname "LAYER" "JGLS-1临时图层") nil)
  13. (progn
  14. (entmake (list
  15.     '(0 . "LAYER")
  16.     '(100 . "AcDbSymbolTableRecord")
  17.     '(100 . "AcDbLayerTableRecord")
  18.     '(6 . "CONTINUOUS")
  19.     '(62 . 1)
  20.     '(70 . 0)
  21.     (cons 2 "JGLS-1临时图层")
  22.    )
  23. )
  24. )
  25. )
  26. (setvar "clayer" "JGLS-1临时图层")
  27. (command "color" "bylayer")
  28. ;-----------------------------------------------------------------------------
  29.   (setq ss (ssget  '((0 . "TEXT")(-4 . "<AND")(1 . "~*&#91;~!-~&#93;*")(1 . "~*@*")(1 . "*#*")(-4 . "AND>"))))
  30.     (repeat (setq n (sslength ss))
  31.     (setq en (ssname ss (setq n (1- n))))
  32.     (setq ent (entget en))
  33.     (setq s (atof (cdr (assoc 1 ent))))
  34.       (if (and (> s r_min) (< s r_max))

  35.          (if (assoc 8 ent) (setq ent (subst (cons 8 "JGLS-1临时图层") (assoc 8 ent) ent))
  36.           (setq ent (cons (cons 8 "JGLS-1临时图层") ent))
  37.          ) ;end if 1
  38.         
  39.        )  ;end if   2

  40.      (if (and (> s r_min) (< s r_max))

  41.          (if (assoc 62 ent) (setq ent (subst (cons 62 co) (assoc 62 ent) ent))
  42.           (setq ent (cons (cons 62 co) ent))
  43.          ) ;end if 1
  44.         
  45.        )  ;end if   2

  46.       (entmod ent)
  47.       
  48.     ) ;end repeat
  49.    (setvar "clayer" layer_bk)
  50.    (setvar "OSMODE" osmode_backup)
  51.    
  52.   (princ)
  53.   )

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
发表于 2015-5-17 17:16:19 | 显示全部楼层
联系我QQ496968041
发表于 2015-6-3 11:44:09 | 显示全部楼层
这个好弄,
发表于 2015-9-8 21:13:54 | 显示全部楼层
强力围观一下,
发表于 2016-2-28 09:01:20 | 显示全部楼层
本帖最后由 437271963 于 2016-2-28 09:03 编辑
  1. (defun c:szfw(/ r_min r_max co ss n en ent s)

  2. (setq layer_bk (getvar "clayer"))
  3. (setvar "cmdecho" 0)
  4. (setq osmode_backup (getvar "osmode"))
  5. (setvar "OSMODE" 0)
  6. (if (null vlax-dump-object) (vl-load-com) )

  7.   (if (setq r_min (getreal "\n请输入变色改层数字下限(不包含)<1.1>:")) nil (setq r_min 1.1))
  8.   (if (setq r_max (getreal "\n请输入变色改层数字上限(不包含)<9.99>:")) nil (setq r_max 9.99))
  9.    
  10.   (setq co (acad_colordlg 1))

  11. ;-----------------------------------------------------------------------------
  12. (if (= (tblobjname "LAYER" "JGLS-1临时图层") nil)
  13. (progn
  14. (entmake (list
  15.     '(0 . "LAYER")
  16.     '(100 . "AcDbSymbolTableRecord")
  17.     '(100 . "AcDbLayerTableRecord")
  18.     '(6 . "CONTINUOUS")
  19.     '(62 . 1)
  20.     '(70 . 0)
  21.     (cons 2 "JGLS-1临时图层")
  22.    )
  23. )
  24. )
  25. )
  26. (setvar "clayer" "JGLS-1临时图层")
  27. (command "color" "bylayer")
  28. ;-----------------------------------------------------------------------------
  29.   (setq ss (ssget  '((0 . "TEXT")(-4 . "<AND")(1 . "~*&#91;~!-~&#93;*")(1 . "~*@*")(1 . "*#*")(-4 . "AND>"))))
  30.    (repeat (setq n (sslength ss))
  31.     (setq en (ssname ss (setq n (1- n))))
  32.     (setq ent (entget en) en (vlax-ename->vla-object en))
  33.     (setq s (cdr (assoc 1 ent)))
  34.     (setq s (lsp201602281 s))
  35.     (if (and s (> s r_min) (< s r_max))
  36.      (progn
  37.       (vla-put-layer en "JGLS-1临时图层");改变图层
  38.       (vla-put-color en co);改变颜色
  39.      )
  40.     )
  41.       
  42.    ) ;end repeat
  43.    (setvar "clayer" layer_bk)
  44.    (setvar "OSMODE" osmode_backup)
  45.    
  46.   (princ)
  47.   )
  48.   
  49. (defun lsp201602281 (&a1 / &a1 &a2 &n1 &ss1);拆开文字内容
  50. (setq &ss1 '())
  51. (while (/= &a1 "")
  52.   (setq &a2 (substr &a1 1 1) &n1 (ascii &a2))
  53.   (if (< &n1 128)
  54.    (setq &a1 (substr &a1 2))
  55.    (progn
  56.     (setq &a2 (substr &a1 1 2) &a1 (substr &a1 3))
  57.    )
  58.   )
  59.   (setq &ss1 (cons &a2 &ss1))
  60. );while
  61. (if (> (length &ss1) 0) (lsp201602282 &ss1) nil)
  62. )

  63. (defun lsp201602282 (&ss1 / &s1 &ss1 &ss2 &ss3 &ss5 x1 y1);提取文字内容最大值
  64. (setq &ss2 '() &ss3 '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "."))
  65. (while &ss1
  66.   (setq &s1 (car &ss1) &ss5 '())
  67.   (while &s1
  68.    (setq &ss1 (cdr &ss1))
  69.    (if (member &s1 &ss3) (progn (setq &ss5 (cons &s1 &ss5) &s1 (car &ss1)) ) (setq &s1 nil) )
  70.   );while;2
  71.   (if (> (length &ss5) 0)
  72.    (progn
  73.     (setq &ss5 (atof (apply 'strcat &ss5)) &ss2 (cons &ss5 &ss2))
  74.    )
  75.   );if
  76. );while;1
  77. (if (> (length &ss2) 0) (car (vl-sort &ss2 (function (lambda (x1 y1) (> x1 y1))))) nil)
  78. )
发表于 2022-2-17 10:56:29 | 显示全部楼层
这应该是结构专业的梁配筋率改色,目前已有成熟的插件。
发表于 2022-2-17 17:38:28 | 显示全部楼层


在 @lisp 数学工具中。
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-22 21:44 , Processed in 0.196088 second(s), 29 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表