duotu007 发表于 2010-4-24 13:46:00

求助：LISP高手，希望能得到你的帮助？

假如CAD图纸里有1000条长度不等的直线（其中也有长度相等的），想把它统计出来，我需要的统计结果是，各种长度的线分别有多少根。

masterlong 发表于 2010-4-24 15:30:00

<p>(defun c:tjl()&nbsp;&nbsp;&nbsp; ;分类统计线长度<br/>&nbsp;(setq lss (ssget '((0 . "line"))))<br/>&nbsp;(setq i 0)<br/>&nbsp;(setq biao '())<br/>&nbsp;(repeat (sslength lss)<br/>&nbsp;&nbsp;(setq a (ssname lss i))<br/>&nbsp;&nbsp;(setq a10 (cdr (assoc 10 (entget a))))<br/>&nbsp;&nbsp;(setq a11 (cdr (assoc 11 (entget a))))<br/>&nbsp;&nbsp;(setq dist (distance a10 a11))<br/>&nbsp;&nbsp;(if (assoc dist biao)<br/>&nbsp;&nbsp;&nbsp;(progn<br/>&nbsp;&nbsp;&nbsp;&nbsp;(setq bbb (assoc dist biao))<br/>&nbsp;&nbsp;&nbsp;&nbsp;(setq bbbb (list dist (1+ (cadr bbb))))<br/>&nbsp;&nbsp;&nbsp;&nbsp;(setq biao (subst bbbb (assoc dist biao) biao))<br/>&nbsp;&nbsp;&nbsp;)<br/>&nbsp;&nbsp;&nbsp;(setq biao (append biao (list (list dist 1))))<br/>&nbsp;&nbsp;)<br/>&nbsp;&nbsp;(setq i (1+ i))<br/>&nbsp;)<br/>&nbsp;(foreach x biao<br/>&nbsp;&nbsp;(princ "\n")(princ x)<br/>&nbsp;)<br/>(princ)<br/>)</p>

duotu007 发表于 2010-4-24 17:41:00

谢谢楼上帅哥，能不能把结果输出到EXCEL呢？

masterlong 发表于 2010-4-24 18:18:00

<p>输出到文件里</p><p>自己copy吧</p><p></p><p>(defun c:tjl()&nbsp;&nbsp;&nbsp; ;分类统计线长度<br/>&nbsp;(setq lss (ssget '((0 . "line"))))<br/>&nbsp;(setq i 0)<br/>&nbsp;(setq biao '())<br/>&nbsp;(repeat (sslength lss)<br/>&nbsp; (setq a (ssname lss i))<br/>&nbsp; (setq a10 (cdr (assoc 10 (entget a))))<br/>&nbsp; (setq a11 (cdr (assoc 11 (entget a))))<br/>&nbsp; (setq dist (distance a10 a11))<br/>&nbsp; (if (assoc dist biao)<br/>&nbsp;&nbsp; (progn<br/>&nbsp;&nbsp;&nbsp; (setq bbb (assoc dist biao))<br/>&nbsp;&nbsp;&nbsp; (setq bbbb (list dist (1+ (cadr bbb))))<br/>&nbsp;&nbsp;&nbsp; (setq biao (subst bbbb (assoc dist biao) biao))<br/>&nbsp;&nbsp; )<br/>&nbsp;&nbsp; (setq biao (append biao (list (list dist 1))))<br/>&nbsp; )<br/>&nbsp; (setq i (1+ i))<br/>&nbsp;)<br/>&nbsp;(setq file (open "c:\\temp.txt" "w"))<br/>&nbsp;(foreach x biao<br/>&nbsp; (princ (car x) file)(princ "\t" file)(princ (cadr x) file)(princ "\n" file)<br/>&nbsp;)<br/>&nbsp;(close file)<br/>(princ)<br/>)</p>

duotu007 发表于 2010-4-24 18:49:00

<p>太感谢你了，</p>

duotu007 发表于 2010-4-24 20:43:00

<p>有一个小问题，数量太多的时候，会导致同样长的线，出现几次。</p><p>1375.0&nbsp;108<br/>650.0&nbsp;2462<br/>1400.0&nbsp;3768<br/>445.0&nbsp;1512<br/>1475.0&nbsp;56<br/>400.0&nbsp;56<br/>445.0&nbsp;28<br/>1400.0&nbsp;138<br/>646.71&nbsp;2<br/>445.0&nbsp;28<br/>1400.0&nbsp;18<br/></p>

lsjj 发表于 2010-4-24 21:29:00

<p>試試,改一下</p><p>&nbsp;(setq dist&nbsp;(rtos (distance a10 a11) 2 1))</p><p>或</p><p>&nbsp;(setq dist&nbsp;(atof (rtos (distance a10 a11) 2 1)))</p>

duotu007 发表于 2010-4-25 09:18:00

<p>改成(setq dist&nbsp;(rtos (distance a10 a11) 2 1))就可以了，谢谢！</p>
页: [1]
查看完整版本: 求助：LISP高手，希望能得到你的帮助？