角落矩形-----LISP------

qiuhaitao110

不太懂你的意思说具体点

ZZXXQQ

如果矩形是封闭的PLINE，可以按下面的步骤编程：
1、选择图框（可以是块）；
2、计算图框的最小包围框；
3、用上面计算好的包围框选择该范围内的封闭PLINE矩形；
4、循环计算各矩形的四个角点组成表；
5、分别对各矩形角点表排序，先排X后排Y；
6、对各矩形的一个角点排序，方法同上；
7、按顺序输出结果。

ZZXXQQ

程序未经调试。另外：小数点后可以有零吧。

2. ;[提取1號矩形左下角點的坐標[X,Y]及X軸長度，Y軸長度，]  X軸55.4 Y軸58. X軸長度52. Y軸長度39.
   
3. ;[提取2號矩形右下角點的坐標[X,Y]及X軸長度，Y軸長度，]  X軸2163.7 Y軸60.5 X軸長度72.Y軸長度61.
   
4. ;[提取3號矩形左上角點的坐標[X,Y]及X軸長度，Y軸長度，]  X軸2162.3 Y軸870.75 X軸長度45. Y軸長度54.
   
5. ;[提取4號矩形右上角點的坐標[X,Y]及X軸長度，Y軸長度，]  X軸53. Y軸869.3 X軸長度36. Y軸長度85
   
6. ;55.4 58. 52. 39.
   
7. ;2163.7 60.5 72. 61.
   
8. ;2162.3 870.75 45. 54.
   
9. ;53. 869.3 36. 85.
   
10. (defun c:nn()
    
11. (setvar "osmode" 0)     
    
12. (setq p1 (getpoint "\n 請選擇窗口的第1點:"))
    
13. (setq p2 (getcorner p1 "\n 請選擇窗口的第1點:"))
    
14. (if (setq ss (ssget "w" P1 P2 '((0 . "LWPOLYLINE") (70 . 1) (90 . 4)))) (progn
    
15. (setq n -1)
    
16. (setq ptlst (list))
    
17. (if (= (sslength ss) 4) (progn
    
18. (repeat (sslength ss)
    
19. (setq ent (ssname ss (setq i (1+ i))))
    
20. (setq plst (list))
    
21. (foreach x ent (if (= (car x) 10) (setq plst (cons (cdr x) plst))))
    
22. (setq plst (vl-sort plst '(lambda (a b) (< (cadr a) (cadr b)))))
    
23. (setq plst (vl-sort plst '(lambda (a b) (< (car a) (car b)))))
    
24. (setq ptlst (cons plst ptlst))
    
25. )
    
26. (setq ptlst (vl-sort ptlst '(lambda (a b) (< (cadar a) (cadar b)))))
    
27. (setq ptlst (vl-sort ptlst '(lambda (a b) (< (caar a) (caar b)))))
    
28. (if (setq fn (findfile "558.txt"))
    
29. (setq fp (open fn "a"))
    
30. (setq fp (open "558.txt" "w"))
    
31. )
    
32. (setvar "DIMZIN" 0)
    
33. (setq lenlst (list))
    
34. (mapcar '(lambda (x) (list (-(car (last x)) (caar x)) (-(cadr(last x)) (cadar x)))) ptlst)
    
35. (setq pt1 (caar ptlst)
    
36.       pt2 (cadadr ptlst)
    
37.       pt3 (cadr(caddr ptlst))
    
38.       pt4 (car(last ptlst)))
    
39. (setq i 1)
    
40. (foreach x lenlst
    
41. (setq pt (eval(read(strcat "pt" (itoa i)))))
    
42. (print (rtos (car pt) 2 1) fp) (princ " " fp)
    
43. (princ (rtos (cadr pt) 2 1) fp) (princ " " fp)
    
44. (princ (rtos (car x) 2 1) fp) (princ " " fp)
    
45. (princ (rtos (cadr x) 2 1) fp)
    
46. )
    
47. (close fp)
    
48. ))
    
49. ))
    
50. (princ)
    
51. )
    

;[提取1號矩形左下角點的坐標[X,Y]及X軸長度，Y軸長度，]  X軸55.4 Y軸58. X軸長度52. Y軸長度39.<br /> ;[提取2號矩形右下角點的坐標[X,Y]及X軸長度，Y軸長度，]  X軸2163.7 Y軸60.5 X軸長度72.Y軸長度61.<br /> ;[提取3號矩形左上角點的坐標[X,Y]及X軸長度，Y軸長度，]  X軸2162.3 Y軸870.75 X軸長度45. Y軸長度54.<br /> ;[提取4號矩形右上角點的坐標[X,Y]及X軸長度，Y軸長度，]  X軸53. Y軸869.3 X軸長度36. Y軸長度85<br /> ;55.4 58. 52. 39.<br /> ;2163.7 60.5 72. 61.<br /> ;2162.3 870.75 45. 54.<br /> ;53. 869.3 36. 85. <br /> (defun c:nn()<br /> (setvar "osmode" 0)     <br /> (setq p1 (getpoint "\n 請選擇窗口的第1點:"))<br /> (setq p2 (getcorner p1 "\n 請選擇窗口的第1點:"))<br /> (if (setq ss (ssget "w" P1 P2 '((0 . "LWPOLYLINE") (70 . 1) (90 . 4)))) (progn<br /> (setq n -1)<br /> (setq ptlst (list))<br /> (if (= (sslength ss) 4) (progn<br /> (repeat (sslength ss)<br /> (setq ent (ssname ss (setq i (1+ i))))<br /> (setq plst (list))<br /> (foreach x ent (if (= (car x) 10) (setq plst (cons (cdr x) plst))))<br /> (setq plst (vl-sort plst '(lambda (a b) (< (cadr a) (cadr b)))))<br /> (setq plst (vl-sort plst '(lambda (a b) (< (car a) (car b)))))<br /> (setq ptlst (cons plst ptlst))<br /> )<br /> (setq ptlst (vl-sort ptlst '(lambda (a b) (< (cadar a) (cadar b)))))<br /> (setq ptlst (vl-sort ptlst '(lambda (a b) (< (caar a) (caar b)))))<br /> (if (setq fn (findfile "558.txt"))<br /> (setq fp (open fn "a"))<br /> (setq fp (open "558.txt" "w"))<br /> )<br /> (setvar "DIMZIN" 0)<br /> (setq lenlst (list))<br /> (mapcar '(lambda (x) (list (-(car (last x)) (caar x)) (-(cadr(last x)) (cadar x)))) ptlst)<br /> (setq pt1 (caar ptlst)<br />       pt2 (cadadr ptlst)<br />       pt3 (cadr(caddr ptlst))<br />       pt4 (car(last ptlst)))<br /> (setq i 1)<br /> (foreach x lenlst<br /> (setq pt (eval(read(strcat "pt" (itoa i)))))<br /> (print (rtos (car pt) 2 1) fp) (princ " " fp)<br /> (princ (rtos (cadr pt) 2 1) fp) (princ " " fp)<br /> (princ (rtos (car x) 2 1) fp) (princ " " fp)<br /> (princ (rtos (cadr x) 2 1) fp)<br /> )<br /> (close fp)<br /> ))<br /> ))<br /> (princ)<br /> )<br />

xyp1964

楼主给的txt文件数据就是错的！

xyp1964

2. ;; 角落矩形 2013-11-06
   
3. (defun c:test1405 ()
   
4.   (xyp-CMDLA0)
   
5.   (defun xyp-aaa (point ptn aa bb cc / pt ss s1 pt ww hh tx)
   
6.     (setq pt (xyp-Get-PtNearPtn point ptn)
   
7.           ss (ssget "c" pt pt '((0 . "*polyline")))
   
8.           s1 (ssname ss 0)
   
9.           pt (xyp-9pt s1 aa)
   
10.           ww (distance pt (xyp-9pt s1 bb))
    
11.           hh (distance pt (xyp-9pt s1 cc))
    
12.           tx (list (car pt) (cadr pt) ww hh)
    
13.     )
    
14.     (xyp-strcat (mapcar 'xyp-2str tx) " ")
    
15.   )
    
16.   (setq lst '())
    
17.   (if (setq ss (ssget '((0 . "LINE") (62 . 1))))
    
18.     (progn
    
19.       (setq s0 (entlast))
    
20.       (xyp-PeditJoin ss 0)
    
21.       (setq ss1        (xyp-SSelEntnext s0)
    
22.             p1        (xyp-9pt ss1 1)
    
23.             p3        (xyp-9pt ss1 3)
    
24.             p7        (xyp-9pt ss1 7)
    
25.             p9        (xyp-9pt ss1 9)
    
26.             ptn        (mapcar '(lambda (x) (xyp-9pt x 1)) (xyp-ss2list ss1))
    
27.             lst        (list (xyp-aaa p1 ptn 1 3 7)
    
28.                       (xyp-aaa p3 ptn 3 1 9)
    
29.                       (xyp-aaa p7 ptn 7 9 1)
    
30.                       (xyp-aaa p9 ptn 9 7 3)
    
31.                 )
    
32.       )
    
33.     )
    
34.   )
    
35.   (xyp-List2File lst "558a" "txt")
    
36.   (xyp-CMDLA1)
    
37. )
    

;; 角落矩形 2013-11-06<br /> (defun c:test1405 ()<br />   (xyp-CMDLA0)<br />   (defun xyp-aaa (point ptn aa bb cc / pt ss s1 pt ww hh tx)<br />     (setq pt (xyp-Get-PtNearPtn point ptn)<br />           ss (ssget "c" pt pt '((0 . "*polyline")))<br />           s1 (ssname ss 0)<br />           pt (xyp-9pt s1 aa)<br />           ww (distance pt (xyp-9pt s1 bb))<br />           hh (distance pt (xyp-9pt s1 cc))<br />           tx (list (car pt) (cadr pt) ww hh)<br />     )<br />     (xyp-strcat (mapcar 'xyp-2str tx) " ")<br />   )<br />   (setq lst '())<br />   (if (setq ss (ssget '((0 . "LINE") (62 . 1))))<br />     (progn<br />       (setq s0 (entlast))<br />       (xyp-PeditJoin ss 0)<br />       (setq ss1        (xyp-SSelEntnext s0)<br />             p1        (xyp-9pt ss1 1)<br />             p3        (xyp-9pt ss1 3)<br />             p7        (xyp-9pt ss1 7)<br />             p9        (xyp-9pt ss1 9)<br />             ptn        (mapcar '(lambda (x) (xyp-9pt x 1)) (xyp-ss2list ss1))<br />             lst        (list (xyp-aaa p1 ptn 1 3 7)<br />                       (xyp-aaa p3 ptn 3 1 9)<br />                       (xyp-aaa p7 ptn 7 9 1)<br />                       (xyp-aaa p9 ptn 9 7 3)<br />                 )<br />       )<br />     )<br />   )<br />   (xyp-List2File lst "558a" "txt")<br />   (xyp-CMDLA1)<br /> )<br />