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

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

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

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

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

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

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

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

输出到文件里

自己copy吧

(defun c:tjl()    ;分类统计线长度
(setq lss (ssget '((0 . "line"))))
(setq i 0)
(setq biao '())
(repeat (sslength lss)
(setq a (ssname lss i))
(setq a10 (cdr (assoc 10 (entget a))))
(setq a11 (cdr (assoc 11 (entget a))))
(setq dist (distance a10 a11))
(if (assoc dist biao)
   (progn
    (setq bbb (assoc dist biao))
    (setq bbbb (list dist (1+ (cadr bbb))))
    (setq biao (subst bbbb (assoc dist biao) biao))
   )
   (setq biao (append biao (list (list dist 1))))
)
(setq i (1+ i))
)
(setq file (open "c:\\temp.txt" "w"))
(foreach x biao
(princ (car x) file)(princ "\t" file)(princ (cadr x) file)(princ "\n" file)
)
(close file)
(princ)
)

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

太感谢你了，

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

有一个小问题，数量太多的时候，会导致同样长的线，出现几次。

1375.0 108
650.0 2462
1400.0 3768
445.0 1512
1475.0 56
400.0 56
445.0 28
1400.0 138
646.71 2
445.0 28
1400.0 18

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

試試,改一下

(setq dist (rtos (distance a10 a11) 2 1))

或

(setq dist (atof (rtos (distance a10 a11) 2 1)))

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

改成(setq dist (rtos (distance a10 a11) 2 1))就可以了，谢谢！

账号		自动登录	找回密码
密码			注册

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