想请指点一下,定了4个点,想它始终由p1点为起点顺时排序

kwok

我用框选定了p1和p3,然后设了p2和p4,想让它们从p1,p2,p3,p4排位序
不管框选改了p1的位置,都是顺时什排位.例如我框选时是从p2点开始,这里p2就变p1了后面也跟着变.
想达到效果是,p1和p2点不变,让p3和p4根据p1和p2来顺时或逆时排序.

下面是代码
(defun c:tt6();;;框选
  (setq pt1 (getpoint "\n框选范围:")
        pt3 (getcorner pt1)
        pt2 (list (car pt1)(cadr pt3))
        pt4 (list (car pt3)(cadr pt1))
  )
;;;;;;;;;;;下面是是搜坛里的排序,建了个空表,想让他们排序,不起作用;;请指正一下,谢谢.
(setq ptlist (ssadd));;建空表
  (ssadd pt1 ptlist);将若干个元素增加到集
  (ssadd pt3 ptlist)
  (ssadd pt2 ptlist)
  (ssadd pt4 ptlist)
;;;对顶点表排序
  (setq  ptlist (vl-sort ptlist (function
                    (lambda (e1 e2)
                      (< (+ (car e1) (cadr e1)) (+ (car e2) (cadr e2))) ))))
)



还有想问一下entmake 可以定2点直接创建矩形吗?

Gu_xl

1. (defun c:tt ()
   
2.   (setq p1 (getpoint "\n第一点:"))
   
3.   (setq p2 (getcorner p1 "\n对角点:"))
   
4.   (setq ll (apply 'mapcar (list 'min p1 p2))
   
5.         ur (apply 'mapcar (list 'max p1 p2))
   
6.         )
   
7.   (setq p1 (list (car ll) (cadr ur) (caddr ll))
   
8.         p2 ur
   
9.         p3 (list (car ur) (cadr ll) (caddr ll))
   
10.         p4 ll)
    
11.   (list p1 p2 p3 p4)
    
12.   )

(defun c:tt ()<br />   (setq p1 (getpoint "\n第一点:"))<br />   (setq p2 (getcorner p1 "\n对角点:"))<br />   (setq ll (apply 'mapcar (list 'min p1 p2))<br />         ur (apply 'mapcar (list 'max p1 p2))<br />         )<br />   (setq p1 (list (car ll) (cadr ur) (caddr ll))<br />         p2 ur<br />         p3 (list (car ur) (cadr ll) (caddr ll))<br />         p4 ll)<br />   (list p1 p2 p3 p4)<br />   )

kwok

Gu_xl 发表于 2013-2-7 19:48

谢谢,不过p1点始终于是在左上角,
可以让开始框选的第一点做为p1点吗,如你的代码的getpoint"第一点,不管从左上或是坐右下角开始,它都是作为做p1.
想达到效果是,p1和p2点不变,让p3和p4根据p1和p2来顺时或逆时排序.

Gu_xl

kwok 发表于 2013-2-7 19:57
谢谢,不过p1点始终于是在左上角,
可以让开始框选的第一点做为p1点吗,如你的代码的getpoint"第一点,不管从 ...

1. (defun c:tt (/ P1 A P2 LL UR P3 P4 PL)
   
2. 
   
3.   (setq        p1 (getpoint "\n第一点:")
   
4.         a  p1
   
5.   )
   
6. 
   
7.   (setq p2 (getcorner p1 "\n对角点:"))
   
8. 
   
9.   (setq        ll (apply 'mapcar (list 'min p1 p2))
   
10. 
    
11.         ur (apply 'mapcar (list 'max p1 p2))
    
12. 
    
13.   )
    
14. 
    
15.   (setq        p1 (list (car ll) (cadr ur) (caddr ll))
    
16. 
    
17.         p2 ur
    
18. 
    
19.         p3 (list (car ur) (cadr ll) (caddr ll))
    
20. 
    
21.         p4 ll
    
22.   )
    
23. 
    
24.   (setq pl (list p1 p2 p3 p4))
    
25.   (while (not (equal a (car pl) 1e-6))
    
26.     (setq pl (reverse (cons (car pl) (reverse (cdr pl)))))
    
27.   )
    
28. )

(defun c:tt (/ P1 A P2 LL UR P3 P4 PL)<br /> <br />   (setq        p1 (getpoint "\n第一点:")<br />         a  p1<br />   )<br /> <br />   (setq p2 (getcorner p1 "\n对角点:"))<br /> <br />   (setq        ll (apply 'mapcar (list 'min p1 p2))<br /> <br />         ur (apply 'mapcar (list 'max p1 p2))<br /> <br />   )<br /> <br />   (setq        p1 (list (car ll) (cadr ur) (caddr ll))<br /> <br />         p2 ur<br /> <br />         p3 (list (car ur) (cadr ll) (caddr ll))<br /> <br />         p4 ll<br />   )<br /> <br />   (setq pl (list p1 p2 p3 p4))<br />   (while (not (equal a (car pl) 1e-6))<br />     (setq pl (reverse (cons (car pl) (reverse (cdr pl)))))<br />   )<br /> )

weiqi

围观之~支持G版~

xsso

学习一下思路和技术

kwok

谢谢G版的帮助,
不过效果还不是我想的,
我想达到的是不管框选的第一点从什么位置开始框选,它同时也是p1点,然后再根据p1排序其它点,你这个冒似把p1定在左上角.
这个p1点有可能是在左下角,也有可能在右下角或是右上角,它是跟框选第一点在一起的,例如有可能在框选是从右上角到左下角,那p1点就在右上角;,也有可能从右下角到左上角框选,那p1就在右下角.

xyp1964

2. 
   
3. ;; 自定义函数下载: [url]http://bbs.mjtd.com/thread-95673-1-1.html[/url]
   
4. ;; 伪源码需要e派工具箱(XCAD)的支持
   
5. (defun c:tt ()
   
6.   (if (and (setq p1 (getpoint "\n基点<退出>: "))
   
7.            (setq p2 (getcorner p1 "\n对角点<退出>: "))
   
8.       )
   
9.     (progn
   
10.       (xyp-MkLaCo "TEST1" 1)
    
11.       (setq s1  (xyp-rectang p1 p2)
    
12.             ptn  (xyp-get-Vertexs s1 0)
    
13.             ptn1 (xyp-Ptn2CCW ptn)
    
14.             ptn  (if (equal (car ptn) (car ptn1))
    
15.                    ptn
    
16.                    (reverse (cdr (reverse (cons (last ptn1) ptn1))))
    
17.                  )
    
18.             i  1
    
19.       )
    
20.       (xyp-MkLaCo "TEST2" 2)
    
21.       (foreach pt ptn
    
22.         (xyp-Text 5 pt (itoa i))
    
23.         (setq i (1+ i))
    
24.       )
    
25.     )
    
26.   )
    
27.   (princ)
    
28. )
    
29. 
    

<br /> ;; 自定义函数下载: [url]http://bbs.mjtd.com/thread-95673-1-1.html[/url]<br /> ;; 伪源码需要e派工具箱(XCAD)的支持<br /> (defun c:tt ()<br />   (if (and (setq p1 (getpoint "\n基点<退出>: "))<br />            (setq p2 (getcorner p1 "\n对角点<退出>: "))<br />       )<br />     (progn<br />       (xyp-MkLaCo "TEST1" 1)<br />       (setq s1  (xyp-rectang p1 p2)<br />             ptn  (xyp-get-Vertexs s1 0)<br />             ptn1 (xyp-Ptn2CCW ptn)<br />             ptn  (if (equal (car ptn) (car ptn1))<br />                    ptn<br />                    (reverse (cdr (reverse (cons (last ptn1) ptn1))))<br />                  )<br />             i  1<br />       )<br />       (xyp-MkLaCo "TEST2" 2)<br />       (foreach pt ptn<br />         (xyp-Text 5 pt (itoa i))<br />         (setq i (1+ i))<br />       )<br />     )<br />   )<br />   (princ)<br /> )<br /> <br />

kwok

楼上效果是我所想，可惜是伪源码，没得学习.

yjr111

2. (defun c:tt (/ plst)
   
3.   (if (and (setq p1 (getpoint "\n基点<退出>: "))
   
4.            (setq p2 (getcorner p1 "\n对角点<退出>: "))
   
5.       )
   
6.     (progn
   
7.       (command "rectang" p1 p2 )
   
8.       (setq s(entget(entlast)))
   
9.       (setq zf (tt (entlast)))
   
10.       (foreach x s(if (=(car x)10)(setq plst(cons (cdr x)plst))))
    
11.       (setq plst(reverse plst))
    
12.       (if (not zf)(setq plst (cons (car plst)(reverse (cdr plst)))))
    
13.       (setq n 1)
    
14.       (mapcar '(lambda(x)(command "text" x "50" "" (itoa n))(setq n(1+ n)))plst)
    
15.       )
    
16.     )  
    
17.   (princ)
    
18.   )
    
19. (defun tt(e / flag)
    
20.     (setq Obj (vlax-ename->vla-object e))
    
21.     (vla-offset (setq Obj(vlax-ename->vla-object (entlast))) 0.0001)
    
22.     (setq oobj (vlax-ename->vla-object (entlast)))
    
23.     (if (> (vla-get-length obj) (vla-get-length oobj)) (setq flag 1))
    
24.     (vla-delete OObj)
    
25.   flag
    
26. )

(defun c:tt (/ plst)<br />   (if (and (setq p1 (getpoint "\n基点<退出>: "))<br />            (setq p2 (getcorner p1 "\n对角点<退出>: "))<br />       )<br />     (progn<br />       (command "rectang" p1 p2 )<br />       (setq s(entget(entlast)))<br />       (setq zf (tt (entlast)))<br />       (foreach x s(if (=(car x)10)(setq plst(cons (cdr x)plst))))<br />       (setq plst(reverse plst))<br />       (if (not zf)(setq plst (cons (car plst)(reverse (cdr plst)))))<br />       (setq n 1)<br />       (mapcar '(lambda(x)(command "text" x "50" "" (itoa n))(setq n(1+ n)))plst)<br />       )<br />     )  <br />   (princ)<br />   )<br /> (defun tt(e / flag)<br />     (setq Obj (vlax-ename->vla-object e))<br />     (vla-offset (setq Obj(vlax-ename->vla-object (entlast))) 0.0001)<br />     (setq oobj (vlax-ename->vla-object (entlast)))<br />     (if (> (vla-get-length obj) (vla-get-length oobj)) (setq flag 1))<br />     (vla-delete OObj)<br />   flag<br /> )