[讨论]：终于搞定了：有n(n为偶数)个点pt1,pt2,pt3,pt4,pt5,pt6......ptn,程序要使这n

yybu · 发表于 2006-11-6 22:55:04

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

由点的坐标组成表"plst" 中,使与第一个点距离最小的另一个点组成一个只有两个点的表.

(defun c:t1 ()
(setq plst '((2000.0 0.0 0.0) (800.0 0.0 0.0) (500.0 0.0 0.0) (0.0 0.0 0.0)))
(ttt plst))
(defun c:t2 ()
(setq plst '((500.0 0.0 0.0) (0.0 0.0 0.0) (2000.0 0.0 0.0) (800.0 0.0 0.0)))
(ttt plst))
(defun ttt (plst / i n p1 p2 p3 d12 d13 plst1)
(setq i 0
n (length plst)
)
(while (< i (- n 2))
(setq p1 (nth 0 plst)
p2 (nth 1 plst)
p3 (nth 2 plst)
d12 (distance p1 p2)
d13 (distance p1 p3)
)
(if (> d12 d13)
(progn
((setq plst (cons p1 (cddr plst)))
(setq plst1 (cons p2 plst1))
)
)
(progn (setq plst (cons p1 (cons p2 (cdddr plst))))
(setq plst1 (cons p3 plst1))
)
)
(setq i (1+ i))
)
(princ plst)
(prin1)
)

上面程序中"t1"运行正常,但"t2"不正常!
请高手点解,
WHY??

kohi · 发表于 2006-11-7 04:53:23

[php]
(defun c:test ()
 (setq plst '((2000.0 0.0 0.0) (800.0 0.0 0.0) (500.0 0.0 0.0) (0.0 0.0 0.0)))
 ;(setq plst '((500.0 0.0 0.0) (0.0 0.0 0.0) (2000.0 0.0 0.0) (800.0 0.0 0.0)))
 (mindis (car plst)(cdr plst))
)
(defun mindis (p0 pts)
 (setq i 0 dis 10e10)
 (while (< i (length pts))
(if (< (distance p0 (nth i pts)) dis)
 (setq n i dis (distance p0 (nth i pts)))
)
(setq i (1+ i))
 )
 (list p0 (nth n pts))
)
[/php]

yybu · 发表于 2006-11-7 14:49:45

"kohi "
你能不能把你的程序改下
使"plst"中的点以两点距离最小两两组成点对
输出结果格式如下:
((2000.0 0.0 0.0) (800.0 0.0 0.0) )((500.0 0.0 0.0) (0.0 0.0 0.0)))

bdgxhmldzj · 发表于 2006-11-7 20:58:57

楼主的程序中，第一个progn后多了一对()，去掉那对括号就正常了。

kohi · 发表于 2006-11-8 02:38:19

2楼的程序是满足你开始说的“距离最小的另一个点组成一个只有两个点的表.“的要求。
不明白你在3楼说的“以两点距离最小两两组成点对“的准确含义是什么，按我的理解， “两两组成点对“--- 结果应该是这样：
((2000.0 0.0 0.0) (800.0 0.0 0.0) )((800.0 0.0 0.0) (500.0 0.0 0.0))((500.0 0.0 0.0) (0.0 0.0 0.0))。。。

sujia · 发表于 2006-11-8 12:42:12

建议采用排序函数
(list (car ptlst) (car ((vl-sort '(lambda(e1 e2) (< (distance (car ptlst) e1) (distance (car ptlst) e2) ) (cdr ptlst))

yybu · 发表于 2006-11-9 09:27:49

一楼的要求简单了点，现在对程序提出新要求:
有n(n为偶数)个点pt1,pt2,pt3,pt4,pt5,pt6......ptn,程序要使这n个点中每两个点距离最近点组成一个表。
例如有：六个点组成表list1(pt1,pt2,pt3,pt4,pt5,pt6), pt1与pt2的距离为d12=5,d13=6,d14=7,d15=8,d16=9,d23=1,d24=2,d25=3,d26=4,d34=10,
d35=11,d36=12,d45=13,d46=14,d56=15,其中d23上述所有距离中最
小，则pt2,pt3组成一个表(pt2 pt3),将p2,p3从表list1中去除，剩下的点
(pt1,pt4,pt5,pt6)再按距离最近原则进行两两成表。最终输出结果
((pt2 pt3)(pt1 pt4)(pt5 pt6))
不知我说清楚没有！

eachy · 发表于 2006-11-9 10:54:26

参考
http://www.xdcad.net/forum/showthread.php?s=&threadid=452598

yybu · 发表于 2006-11-9 16:59:36

谢谢eachy版主的指点,
请帮我看一下下面程序:

(defun c:t1()
(setq ptlst '((2000.0 0.0 0.0) (800.0 0.0 0.0) (500.0 0.0 0.0) (8100.0 0.0 0.0)(0.0 0.0 0.0)(8000.0 0.0 0.0)))
(mlenpts ptlst))
(defun mlenpts (ptlst / pt d maxd mind maxl minl p1p2lst)
(setq minl (list (car ptlst) (cadr ptlst))
maxd 0
mind (apply 'distance minl)
)
(while (> (length ptlst) 2)
(setq ptlst1 ptlst)
(while (setq pt (car ptlst1)
ptlst1 (cdr ptlst1)
)
(foreach n ptlst1
(setq d (distance n pt))
(cond ((< maxd d)
(setq maxd d
maxl (list n pt)
)
)
((> mind d)
(setq mind d
minl (list n pt)
)
)
)
)
)
(list maxl minl)
(setq p1p2lst (cons minl p1p2lst))
(setq ptlst (vl-remove (car minl) ptlst))
(setq ptlst (vl-remove (cadr minl) ptlst))
)
(setq p1p2lst (cons ptlst p1p2lst))
(princ p1p2lst)
)

(defun c:t1() 
(setq ptlst '((2000.0 0.0 0.0) (800.0 0.0 0.0) (500.0 0.0 0.0) (8100.0 0.0 0.0)(0.0 0.0 0.0)(8000.0 0.0 0.0))) 
(mlenpts ptlst)) 
(defun mlenpts (ptlst / pt d maxd mind maxl minl p1p2lst) 
  (setq        minl   (list (car ptlst) (cadr ptlst)) 
        maxd   0 
        mind   (apply 'distance minl) 
) 
  (while (> (length ptlst) 2) 
    (setq ptlst1 ptlst) 
    (while (setq pt        (car ptlst1) 
                 ptlst1        (cdr ptlst1) 
           ) 
      (foreach n ptlst1 
        (setq d (distance n pt)) 
        (cond ((< maxd d) 
               (setq maxd d 
                     maxl (list n pt) 
               ) 
              ) 
              ((> mind d) 
               (setq mind d 
                     minl (list n pt) 
               ) 
              ) 
        ) 
      ) 
    ) 
    (list maxl minl) 
    (setq p1p2lst (cons minl p1p2lst)) 
    (setq ptlst (vl-remove (car minl) ptlst)) 
    (setq ptlst (vl-remove (cadr minl) ptlst)) 
  ) 
  (setq p1p2lst (cons ptlst p1p2lst)) 
  (princ p1p2lst) 
)

bdgxhmldzj · 发表于 2006-11-9 20:35:45

不知所云，但我知道第二个while后缺少判断式。

yybu · 发表于 2006-11-9 22:47:14

终于搞定了，谢谢大家的帮助！
现将最终成果共享之：

(defun c:t1()
(setq ptlst '((2000.0 0.0 0.0) (800.0 0.0 0.0) (500.0 0.0 0.0) (8100.0 0.0 0.0)(0.0 0.0 0.0)(8000.0 0.0 0.0)))
(mlenpts ptlst))
(defun mlenpts (ptlst / pt d maxd mind maxl minl p1p2lst)
(while (> (length ptlst) 2)
(setq minl (list (car ptlst) (cadr ptlst))
mind (apply 'distance minl)
ptlst1 ptlst
)
(while (setq pt (car ptlst1)
ptlst1 (cdr ptlst1)
)
(foreach n ptlst1
(setq d (distance n pt))
(cond ((> mind d)
(setq mind d
minl (list n pt)
)
)
)
)
)
(setq p1p2lst (cons minl p1p2lst))
(setq ptlst (vl-remove (car minl) ptlst))
(setq ptlst (vl-remove (cadr minl) ptlst))
)
(setq p1p2lst (cons ptlst p1p2lst))
)

(defun c:t1() 
(setq ptlst '((2000.0 0.0 0.0) (800.0 0.0 0.0) (500.0 0.0 0.0) (8100.0 0.0 0.0)(0.0 0.0 0.0)(8000.0 0.0 0.0))) 
(mlenpts ptlst)) 
(defun mlenpts (ptlst / pt d maxd mind maxl minl p1p2lst) 
  (while (> (length ptlst) 2) 
    (setq minl         (list (car ptlst) (cadr ptlst)) 
          mind         (apply 'distance minl) 
          ptlst1 ptlst 
    ) 
    (while (setq pt        (car ptlst1) 
                 ptlst1        (cdr ptlst1) 
           ) 
      (foreach n ptlst1 
        (setq d (distance n pt)) 
        (cond ((> mind d) 
               (setq mind d 
                     minl (list n pt) 
               ) 
              ) 
        ) 
      ) 
    ) 
    (setq p1p2lst (cons minl p1p2lst)) 
    (setq ptlst (vl-remove (car minl) ptlst)) 
    (setq ptlst (vl-remove (cadr minl) ptlst)) 
  ) 
  (setq p1p2lst (cons ptlst p1p2lst)) 
)

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

[讨论]：终于搞定了：有n(n为偶数)个点pt1,pt2,pt3,pt4,pt5,pt6......ptn,程序要使这n

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子