表格处理：自动延伸＋修剪

tianyi1230

院长再给大伙开玩笑吧，可能这样的代码院长都不会吗？

xyp1964

出个题，非调戏！
欢迎讨论……

风树

想了个笨思路:
1、拷贝一份作为计算，全部打断求外轮廓线
2、以外轮廓线和原图做相交打断，轮廓线以外的删除；轮廓线内的各线做交点计算，求最近的交点然后延申。

不知道有什么好的思路？

flytoday

院长调戏大众了~

Lisper

1. ;;仅对水平和垂直相交直线有效 By Lisper 2013.10.01
   
2. (defun c:tt (/ SS N E EL P1 P2 ANG L1 L2 YL XL X1 X2 L Y1 Y2)
   
3.   (setq ss (ssget '((0 . "line"))))
   
4.   (if ss
   
5.     (progn
   
6.       (repeat (setq n (sslength ss))
   
7.         (setq e (ssname ss (setq n (1- n))))
   
8.         (setq el (entget e)
   
9.               p1 (cdr (assoc 10 el))
   
10.               p2 (cdr (assoc 11 el))
    
11.               ang (angle p1 p2)
    
12.               )
    
13.         (if (or (equal 0 ang 1e-4)
    
14.                 (equal pi ang 1e-4)
    
15.                 )
    
16.           (setq l1 (cons e l1))
    
17.           (setq l2 (cons e l2))
    
18.           )
    
19.         )
    
20.       (setq l1 (vl-sort l1 '(lambda (a b) (< (caddr (assoc 10 (entget a))) (caddr (assoc 10 (entget b)))))) ;_ 水平
    
21.             yl (mapcar '(lambda (x) (caddr (assoc 10 (entget x)))) l1)
    
22.             l2 (vl-sort l2 '(lambda (a b) (< (cadr (assoc 10 (entget a))) (cadr (assoc 10 (entget b)))))) ;_ 垂直
    
23.             xl (mapcar '(lambda (x) (cadr (assoc 10 (entget x)))) l2)
    
24.             )
    
25.       (foreach line l1 ;_ 处理水平线
    
26.         (setq el (entget line)
    
27.               p1 (cdr (assoc 10 el))
    
28.               x1 (car p1)
    
29.               p2 (cdr (assoc 11 el))
    
30.               x2 (car p2)
    
31.               )
    
32.         (setq l (vl-sort-i xl '(lambda (a b) (< (abs (- x1 a)) (abs (- x1 b))))))
    
33.         (setq p1 (list (nth (car l) xl) (cadr p1) (caddr p1)))
    
34.         (setq l (vl-sort-i xl '(lambda (a b) (< (abs (- x2 a)) (abs (- x2 b))))))
    
35.         (setq p2 (list (nth (car l) xl) (cadr p2) (caddr p2)))
    
36.         (setq el (subst (cons 10 p1) (assoc 10 el) el)
    
37.               el (subst (cons 11 p2) (assoc 11 el) el)
    
38.               )
    
39.         (entmod el)
    
40.         )
    
41.       (foreach line l2 ;_ 处理垂直线
    
42.         (setq el (entget line)
    
43.               p1 (cdr (assoc 10 el))
    
44.               y1 (cadr p1)
    
45.               p2 (cdr (assoc 11 el))
    
46.               y2 (cadr p2)
    
47.               )
    
48.         (setq l (vl-sort-i yl '(lambda (a b) (< (abs (- y1 a)) (abs (- y1 b))))))
    
49.         (setq p1 (list (car p1) (nth (car l) yl)  (caddr p1)))
    
50.         (setq l (vl-sort-i yl '(lambda (a b) (< (abs (- y2 a)) (abs (- y2 b))))))
    
51.         (setq p2 (list (car p2) (nth (car l) yl)  (caddr p2)))
    
52.         (setq el (subst (cons 10 p1) (assoc 10 el) el)
    
53.               el (subst (cons 11 p2) (assoc 11 el) el)
    
54.               )
    
55.         (entmod el)
    
56.         )
    
57.      )
    
58.     )
    
59.   (princ)
    
60.   )
    

;;仅对水平和垂直相交直线有效 By Lisper 2013.10.01<br /> (defun c:tt (/ SS N E EL P1 P2 ANG L1 L2 YL XL X1 X2 L Y1 Y2)<br />   (setq ss (ssget '((0 . "line"))))<br />   (if ss<br />     (progn<br />       (repeat (setq n (sslength ss))<br />         (setq e (ssname ss (setq n (1- n))))<br />         (setq el (entget e)<br />               p1 (cdr (assoc 10 el))<br />               p2 (cdr (assoc 11 el))<br />               ang (angle p1 p2)<br />               )<br />         (if (or (equal 0 ang 1e-4)<br />                 (equal pi ang 1e-4)<br />                 )<br />           (setq l1 (cons e l1))<br />           (setq l2 (cons e l2))<br />           )<br />         )<br />       (setq l1 (vl-sort l1 '(lambda (a b) (< (caddr (assoc 10 (entget a))) (caddr (assoc 10 (entget b)))))) ;_ 水平<br />             yl (mapcar '(lambda (x) (caddr (assoc 10 (entget x)))) l1) <br />             l2 (vl-sort l2 '(lambda (a b) (< (cadr (assoc 10 (entget a))) (cadr (assoc 10 (entget b)))))) ;_ 垂直<br />             xl (mapcar '(lambda (x) (cadr (assoc 10 (entget x)))) l2)<br />             )<br />       (foreach line l1 ;_ 处理水平线<br />         (setq el (entget line)<br />               p1 (cdr (assoc 10 el))<br />               x1 (car p1)<br />               p2 (cdr (assoc 11 el))<br />               x2 (car p2)<br />               )<br />         (setq l (vl-sort-i xl '(lambda (a b) (< (abs (- x1 a)) (abs (- x1 b))))))<br />         (setq p1 (list (nth (car l) xl) (cadr p1) (caddr p1)))<br />         (setq l (vl-sort-i xl '(lambda (a b) (< (abs (- x2 a)) (abs (- x2 b))))))<br />         (setq p2 (list (nth (car l) xl) (cadr p2) (caddr p2)))<br />         (setq el (subst (cons 10 p1) (assoc 10 el) el)<br />               el (subst (cons 11 p2) (assoc 11 el) el)<br />               )<br />         (entmod el)<br />         )<br />       (foreach line l2 ;_ 处理垂直线<br />         (setq el (entget line)<br />               p1 (cdr (assoc 10 el))<br />               y1 (cadr p1)<br />               p2 (cdr (assoc 11 el))<br />               y2 (cadr p2)<br />               )<br />         (setq l (vl-sort-i yl '(lambda (a b) (< (abs (- y1 a)) (abs (- y1 b))))))<br />         (setq p1 (list (car p1) (nth (car l) yl)  (caddr p1)))<br />         (setq l (vl-sort-i yl '(lambda (a b) (< (abs (- y2 a)) (abs (- y2 b))))))<br />         (setq p2 (list (car p2) (nth (car l) yl)  (caddr p2)))<br />         (setq el (subst (cons 10 p1) (assoc 10 el) el)<br />               el (subst (cons 11 p2) (assoc 11 el) el)<br />               )<br />         (entmod el)<br />         )<br />      )<br />     )<br />   (princ)<br />   )<br />

xyp1964

Lisper 发表于 2013-10-1 22:47
**** 本内容被作者隐藏 ****

延伸和打断有点搞不清

冰之绝恋

围观围观～～新手来学习

Lisper

xyp1964 发表于 2013-10-2 15:40
延伸和打断有点搞不清

之前的版本是端点就最近的线打断！
以下代码改成了端点全部都延伸的效果:

1. 仅对水平和垂直相交直线有效 By Lisper 2013.10.02
   
2. (defun c:LineExt (/ SS         N    E           EL        P1   P2          ANG  L1   L2         YL
   
3.                     XL         MINX MAXX MINY        MAXY E1          E2   E3   E4         X1
   
4.                     X2         X    I           Y1        Y2   Y
   
5.                    )
   
6.   (setq ss (ssget '((0 . "line"))))
   
7.   (if ss
   
8.     (progn
   
9.       (repeat (setq n (sslength ss))
   
10.         (setq e (ssname ss (setq n (1- n))))
    
11.         (setq el  (entget e)
    
12.               p1  (cdr (assoc 10 el))
    
13.               p2  (cdr (assoc 11 el))
    
14.               ang (angle p1 p2)
    
15.         )
    
16.         (if (or        (equal 0 ang 1e-4)
    
17.                 (equal pi ang 1e-4)
    
18.             )
    
19.           (setq l1 (cons e l1))
    
20.           (setq l2 (cons e l2))
    
21.         )
    
22.       )
    
23.       (setq l1         (vl-sort l1
    
24.                           '(lambda (a b)
    
25.                              (<        (caddr (assoc 10 (entget a)))
    
26.                                 (caddr (assoc 10 (entget b)))
    
27.                              )
    
28.                            )
    
29.                  ) ;_ 水平
    
30.             yl         (mapcar '(lambda (x) (caddr (assoc 10 (entget x)))) l1)
    
31.             l2         (vl-sort l2
    
32.                           '(lambda (a b)
    
33.                              (<        (cadr (assoc 10 (entget a)))
    
34.                                 (cadr (assoc 10 (entget b)))
    
35.                              )
    
36.                            )
    
37.                  ) ;_ 垂直
    
38.             xl         (mapcar '(lambda (x) (cadr (assoc 10 (entget x)))) l2)
    
39.             minx (cadr (assoc 10 (entget (car l2))))
    
40.             maxx (cadr (assoc 10 (entget (last l2))))
    
41.             miny (caddr (assoc 10 (entget (car l1))))
    
42.             maxy (caddr (assoc 10 (entget (last l1))))
    
43.             e1         (car l1)
    
44.             l1         (cdr l1)
    
45.             e2         (last l1)
    
46.             l1         (reverse (cdr (reverse l1)))
    
47.             e3         (car l2)
    
48.             l2         (cdr l2)
    
49.             e4         (last l2)
    
50.             l2         (reverse (cdr (reverse l2)))
    
51.       )
    
52.       (foreach line l1 ;_ 处理水平线
    
53.         (setq el (entget line)
    
54.               p1 (cdr (assoc 10 el))
    
55.               x1 (car p1)
    
56.               p2 (cdr (assoc 11 el))
    
57.               x2 (car p2)
    
58.         )
    
59.         (setq i -1)
    
60.         (vl-some '(lambda (a) (setq i (1+ i)) (< x1 a)) xl)
    
61.         (if (> i 0) (setq i (1- i)))
    
62.         (setq p1 (list (nth i xl) (cadr p1) (caddr p1)))
    
63.         (setq i -1)
    
64.         (vl-some '(lambda (a) (setq i (1+ i)) (< x2 a)) xl)
    
65.        
    
66.         (if
    
67.           (nth i xl)
    
68.           (setq p2 (list (nth i xl) (cadr p2) (caddr p2)))
    
69.           (setq p2 (list (last xl) (cadr p2) (caddr p2)))
    
70.           )
    
71.        
    
72.         (setq el (subst (cons 10 p1) (assoc 10 el) el)
    
73.               el (subst (cons 11 p2) (assoc 11 el) el)
    
74.         )
    
75.         (entmod el)
    
76.       )
    
77.       (foreach line l2 ;_ 处理垂直线
    
78.         (setq el (entget line)
    
79.               p1 (cdr (assoc 10 el))
    
80.               y1 (cadr p1)
    
81.               p2 (cdr (assoc 11 el))
    
82.               y2 (cadr p2)
    
83.         )
    
84.         (setq i -1)
    
85.         (vl-some '(lambda (a) (setq i (1+ i)) (< y1 a)) yl)
    
86.         (if (> i 0) (setq i (1- i)))
    
87.         (setq p1 (list (car p1) (nth i yl)  (caddr p1)))
    
88.         (setq i -1)
    
89.         (vl-some '(lambda (a) (setq i (1+ i)) (< y2 a)) yl)
    
90.         (if
    
91.           (nth i yl)
    
92.           (setq p2 (list (car p2) (nth i yl)  (caddr p2)))
    
93.           (setq p2 (list (car p2) (last yl) (caddr p2)))
    
94.           )
    
95.        
    
96.         (setq el (subst (cons 10 p1) (assoc 10 el) el)
    
97.               el (subst (cons 11 p2) (assoc 11 el) el)
    
98.         )
    
99.         (entmod el)
    
100.       )
     
101.       (if e1
     
102.         (progn
     
103.           (setq el (entget e1))
     
104.           (setq        el (subst (list 10 minx miny 0) (assoc 10 el) el)
     
105.                 el (subst (list 11 maxx miny 0) (assoc 11 el) el)
     
106.           )
     
107.           (entmod el)
     
108.         )
     
109.       )
     
110.       (if e2
     
111.         (progn
     
112.           (setq el (entget e2))
     
113.           (setq        el (subst (list 10 minx maxy 0) (assoc 10 el) el)
     
114.                 el (subst (list 11 maxx maxy 0) (assoc 11 el) el)
     
115.           )
     
116.           (entmod el)
     
117.         )
     
118.       )
     
119.       (if e3
     
120.         (progn
     
121.           (setq el (entget e3))
     
122.           (setq        el (subst (list 10 minx miny 0) (assoc 10 el) el)
     
123.                 el (subst (list 11 minx maxy 0) (assoc 11 el) el)
     
124.           )
     
125.           (entmod el)
     
126.         )
     
127.       )
     
128.       (if e4
     
129.         (progn
     
130.           (setq el (entget e4))
     
131.           (setq        el (subst (list 10 maxx miny 0) (assoc 10 el) el)
     
132.                 el (subst (list 11 maxx maxy 0) (assoc 11 el) el)
     
133.           )
     
134.           (entmod el)
     
135.         )
     
136.       )
     
137. 
     
138.     )
     
139.   )
     
140.   (princ)
     
141. )
     
142. 
     

仅对水平和垂直相交直线有效 By Lisper 2013.10.02<br /> (defun c:LineExt (/ SS         N    E           EL        P1   P2          ANG  L1   L2         YL<br />                     XL         MINX MAXX MINY        MAXY E1          E2   E3   E4         X1<br />                     X2         X    I           Y1        Y2   Y<br />                    )<br />   (setq ss (ssget '((0 . "line"))))<br />   (if ss<br />     (progn<br />       (repeat (setq n (sslength ss))<br />         (setq e (ssname ss (setq n (1- n))))<br />         (setq el  (entget e)<br />               p1  (cdr (assoc 10 el))<br />               p2  (cdr (assoc 11 el))<br />               ang (angle p1 p2)<br />         )<br />         (if (or        (equal 0 ang 1e-4)<br />                 (equal pi ang 1e-4)<br />             )<br />           (setq l1 (cons e l1))<br />           (setq l2 (cons e l2))<br />         )<br />       )<br />       (setq l1         (vl-sort l1<br />                           '(lambda (a b)<br />                              (<        (caddr (assoc 10 (entget a)))<br />                                 (caddr (assoc 10 (entget b)))<br />                              )<br />                            )<br />                  ) ;_ 水平<br />             yl         (mapcar '(lambda (x) (caddr (assoc 10 (entget x)))) l1)<br />             l2         (vl-sort l2<br />                           '(lambda (a b)<br />                              (<        (cadr (assoc 10 (entget a)))<br />                                 (cadr (assoc 10 (entget b)))<br />                              )<br />                            )<br />                  ) ;_ 垂直<br />             xl         (mapcar '(lambda (x) (cadr (assoc 10 (entget x)))) l2)<br />             minx (cadr (assoc 10 (entget (car l2))))<br />             maxx (cadr (assoc 10 (entget (last l2))))<br />             miny (caddr (assoc 10 (entget (car l1))))<br />             maxy (caddr (assoc 10 (entget (last l1))))<br />             e1         (car l1)<br />             l1         (cdr l1)<br />             e2         (last l1)<br />             l1         (reverse (cdr (reverse l1)))<br />             e3         (car l2)<br />             l2         (cdr l2)<br />             e4         (last l2)<br />             l2         (reverse (cdr (reverse l2)))<br />       )<br />       (foreach line l1 ;_ 处理水平线<br />         (setq el (entget line)<br />               p1 (cdr (assoc 10 el))<br />               x1 (car p1)<br />               p2 (cdr (assoc 11 el))<br />               x2 (car p2)<br />         )<br />         (setq i -1)<br />         (vl-some '(lambda (a) (setq i (1+ i)) (< x1 a)) xl)<br />         (if (> i 0) (setq i (1- i)))<br />         (setq p1 (list (nth i xl) (cadr p1) (caddr p1)))<br />         (setq i -1)<br />         (vl-some '(lambda (a) (setq i (1+ i)) (< x2 a)) xl)<br />         <br />         (if<br />           (nth i xl)<br />           (setq p2 (list (nth i xl) (cadr p2) (caddr p2)))<br />           (setq p2 (list (last xl) (cadr p2) (caddr p2)))<br />           )<br />         <br />         (setq el (subst (cons 10 p1) (assoc 10 el) el)<br />               el (subst (cons 11 p2) (assoc 11 el) el)<br />         )<br />         (entmod el)<br />       )<br />       (foreach line l2 ;_ 处理垂直线<br />         (setq el (entget line)<br />               p1 (cdr (assoc 10 el))<br />               y1 (cadr p1)<br />               p2 (cdr (assoc 11 el))<br />               y2 (cadr p2)<br />         )<br />         (setq i -1)<br />         (vl-some '(lambda (a) (setq i (1+ i)) (< y1 a)) yl)<br />         (if (> i 0) (setq i (1- i)))<br />         (setq p1 (list (car p1) (nth i yl)  (caddr p1)))<br />         (setq i -1)<br />         (vl-some '(lambda (a) (setq i (1+ i)) (< y2 a)) yl)<br />         (if<br />           (nth i yl)<br />           (setq p2 (list (car p2) (nth i yl)  (caddr p2)))<br />           (setq p2 (list (car p2) (last yl) (caddr p2)))<br />           )<br />         <br />         (setq el (subst (cons 10 p1) (assoc 10 el) el)<br />               el (subst (cons 11 p2) (assoc 11 el) el)<br />         )<br />         (entmod el)<br />       )<br />       (if e1<br />         (progn<br />           (setq el (entget e1))<br />           (setq        el (subst (list 10 minx miny 0) (assoc 10 el) el)<br />                 el (subst (list 11 maxx miny 0) (assoc 11 el) el)<br />           )<br />           (entmod el)<br />         )<br />       )<br />       (if e2<br />         (progn<br />           (setq el (entget e2))<br />           (setq        el (subst (list 10 minx maxy 0) (assoc 10 el) el)<br />                 el (subst (list 11 maxx maxy 0) (assoc 11 el) el)<br />           )<br />           (entmod el)<br />         )<br />       )<br />       (if e3<br />         (progn<br />           (setq el (entget e3))<br />           (setq        el (subst (list 10 minx miny 0) (assoc 10 el) el)<br />                 el (subst (list 11 minx maxy 0) (assoc 11 el) el)<br />           )<br />           (entmod el)<br />         )<br />       )<br />       (if e4<br />         (progn<br />           (setq el (entget e4))<br />           (setq        el (subst (list 10 maxx miny 0) (assoc 10 el) el)<br />                 el (subst (list 11 maxx maxy 0) (assoc 11 el) el)<br />           )<br />           (entmod el)<br />         )<br />       )<br /> <br />     )<br />   )<br />   (princ)<br /> )<br /> <br />

xyp1964

该延伸的延伸，该打断的打断

风树

将最近延申点长度和可裁剪长度做比较，前者长时裁剪删悬挂线，否则延申