明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1388|回复: 4

[源码] 新人第一贴,求完善(测量多点距离和)

[复制链接]
发表于 2013-9-26 12:54:47 | 显示全部楼层 |阅读模式
本帖最后由 丽丽星空 于 2013-9-26 13:08 编辑

刚开始学习LISP的时候就简单的编写了一个程序,花了三天时间。程序虽简单但对新手来说可是困难啊!代码如下:
;测量多点程序,当x1=x2时,停止测量,返回距离和
(defun c:dm ()
(setq m 0)
(setq x1 (getpoint))
(setq x2 (getpoint))
(setq y1 (distance x1 x2))
(setq m (+ m y1))
(while(or (/=(setq p11 (car x1)) (setq p21 (car x2))) (/=(setq p12 (cadr x1)) (setq p22 (cadr x2))) (/=(setq p13 (caddr x1)) (setq p23 (caddr x2))))
(setq x1 x2)
(setq x2 (getpoint))
(setq y1 (distance x1 x2))
(setq m (+ m y1))
)
(prompt "\n距离之和:")
(prin1 m)
)

程序有不完善的地方,如 当x1=x2时,停止测量,返回距离和。本想按空格键或ENTER键退出程序,研究了很久也没出来。请知者指教。
发表于 2013-9-26 13:02:43 | 显示全部楼层
(defun c:dm1 (/ M X1 X2)
  (setq m 0)
  (while (and (setq x1 (getpoint "\n 起点"))
              (setq x2 (getpoint x1 "\n 终点"))
         )
    (setq m (+ m (distance x1 x2)))
  )
  (princ (strcat "\n距离之和:" (VL-PRINC-TO-STRING m)))
  (princ)
)
 楼主| 发表于 2013-9-26 22:46:39 | 显示全部楼层
自贡黄明儒 发表于 2013-9-26 13:02
(defun c:dm1 (/ M X1 X2)
  (setq m 0)
  (while (and (setq x1 (getpoint "\n 起点"))

多谢大侠指点,你编的程序真是精致啊
发表于 2013-9-26 23:37:31 | 显示全部楼层
(defun c:dm2 (/ M X1 ptlst)
  (while (setq x1 (getpoint "\n 点"))
    (setq ptlst (cons x1 ptlst))
  )
  (setq        m
         (apply        '+
                (mapcar        '(lambda (x y)
                           (distance x y)
                         )
                        ptlst
                        (cdr ptlst)
                )
         )
  )
  (princ (strcat "\n距离之和:" (VL-PRINC-TO-STRING m)))
  (princ)
)
 楼主| 发表于 2013-9-27 22:58:18 | 显示全部楼层
snddd2000 发表于 2013-9-26 23:37
(defun c:dm2 (/ M X1 ptlst)
  (while (setq x1 (getpoint "\n 点"))
    (setq ptlst (cons x1 ptlst)) ...

  精炼!正是所需功能。为避免Z值影响,可再优化
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2025-5-26 07:33 , Processed in 0.179025 second(s), 25 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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