两个关联表根据指定函数排序

newbuser

请求mapcar，foreach级别高手帮忙啊

1. ;; lst1的点分别位于lst2表组成的多边形内,顺序不对
   
2. ;; 现将lst2内的表按照函数 *判断点是否在多边形内* 对lst2重新进行排列，请问如何嵌套foreach达到目的
   
3. (setq lst1 '((1266.34 -793.366 0.0) (1109.44 -350.086 0.0) (1670.87 -371.66 0.0) (1543.04 -773.619 0.0))) ;;点表
   
4. (setq lst2 '(((1522.25 -655.235 0) (1522.25 -952.235 0) (1942.25 -952.235 0) (1942.25 -655.235 0)) ((930.677 -655.235 0) (930.677 -952.235 0) (1350.68 -952.235 0) (1350.68 -655.235 0)) ((1522.25 -174.764 0) (1522.25 -471.764 0) (1942.25 -471.764 0) (1942.25 -174.764 0)) ((930.677 -174.764 0) (930.677 -471.764 0) (1350.68 -471.764 0) (1350.68 -174.764 0))))  ;;封闭图形坐标表
   
5. 
   
6. ;; No.51  判断点是否在多边形内(狂刀程序)
   
7. 
   
8. (defun isPtinPM  (xPt Points)
   
9.   (equal
   
10.     PI
    
11.     (abs
    
12.       (apply
    
13.   '+
    
14.   (mapcar  '(lambda (x y) (rem (- (angle xPt x) (angle xPt y)) PI))
    
15.     (reverse (cdr (reverse (cons (last Points) Points))))
    
16.     Points
    
17.   )
    
18.       )
    
19.     )
    
20.     1e-6
    
21.   )
    
22. )

;; lst1的点分别位于lst2表组成的多边形内,顺序不对<br /> ;; 现将lst2内的表按照函数 *判断点是否在多边形内* 对lst2重新进行排列，请问如何嵌套foreach达到目的<br /> (setq lst1 '((1266.34 -793.366 0.0) (1109.44 -350.086 0.0) (1670.87 -371.66 0.0) (1543.04 -773.619 0.0))) ;;点表<br /> (setq lst2 '(((1522.25 -655.235 0) (1522.25 -952.235 0) (1942.25 -952.235 0) (1942.25 -655.235 0)) ((930.677 -655.235 0) (930.677 -952.235 0) (1350.68 -952.235 0) (1350.68 -655.235 0)) ((1522.25 -174.764 0) (1522.25 -471.764 0) (1942.25 -471.764 0) (1942.25 -174.764 0)) ((930.677 -174.764 0) (930.677 -471.764 0) (1350.68 -471.764 0) (1350.68 -174.764 0))))  ;;封闭图形坐标表<br /> <br /> ;; No.51  判断点是否在多边形内(狂刀程序)<br /> <br /> (defun isPtinPM  (xPt Points)<br />   (equal<br />     PI<br />     (abs<br />       (apply<br />   '+<br />   (mapcar  '(lambda (x y) (rem (- (angle xPt x) (angle xPt y)) PI))<br />     (reverse (cdr (reverse (cons (last Points) Points))))<br />     Points<br />   )<br />       )<br />     )<br />     1e-6<br />   )<br /> )

q3_2006

什么顺序不对...你想要的顺序是什么....上个图说明一下呗....

newbuser

q3_2006 发表于 2013-12-25 10:53
什么顺序不对...你想要的顺序是什么....上个图说明一下呗....

我想按照图中的text编号按照顺序排列这些图框。除了用循环还有没有更简单的方法

q3_2006

4个点依次在4个点表内??

q3_2006

newbuser 发表于 2013-12-25 10:56
我想按照图中的text编号按照顺序排列这些图框。除了用循环还有没有更简单的方法

图里要说明排序之前的顺序和排好后的顺序.....

newbuser

大哥，图中元顺序是图元生成的顺序，要排列成按照text文件的3，11,12,20排列啊。

q3_2006

2. (defun c:tt ( / i l lst1 lst2 x y)
   
3. (setq lst1 '((1266.34 -793.366 0.0) (1109.44 -350.086 0.0) (1670.87 -371.66 0.0) (1543.04 -773.619 0.0))) ;;点表
   
4. (setq lst2 '(((1522.25 -655.235 0) (1522.25 -952.235 0) (1942.25 -952.235 0) (1942.25 -655.235 0))
   
5. ((930.677 -655.235 0) (930.677 -952.235 0) (1350.68 -952.235 0) (1350.68 -655.235 0))
   
6. ((1522.25 -174.764 0) (1522.25 -471.764 0) (1942.25 -471.764 0) (1942.25 -174.764 0))
   
7. ((930.677 -174.764 0) (930.677 -471.764 0) (1350.68 -471.764 0) (1350.68 -174.764 0))))
   
8.   (setq l '()
   
9. l (reverse (last (mapcar
   
10.       '(lambda (x)
    
11.          (repeat (setq i (length lst2))
    
12.     (setq y (nth (setq i (1- i))
    
13.           lst2
    
14.      )
    
15.     )
    
16.     (if (isPtinPM x y)
    
17.       (setq l (cons y l))
    
18.     )
    
19.          )
    
20.        )
    
21.       lst1
    
22.     )
    
23.      )
    
24.    )
    
25.   )
    
26. )

(defun c:tt ( / i l lst1 lst2 x y)<br /> (setq lst1 '((1266.34 -793.366 0.0) (1109.44 -350.086 0.0) (1670.87 -371.66 0.0) (1543.04 -773.619 0.0))) ;;点表<br /> (setq lst2 '(((1522.25 -655.235 0) (1522.25 -952.235 0) (1942.25 -952.235 0) (1942.25 -655.235 0)) <br /> ((930.677 -655.235 0) (930.677 -952.235 0) (1350.68 -952.235 0) (1350.68 -655.235 0)) <br /> ((1522.25 -174.764 0) (1522.25 -471.764 0) (1942.25 -471.764 0) (1942.25 -174.764 0)) <br /> ((930.677 -174.764 0) (930.677 -471.764 0) (1350.68 -471.764 0) (1350.68 -174.764 0))))<br />   (setq l '()<br /> l (reverse (last (mapcar<br />       '(lambda (x)<br />          (repeat (setq i (length lst2))<br />     (setq y (nth (setq i (1- i))<br />           lst2<br />      )<br />     )<br />     (if (isPtinPM x y)<br />       (setq l (cons y l))<br />     )<br />          )<br />        )<br />       lst1<br />     )<br />      )<br />    )<br />   )<br /> )

q3_2006

我也新手....这是LST2按LST1的顺序排...感觉应该有更简单的写法....拜托高手来个简洁版的....

xyp1964

2. (setq ptn '())
   
3. (foreach pt lst1
   
4.   (if (setq ptn1 (vl-remove-if
   
5.                  '(lambda (x) (not (isPtinPM pt x))) lst2)
   
6.       )
   
7.     (setq ptn (cons (car ptn1) ptn))
   
8.   )
   
9. )
   
10. (setq ptn (reverse ptn))
    

(setq ptn '())<br /> (foreach pt lst1<br />   (if (setq ptn1 (vl-remove-if<br />                  '(lambda (x) (not (isPtinPM pt x))) lst2)<br />       )<br />     (setq ptn (cons (car ptn1) ptn))<br />   )<br /> )<br /> (setq ptn (reverse ptn))<br />

xyp1964

1. (mapcar '(lambda (x) (car (vl-remove-if '(lambda (y) (not (isPtinPM x y))) lst2))) lst1)

复制代码