筛选直线长度尾数非0的插件。。

再见熊猫衣服

有没有可以筛选长度尾数非0的插件。。
就是有强迫症那种类型的，
有时候不知不觉的、不知道哪个地方的直线，画出问题了，
导致长度不是整数（比如用DI测量实际长度为9.5428124）、
或者长度的末尾数不是0（比如墙体厚度一般都是240的，但是不知道哪个地方的线段有问题，这个墙体的厚度就变成241、289...）。
——
不知道咱们论坛有没有这样的插件啊，可以达到的效果：
命令，框选需要检索的图元，确定，程序则自动从所选图元内，自动选中，直线长度非整数和末尾数非0的直线。
然后自动将它们变为红色。

marting

现写一个也没多少时间

1. (defun c:tt ()
   
2.   (if (and (princ "\n选择搜索的直线<退出>:")
   
3.            (setq ss (ssget '((0 . "LINE"))))
   
4.       )
   
5.     (progn (setq i -1
   
6.                  num 0
   
7.            )
   
8.            (while (setq e (ssname ss (setq i (1+ i))))
   
9.              (setq o    (vlax-ename->vla-object e)
   
10.                    spt  (vlax-curve-getstartpoint e)
    
11.                    ept  (vlax-curve-getendpoint e)
    
12.                    dist (distance spt ept)
    
13.              )
    
14.              (if (or (/= (fix dist) dist)
    
15.                      (/= (rem dist 10) 0))
    
16.                (progn (setq num (1+ num)) (vla-put-color o 1))
    
17.              )
    
18.            )
    
19.            (if (> num 0)
    
20.              (princ (strcat "\n搜索到"
    
21.                             (itoa num)
    
22.                             "条长度非整数的直线，已经变红色."
    
23.                     )
    
24.              )
    
25.              (princ "\n没有发现长度非整数的直线.")
    
26.            )
    
27.     )
    
28.   )
    
29.   (princ)
    
30. )
    
31. 
    

(defun c:tt ()<br />   (if (and (princ "\n选择搜索的直线<退出>:")<br />            (setq ss (ssget '((0 . "LINE"))))<br />       )<br />     (progn (setq i -1<br />                  num 0<br />            )<br />            (while (setq e (ssname ss (setq i (1+ i))))<br />              (setq o    (vlax-ename->vla-object e)<br />                    spt  (vlax-curve-getstartpoint e)<br />                    ept  (vlax-curve-getendpoint e)<br />                    dist (distance spt ept)<br />              )<br />              (if (or (/= (fix dist) dist)<br />                      (/= (rem dist 10) 0))<br />                (progn (setq num (1+ num)) (vla-put-color o 1))<br />              )<br />            )<br />            (if (> num 0)<br />              (princ (strcat "\n搜索到"<br />                             (itoa num)<br />                             "条长度非整数的直线，已经变红色."<br />                     )<br />              )<br />              (princ "\n没有发现长度非整数的直线.")<br />            )<br />     )<br />   )<br />   (princ)<br /> )<br /> <br />

再见熊猫衣服

marting 发表于 2018-9-7 15:46
现写一个也没多少时间

谢谢，马上测试

再见熊猫衣服

marting 发表于 2018-9-7 15:46
现写一个也没多少时间

是不是必须要晓东工具箱？我加载的时候，报错，
错误 ,load

newer

再见熊猫衣服 发表于 2018-9-7 16:00
是不是必须要晓东工具箱？我加载的时候，报错，
错误 ,load

纯LISP代码，没用XDRX API
你是不是代码拷贝有问题，用鼠标从头选到尾按CTRL+C

把你代码放编辑器，看看代码里面有问号没

再见熊猫衣服

newer 发表于 2018-9-7 16:06
纯LISP代码，没用XDRX API
你是不是代码拷贝有问题，用鼠标从头选到尾按CTRL+C

还是报错。

再见熊猫衣服

marting 发表于 2018-9-7 15:46
现写一个也没多少时间

老师，报错啊。。

newer

再见熊猫衣服 发表于 2018-9-7 16:16
老师，报错啊。。

直接CTRL+C 粘贴到命令行

再见熊猫衣服

newer 发表于 2018-9-7 16:18
直接CTRL+C 粘贴到命令行

全选，粘贴到命令行，
提示，语法错误。

再见熊猫衣服

newer 发表于 2018-9-7 16:18
直接CTRL+C 粘贴到命令行

有人吗。。
版主，确实不行啊，全部方法都试过了。你能不能直接上传lsp上来呢？
为什么我弄不了呢，好奇怪哦

newer

再见熊猫衣服 发表于 2018-9-7 16:36
有人吗。。
版主，确实不行啊，全部方法都试过了。你能不能直接上传lsp上来呢？
为什么我弄不了呢，好 ...

是你的浩辰兼容性问题吧，

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:长度非整数直线.lsp 
下载次数:2  文件大小:908 Bytes 
下载权限: 不限 以上  [免费赚D豆]

再见熊猫衣服

newer 发表于 2018-9-7 16:43
是你的浩辰兼容性问题吧，

你咋知道我用的浩辰？
你好腻害了，用你的这个，就正常了。。
代码都一样的，你只加了  (if (and ，这个做开头，就解决问题了。
膜拜大神。。。
万分感谢啊。不知道怎么答谢你们了。@marting
超级厉害

newer

再见熊猫衣服 发表于 2018-9-7 16:48
你咋知道我用的浩辰？
你好腻害了，用你的这个，就正常了。。
代码都一样的，你只加了  (if (and ，这 ...

不是我神，不是你一直说你用浩辰吗

longer88

浩辰有什么特别的

sicky111

效果很高啊。