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

xyp1964

求以下延伸＋修剪效果的代码：

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 />

阿猪蛋

围观围观～～新手来学习

zazhz123

一群牛人，，拜服。

ucuc2003

顶起+关注一下

vlisp2012

校长也求源码？

669423907

院长帐号被盗

pxt2001

669423907 发表于 2013-9-30 08:13
院长帐号被盗

这是个神回复！

网友的想像力很强大！

lpl

校长也求源码？

成仔

顶起+关注一下!!

机械工程师

目测动画是院长的，发帖的是不是就不知道了。
也许是院长来调戏来了，院长赶紧放源码给我们围观吧。

9701519

围观！！！！！！！！！

sixth

表示围观，院长求源码不太可能吧