中国CAD论坛

 找回密码
 注册会员

QQ登录

只需一步,快速开始

凯得学院(CAD8学院)AutoCAD软件下载AutoCAD视频教程等待验证会员请验证邮箱
注册会员指导可以赚钱的网盘CAD习题集AutoCAD技巧
查看: 14|回复: 0
收起左侧

AutoCAD下 cc检查公差标注H05x用Lisp源程序

[复制链接]
发表于 2018-11-8 09:13:42 | 显示全部楼层 |阅读模式 简体中文繁體中文
用QQ等截图工具截图后,点中发贴区直接按Ctrl+V键就可以将截图粘贴到发贴框.

欢迎加入,注册成为会员,享用更多功能,完全免费。

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

x
AutoCAD下 cc检查公差标注H05x用Lisp源程序
;检测公差标注,当其不为H0.5x时,将其移到错误图层.

  1. (defun c:cc()

  2. (setq savecmdecho (getvar "cmdecho"));获取命令反馈模式的当前值

  3. (setq saveosmode (getvar "osmode"));获取对象捕捉模式的当前值

  4. (setq savesnapmode (getvar "snapmode"));获取捕捉模式的当前值

  5. (setvar "cmdecho" 0);关闭命令反馈模式

  6. (setvar "osmode" 0);关闭对象捕捉模式

  7. (setvar "snapmode" 0);关闭捕捉模式模式

  8. (setq ss (ssget));取得选择集,并且是全部自动选中所有标注对象。

  9. (setq h 0 n 0);设置错误个数h初始值为0,选择集的起始值n=0。

  10. (if (tblobjname "LAYER" "错误检查")

  11. (Princ)

  12. (command "-layer" "n" "错误检查" "s" "错误检查" "c" "42" "" "")

  13. )

  14. (repeat (sslength ss);计算选择集的对象个数。

  15. (setq en (ssname ss n));依据索引值取出选择集中的图元名。

  16. (setq elst (entget en));获得对象(图元)的定义数据.

  17. (setq n (1+ n))

  18. (if (/= (car (member '(0 . "DIMENSION") elst)) nil)

  19. (progn

  20. (setq elst (entget en '("ACAD")));获得对象(图元)的定义数据,并检查其是否为样式替代

  21. (setq s2 (cdr (assoc 1 elst)));其中1为组码,表示标注文字的内容,查找出标注文字的内容。

  22. (setq m (strlen s2));检测出标注文字的内容的字符串长度

  23. (cond;条件语句

  24. (

  25. (= m 0);如果m值为0,则说明是使用CAD默认值标注的。

  26. (princ (strcat "\n第<" (itoa n) ">个为自动标注文字;"))

  27. )

  28. (

  29. (= (s_search s2) "H0.5x");调用了自定义函数来检测字符串s2中是否含有"<>",相当于搜索功能

  30. (princ (strcat "\n第<" (itoa n) ">个为H0.5x公差标注;"))

  31. )

  32. (

  33. (/= (s_search2 s2) "\\");调用了自定义函数来检测字符串s2中是否含有"<>",相当于搜索功能

  34. (princ (strcat "\n第<" (itoa n) ">个为普通标注;"))

  35. )

  36. (

  37. T (princ (strcat "\n序号为<" (itoa n) ">的不是H0.5x公差标注,已经更改到<错误检查>图层;"));其它情况为手动标注文字,需要变更图层提醒用户来检查

  38. (setq h (1+ h))

  39. (setq old_8_color (assoc '8 elst));找出其所在图层的列表,其中8是图层组码

  40. (setq new_8_color (cons '8 "错误检查"));建立新的图层列表,此处图层名称可以更改,如0改为“有问题”图层

  41. (setq elst (subst new_8_color old_8_color elst));把有问题的标注放到新的图层

  42. (entmod elst);将修改好的图元特性更新到电脑屏幕上去

  43. )

  44. );cond终结符.

  45. );第一个progn终结)符号

  46. (princ (strcat "\n第<" (itoa n) ">个不是标注对象" ));说明选的第几个标注有问题

  47. );if终结)符号

  48. );repeat结结符

  49. (princ (strcat "\n共有<" (itoa h) ">个H0.5x公差标注有问题." ))

  50. (princ "\n请更改<错误检查>新加图层的颜色,来检查标注文字错误.")

  51. (princ "\n程序作者:王军锋")

  52. (setvar "osmode" saveosmode);恢复对象捕捉模式原来值

  53. (setvar "snapmode" savesnapmode);恢复捕捉模式原来值

  54. (setvar "cmdecho" savecmdecho);恢复命令反馈模式原来值

  55. (princ)

  56. )

  57. (defun s_search (s);自定义函数,其中s为参变量,接收字符串变量

  58. (setq d 1 s3 "");设置索引号值为1,设置s3为空字符。

  59. (while (/= (substr s d 5) "");当字符串s不为空时,执行下面语句

  60. (if (= (substr s d 5) "H0.5x");判断字符串中是否含有"<>"

  61. (setq s3 (substr s d 5));如果检查出s字符串中有"<>",则将其赋值给s3以供函数返回值用。

  62. (null 0);执行后为nil

  63. )

  64. (setq d (1+ d));索引号值加1

  65. )

  66. (setq s3 s3);返回s_search自定义函数的返回值。

  67. )

  68. (defun s_search2 (s);自定义函数,其中s为参变量,接收字符串变量

  69. (setq d 1 s3 "");设置索引号值为1,设置s3为空字符。

  70. (while (/= (substr s d 1) "");当字符串s不为空时,执行下面语句

  71. (if (= (substr s d 1) "\\");判断字符串中是否含有"<>"

  72. (setq s3 (substr s d 1));如果检查出s字符串中有"<>",则将其赋值给s3以供函数返回值用。

  73. (null 0);执行后为nil

  74. )

  75. (setq d (1+ d));索引号值加1

  76. )

  77. (setq s3 s3);返回s_search自定义函数的返回值。

  78. )





上一篇:AutoCAD下,实测巷道控制点展点用的Lisp源程序

帖子地址: 

本帖被以下淘专辑推荐:

您需要登录后才可以回帖 登录 | 注册会员

本版积分规则

本站所有资料仅供大家学习之用,商用请务必购买正版版权!有侵权之处,请联系管理员(QQ:119891935)删除!
快速回复 返回顶部 返回列表