[讨论]：如何找到多义线的对角点

eachy

1 对不同图层操作应该利用 过滤选项 '((0 . "*polyline")(8  . "D01A,D02A")，更高效的写法是将处理部分写成函数，参数是选择集。
2 对你的应用中这个判断可能要简单的多，只要判断pline 的 Box 是否在另一个的 Box 内即可，

2. (while (< i ssl)
   
3.   (setq e (ssname ss (setq ssl (1- ssl))))
   
4.   (vla-getboundingbox (vlax-ename->vla-object e) 'bp 'up)
   
5.   (if (not outpl) (setq outpl e out_box (list (safearray-value bp) (safrarray-value up))));_ 保存初始值
   
6.   ..接下来对第二个以后的实体和保存的初始值比较Box，如果第二个实体的Box在第一个
   
7.   ;;内部不处理，不在记录的Box内部，则对记录的 outpl out_box 重新赋值
   
8. )

(while (< i ssl)<br />   (setq e (ssname ss (setq ssl (1- ssl))))<br />   (vla-getboundingbox (vlax-ename->vla-object e) 'bp 'up)<br />   (if (not outpl) (setq outpl e out_box (list (safearray-value bp) (safrarray-value up))));_ 保存初始值<br />   ..接下来对第二个以后的实体和保存的初始值比较Box，如果第二个实体的Box在第一个<br />   ;;内部不处理，不在记录的Box内部，则对记录的 outpl out_box 重新赋值<br /> )

啵浪鼓

(vlax-ename->vla-object e)
得到的结果：IAcadLWPolyline 052ff574>
而全句(vla-getboundingbox (vlax-ename->vla-object e) 'bp 'up)
得到的结果为nil，因为bp与up此时未定义呀

斑竹，不要告诉我思路，直接写程序好了，我对arx一窍不通，这样来得比较快些~!
（16楼的程序我也不知该往程序里哪里加，还是斑竹直接写全程序我再来慢慢钻好了）
好像还有个问题，上面的程序感觉只是分辨当同图层2个以内的*pline在一起能识别，你写全程序时请帮忙考虑可能会有无限多个*pline，程序只要得到最外面的*pline即可（乎略所有内在*pline）

eachy

2. 
   
3. (defun getssoutpl (ss / ssl e outpl out_box bp up bp0 up0)
   
4.   (setq ssl (sslength ss))
   
5.   (while (> ssl 0)
   
6.     (setq e (ssname ss (setq ssl (1- ssl))))
   
7.     (vla-getboundingbox (vlax-ename->vla-object e) 'bp 'up)
   
8.     (if        (not outpl)
   
9.       (setq outpl   e
   
10.             out_box (list (safearray-value bp) (safearray-value up))
    
11.       )
    
12.       (progn
    
13.         (vla-getboundingbox (vlax-ename->vla-object e) 'bp 'up)
    
14.         (setq bp  (safearray-value bp)
    
15.               up  (safearray-value up)
    
16.               bp0 (car out_box)
    
17.               up0 (cadr out_box)
    
18.         )
    
19.         (if (and (and (< (car bp) (car bp0))
    
20.                       (< (cadr bp) (cadr bp0))
    
21.                  )
    
22.                  (and (> (car up) (car up0))
    
23.                       (> (cadr up) (cadr up0))
    
24.                  )
    
25.             )
    
26.           (setq        outpl        e
    
27.                 out_box        (list bp up)
    
28.           )
    
29.         )
    
30.       )
    
31.     )
    
32.   )
    
33.   out_box
    
34. )
    
35. (defun c:tt (/ ss lst)
    
36.   (if (setq ss (ssget '((0 . "*polyline"))))
    
37.     (progn
    
38.       (setq lst (getssoutpl ss))
    
39.       (princ lst))
    
40.   )
    
41.   (princ)
    
42. )

<br /> (defun getssoutpl (ss / ssl e outpl out_box bp up bp0 up0)<br />   (setq ssl (sslength ss))<br />   (while (> ssl 0)<br />     (setq e (ssname ss (setq ssl (1- ssl))))<br />     (vla-getboundingbox (vlax-ename->vla-object e) 'bp 'up)<br />     (if        (not outpl)<br />       (setq outpl   e<br />             out_box (list (safearray-value bp) (safearray-value up))<br />       )<br />       (progn<br />         (vla-getboundingbox (vlax-ename->vla-object e) 'bp 'up)<br />         (setq bp  (safearray-value bp)<br />               up  (safearray-value up)<br />               bp0 (car out_box)<br />               up0 (cadr out_box)<br />         )<br />         (if (and (and (< (car bp) (car bp0))<br />                       (< (cadr bp) (cadr bp0))<br />                  )<br />                  (and (> (car up) (car up0))<br />                       (> (cadr up) (cadr up0))<br />                  )<br />             )<br />           (setq        outpl        e<br />                 out_box        (list bp up)<br />           )<br />         )<br />       )<br />     )<br />   )<br />   out_box<br /> )<br /> (defun c:tt (/ ss lst)<br />   (if (setq ss (ssget '((0 . "*polyline"))))<br />     (progn<br />       (setq lst (getssoutpl ss))<br />       (princ lst))<br />   )<br />   (princ)<br /> )

狂刀

点到为止，请不要再找我麻烦

自定义函数(c:corn)
选取图块，返回列表:  '(图块内＂０＂层实体包围盒对角点　＂"D06A"层包围盒实体对角点)
返回格式'(((x1 y1 z1)(x2 y2 z2))((x3 y3 z3)(x4 y4 z4)))
调用实例:

2. 
   
3. (defun c:tt ()
   
4.   (setq lst (c:corn))
   
5.   (command ".line" (caar lst)(cadar lst)"" ".line" (caadr lst)(cadadr lst)"")
   
6. )
   

<br /> (defun c:tt ()<br />   (setq lst (c:corn))<br />   (command ".line" (caar lst)(cadar lst)"" ".line" (caadr lst)(cadadr lst)"")<br /> )<br />

(附件中为编译后的函数，含测试c:tt．加载后直接输入tt可测试)

狂刀

看

啵浪鼓

2. (defun c:ttt (/)
   
3.   (if (setq s (ssget '((0 . "*polyline")
   
4.       (8 . "D01A,D02A,D03A,D04A,D05A,D05B,S01A,S01B,S02A,P05A,P04A,P03A,P02A,P01A"))))
   
5.     (progn
   
6.       (setq d1 (ssadd) d2 (ssadd) d3 (ssadd) d4 (ssadd)  d5 (ssadd) d5b (ssadd)
   
7.             s1 (ssadd) s1b (ssadd) s2 (ssadd) p5 (ssadd) p4 (ssadd)
   
8.             p3 (ssadd) p2 (ssadd)  p1 (ssadd)i 0)
   
9.       (while (< i (sslength s))
   
10.         (if (= "D01A" (cdr(assoc 8 (entget (ssname s i)))))
    
11.           (ssadd (ssname s i) d1))
    
12.         (if (= "D02A" (cdr(assoc 8 (entget (ssname s i)))))
    
13.           (ssadd (ssname s i) d2))
    
14.         (if (= "D03A" (cdr(assoc 8 (entget (ssname s i)))))
    
15.           (ssadd (ssname s i) d3))
    
16.         (if (= "D04A" (cdr(assoc 8 (entget (ssname s i)))))
    
17.           (ssadd (ssname s i) d4))
    
18.         (if (= "D05A" (cdr(assoc 8 (entget (ssname s i)))))
    
19.           (ssadd (ssname s i) d5))
    
20.         (if (= "D05B" (cdr(assoc 8 (entget (ssname s i)))))
    
21.           (ssadd (ssname s i) d5b))
    
22.         (if (= "S01A" (cdr(assoc 8 (entget (ssname s i)))))
    
23.           (ssadd (ssname s i) s1))
    
24.         (if (= "S01B" (cdr(assoc 8 (entget (ssname s i)))))
    
25.           (ssadd (ssname s i) s1b))
    
26.         (if (= "P05A" (cdr(assoc 8 (entget (ssname s i)))))
    
27.           (ssadd (ssname s i) p5))
    
28.         (if (= "P04A" (cdr(assoc 8 (entget (ssname s i)))))
    
29.           (ssadd (ssname s i) p4))
    
30.         (if (= "P03A" (cdr(assoc 8 (entget (ssname s i)))))
    
31.           (ssadd (ssname s i) p3))
    
32.         (if (= "P02A" (cdr(assoc 8 (entget (ssname s i)))))
    
33.           (ssadd (ssname s i) p2))
    
34.         (if (= "P01A" (cdr(assoc 8 (entget (ssname s i)))))
    
35.           (ssadd (ssname s i) p1))
    
36.         (setq i (+ i 1))
    
37.       );while
    
38. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;start d1
    
39.       (setq i 0)
    
40.       (while (< i (sslength d1))
    
41.         (setq d11 (ssname d1 i))
    
42.         (vla-getboundingbox (vlax-ename->vla-object d11) 'd1bp 'd1up)
    
43.         (if (not d1outpl)
    
44.           (setq d1outpl d11
    
45.                 d1out_box (list (safearray-value d1bp) (safearray-value d1up)))
    
46.           (progn
    
47.             (vla-getboundingbox (vlax-ename->vla-object d11) 'd1bp 'd1up)
    
48.             (setq d1bp (safearray-value d1bp)
    
49.                   d1up (safearray-value d1up)
    
50.                   d1bp0 (car d1out_box)
    
51.                   d1up0 (cadr d1out_box))
    
52.             (if (and (and (< (car d1bp) (car d1bp0))
    
53.                           (< (cadr d1bp) (cadr d1bp0)))
    
54.                      (and (> (car d1up) (car d1up0))
    
55.                           (> (cadr d1up) (cadr d1up0)))
    
56.                 )
    
57.               (setq d1outpl d11
    
58.                     d1out_box (list d1bp d1up))
    
59.             )
    
60.           )
    
61.         )
    
62.         d1out_box
    
63.         (setq i (+ i 1))
    
64.         (command "line" d1bp d1up "")
    
65.         (setq d1c1 d1bp d1c2 d1up)
    
66.       );while d1 end
    
67. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;start d2
    
68.       (setq i 0)
    
69.       (while (< i (sslength d2))
    
70.         (setq d22 (ssname d2 i))
    
71.         (vla-getboundingbox (vlax-ename->vla-object d22) 'd2bp 'd2up)
    
72.         (if (not d2outpl)
    
73.           (setq d2outpl d22
    
74.                 d2out_box (list (safearray-value d2bp) (safearray-value d2up)))
    
75.           (progn
    
76.             (vla-getboundingbox (vlax-ename->vla-object d22) 'd2bp 'd2up)
    
77.             (setq d2bp (safearray-value d2bp)
    
78.                   d2up (safearray-value d2up)
    
79.                   d2bp0 (car d2out_box)
    
80.                   d2up0 (cadr d2out_box))
    
81.             (if (and (and (< (car d2bp) (car d2bp0))
    
82.                           (< (cadr d2bp) (cadr d2bp0)))
    
83.                      (and (> (car d2up) (car d2up0))
    
84.                           (> (cadr d2up) (cadr d2up0)))
    
85.                 )
    
86.               (setq d2outpl d22
    
87.                     d2out_box (list d2bp d2up))
    
88.             )
    
89.           )
    
90.         )
    
91.         d2out_box
    
92.         (setq i (+ i 1))
    
93.         (command "line" d2bp d2up "")
    
94.         (setq d2c1 d2bp d2c2 d2up)
    
95.       );while d2 end
    
96.     );progn
    
97.   );if
    
98.   (princ)
    
99. );defun

(defun c:ttt (/)<br />   (if (setq s (ssget '((0 . "*polyline") <br />       (8 . "D01A,D02A,D03A,D04A,D05A,D05B,S01A,S01B,S02A,P05A,P04A,P03A,P02A,P01A"))))<br />     (progn<br />       (setq d1 (ssadd) d2 (ssadd) d3 (ssadd) d4 (ssadd)  d5 (ssadd) d5b (ssadd) <br />             s1 (ssadd) s1b (ssadd) s2 (ssadd) p5 (ssadd) p4 (ssadd) <br />             p3 (ssadd) p2 (ssadd)  p1 (ssadd)i 0)<br />       (while (< i (sslength s))<br />         (if (= "D01A" (cdr(assoc 8 (entget (ssname s i)))))<br />           (ssadd (ssname s i) d1))<br />         (if (= "D02A" (cdr(assoc 8 (entget (ssname s i)))))<br />           (ssadd (ssname s i) d2))<br />         (if (= "D03A" (cdr(assoc 8 (entget (ssname s i)))))<br />           (ssadd (ssname s i) d3))<br />         (if (= "D04A" (cdr(assoc 8 (entget (ssname s i)))))<br />           (ssadd (ssname s i) d4))<br />         (if (= "D05A" (cdr(assoc 8 (entget (ssname s i)))))<br />           (ssadd (ssname s i) d5))<br />         (if (= "D05B" (cdr(assoc 8 (entget (ssname s i)))))<br />           (ssadd (ssname s i) d5b))<br />         (if (= "S01A" (cdr(assoc 8 (entget (ssname s i)))))<br />           (ssadd (ssname s i) s1))<br />         (if (= "S01B" (cdr(assoc 8 (entget (ssname s i)))))<br />           (ssadd (ssname s i) s1b))<br />         (if (= "P05A" (cdr(assoc 8 (entget (ssname s i)))))<br />           (ssadd (ssname s i) p5))<br />         (if (= "P04A" (cdr(assoc 8 (entget (ssname s i)))))<br />           (ssadd (ssname s i) p4))<br />         (if (= "P03A" (cdr(assoc 8 (entget (ssname s i)))))<br />           (ssadd (ssname s i) p3))<br />         (if (= "P02A" (cdr(assoc 8 (entget (ssname s i)))))<br />           (ssadd (ssname s i) p2))<br />         (if (= "P01A" (cdr(assoc 8 (entget (ssname s i)))))<br />           (ssadd (ssname s i) p1))<br />         (setq i (+ i 1))<br />       );while<br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;start d1<br />       (setq i 0)<br />       (while (< i (sslength d1))<br />         (setq d11 (ssname d1 i))<br />         (vla-getboundingbox (vlax-ename->vla-object d11) 'd1bp 'd1up)<br />         (if (not d1outpl)<br />           (setq d1outpl d11<br />                 d1out_box (list (safearray-value d1bp) (safearray-value d1up)))<br />           (progn<br />             (vla-getboundingbox (vlax-ename->vla-object d11) 'd1bp 'd1up)<br />             (setq d1bp (safearray-value d1bp)<br />                   d1up (safearray-value d1up)<br />                   d1bp0 (car d1out_box)<br />                   d1up0 (cadr d1out_box))<br />             (if (and (and (< (car d1bp) (car d1bp0))<br />                           (< (cadr d1bp) (cadr d1bp0)))<br />                      (and (> (car d1up) (car d1up0))<br />                           (> (cadr d1up) (cadr d1up0)))<br />                 )<br />               (setq d1outpl d11<br />                     d1out_box (list d1bp d1up))<br />             )<br />           )<br />         )<br />         d1out_box<br />         (setq i (+ i 1))<br />         (command "line" d1bp d1up "")<br />         (setq d1c1 d1bp d1c2 d1up)<br />       );while d1 end<br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;start d2<br />       (setq i 0)<br />       (while (< i (sslength d2))<br />         (setq d22 (ssname d2 i))<br />         (vla-getboundingbox (vlax-ename->vla-object d22) 'd2bp 'd2up)<br />         (if (not d2outpl)<br />           (setq d2outpl d22<br />                 d2out_box (list (safearray-value d2bp) (safearray-value d2up)))<br />           (progn<br />             (vla-getboundingbox (vlax-ename->vla-object d22) 'd2bp 'd2up)<br />             (setq d2bp (safearray-value d2bp)<br />                   d2up (safearray-value d2up)<br />                   d2bp0 (car d2out_box)<br />                   d2up0 (cadr d2out_box))<br />             (if (and (and (< (car d2bp) (car d2bp0))<br />                           (< (cadr d2bp) (cadr d2bp0)))<br />                      (and (> (car d2up) (car d2up0))<br />                           (> (cadr d2up) (cadr d2up0)))<br />                 )<br />               (setq d2outpl d22<br />                     d2out_box (list d2bp d2up))<br />             )<br />           )<br />         )<br />         d2out_box<br />         (setq i (+ i 1))<br />         (command "line" d2bp d2up "")<br />         (setq d2c1 d2bp d2c2 d2up)<br />       );while d2 end<br />     );progn<br />   );if<br />   (princ)<br /> );defun

18楼的程序经测试是可用且无问题的，可加入我的主程序时出错了，下面错误提示是发现这段(command "line" d2bp d2up "")里有许多坐标，CAD命令导致错误！
Command: ttt
Select objects: Specify opposite corner: 2 found
Select objects:  ; error: bad argument value: AutoCAD command: #<safearray...>


因为我的主程序里需要调用图层的坐标点，所以将18楼eachy斑竹的程序加入到我的程序里。
经测试，无限多个*pline，程序无法得到最外面的*pline（将所有选中的*pline的坐标全记录了），请eachy斑竹再帮我看看问题出在哪？

eachy

已经给你说明了，不要一次把图层都写上，分开处理
(setq s1 (ssget '((8 . "D01A"))))
(setq box1 (getssoutpl s1))
(setq s2 (ssget '((8 . "D02A"))))
(setq box2 (getssoutpl s2))
(setq s3 (ssget '((8 . "D03A"))))
(setq box3 (ssget '((8 . "D04A"))))

...

你是得到所有线的box还是每个层一个box？

啵浪鼓

可是在总图里，我只要一次框选就好了，你这样做我得选多少次呀？
下面图示是我想一次得到的各图层的坐标点

eachy

选择用 getpoint  和 getcorner 可以得到对角点，后面构造选择集就可以使用了，不是每次都选择

eachy

如果用 set 和 eval 下面的代码还可以简化很多，初学就用下面的可以了
求box的一定要用子函数，不要每个选择集处理都写一遍代码

2. 
   
3. (defun c:tt (/           p1         p2    s1    s2           s3         s4    s5    s6
   
4.              s7           s8         s9    s10   s11   s12         s13   box1  box2
   
5.              box3  box4         box5  box6  box7  box8         box9  box10 box11
   
6.              box12 box13
   
7.             )
   
8.   (if (and (setq p1 (getpoint "\n角点: "))
   
9.            (setq p2 (getcorner p1 "\n对角点: "))
   
10.       )
    
11.     (progn
    
12.       (setq s1        (ssget "w" p1 p2 '((8 . "D01A")))
    
13.             s2        (ssget "w" p1 p2 '((8 . "D02A")))
    
14.             s3        (ssget "w" p1 p2 '((8 . "D04A")))
    
15.             s4        (ssget "w" p1 p2 '((8 . "D05A")))
    
16.             s5        (ssget "w" p1 p2 '((8 . "D05B")))
    
17.             s6        (ssget "w" p1 p2 '((8 . "S01A")))
    
18.             s7        (ssget "w" p1 p2 '((8 . "S01B")))
    
19.             s8        (ssget "w" p1 p2 '((8 . "S02A")))
    
20.             s9        (ssget "w" p1 p2 '((8 . "P05A")))
    
21.             s10        (ssget "w" p1 p2 '((8 . "P04A")))
    
22.             s11        (ssget "w" p1 p2 '((8 . "P03B")))
    
23.             s12        (ssget "w" p1 p2 '((8 . "P02A")))
    
24.             s13        (ssget "w" p1 p2 '((8 . "P01B")))
    
25.       )
    
26.       (setq box1  (getssoutpl s1)
    
27.             box2  (getssoutpl s2)
    
28.             box3  (getssoutpl s3)
    
29.             box4  (getssoutpl s4)
    
30.             box5  (getssoutpl s5)
    
31.             box6  (getssoutpl s6)
    
32.             box7  (getssoutpl s7)
    
33.             box8  (getssoutpl s8)
    
34.             box9  (getssoutpl s9)
    
35.             box10 (getssoutpl s10)
    
36.             box11 (getssoutpl s11)
    
37.             box12 (getssoutpl s12)
    
38.             box13 (getssoutpl s13)
    
39.       )
    
40.     )
    
41.   )
    
42. )

<br /> (defun c:tt (/           p1         p2    s1    s2           s3         s4    s5    s6<br />              s7           s8         s9    s10   s11   s12         s13   box1  box2<br />              box3  box4         box5  box6  box7  box8         box9  box10 box11<br />              box12 box13<br />             )<br />   (if (and (setq p1 (getpoint "\n角点: "))<br />            (setq p2 (getcorner p1 "\n对角点: "))<br />       )<br />     (progn<br />       (setq s1        (ssget "w" p1 p2 '((8 . "D01A")))<br />             s2        (ssget "w" p1 p2 '((8 . "D02A")))<br />             s3        (ssget "w" p1 p2 '((8 . "D04A")))<br />             s4        (ssget "w" p1 p2 '((8 . "D05A")))<br />             s5        (ssget "w" p1 p2 '((8 . "D05B")))<br />             s6        (ssget "w" p1 p2 '((8 . "S01A")))<br />             s7        (ssget "w" p1 p2 '((8 . "S01B")))<br />             s8        (ssget "w" p1 p2 '((8 . "S02A")))<br />             s9        (ssget "w" p1 p2 '((8 . "P05A")))<br />             s10        (ssget "w" p1 p2 '((8 . "P04A")))<br />             s11        (ssget "w" p1 p2 '((8 . "P03B")))<br />             s12        (ssget "w" p1 p2 '((8 . "P02A")))<br />             s13        (ssget "w" p1 p2 '((8 . "P01B")))<br />       )<br />       (setq box1  (getssoutpl s1)<br />             box2  (getssoutpl s2)<br />             box3  (getssoutpl s3)<br />             box4  (getssoutpl s4)<br />             box5  (getssoutpl s5)<br />             box6  (getssoutpl s6)<br />             box7  (getssoutpl s7)<br />             box8  (getssoutpl s8)<br />             box9  (getssoutpl s9)<br />             box10 (getssoutpl s10)<br />             box11 (getssoutpl s11)<br />             box12 (getssoutpl s12)<br />             box13 (getssoutpl s13)<br />       )<br />     )<br />   )<br /> )

啵浪鼓

楼上的程序运行提示如下错误（有加载vl-load-com）：
Command: tt
角点:
对角点: ; error: no function definition: GETSSOUTPL

又回到原话题了，需要用getpoint这个命令集了，5楼的程序就是基于getpoint建构的，因为总图里有太多的线重叠，如果用getpoint容易误选中点，所以才要改成用(ssget)来选择。
（23楼的贴图只是一个简单的图片，看5楼的flash就不难看出有多少线段在总图里了）

eachy

getssoutpl 是18楼的函数，取点是为了构造选择集用的窗口，和线多少没关系。ssget 前先关闭 Osmode

啵浪鼓

哦，明白了一些了。。。

是不是这样写，可老出错，就是不知哪里出错，老提示; error: syntax error，可能还有其它问题，程序运行不下去了，最重要的一点是不知这样的写法对不对，无法调试，哎~

(defun getssoutpl (d1 d2 / i e outpl out_box bp up bp0 up0)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;start d1
  (setq i 0)
  (while (< i (sslength d1))
    (setq d11 (ssname d1 i))
    (vla-getboundingbox (vlax-ename->vla-object d11) 'd1bp 'd1up)
    (if (not d1outpl)
      (setq d1outpl d11
            d1out_box (list (safearray-value d1bp) (safearray-value d1up)))
      (progn
        (vla-getboundingbox (vlax-ename->vla-object d11) 'd1bp 'd1up)
        (setq d1bp (safearray-value d1bp)
              d1up (safearray-value d1up)
              d1bp0 (car d1out_box)
              d1up0 (cadr d1out_box))
        (if (and (and (< (car d1bp) (car d1bp0))
                      (< (cadr d1bp) (cadr d1bp0)))
                 (and (> (car d1up) (car d1up0))
                      (> (cadr d1up) (cadr d1up0)))
            )
          (setq d1outpl d11
                d1out_box (list d1bp d1up))
        )
      )
    )
    (setq i (+ i 1))
  );while d1 end
  d1out_box
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;start d2
  (setq i 0)
  (while (< i (sslength d2))
    (setq d22 (ssname d2 i))
    (vla-getboundingbox (vlax-ename->vla-object d22) 'd2bp 'd2up)
    (if (not d2outpl)
      (setq d2outpl d22
            d2out_box (list (safearray-value d2bp) (safearray-value d2up)))
      (progn
        (vla-getboundingbox (vlax-ename->vla-object d22) 'd2bp 'd2up)
        (setq d2bp (safearray-value d2bp)
              d2up (safearray-value d2up)
              d2bp0 (car d2out_box)
              d2up0 (cadr d2out_box))
        (if (and (and (< (car d2bp) (car d2bp0))
                      (< (cadr d2bp) (cadr d2bp0)))
                 (and (> (car d2up) (car d2up0))
                      (> (cadr d2up) (cadr d2up0)))
            )
          (setq d2outpl d22
                d2out_box (list d2bp d2up))
        )
      )
    )
    (setq i (+ i 1))
  );while d2 end
  d2out_box
);defun

(defun c:tt (/           p1         p2    s1    s2           s3         s4    s5    s6
             s7           s8         s9    s10   s11   s12         s13   box1  box2
             box3  box4         box5  box6  box7  box8         box9  box10 box11
             box12 box13
            )
  (if (setq tk (entsel "\nPick TK: "))
    (progn
      (setq oldos (getvar "osmode"))
      (setvar "osmode" 0)
      (setvar "cmdecho" 0)
      (setq obj (vlax-ename->vla-object (car tk)))
      (vla-getboundingbox obj 'tk_bp 'tk_up);_ 求对角点
      (setq tk_bp (safearray-value tk_bp);_ 转换
            tk_up (safearray-value tk_up);_ 转换
      );_注意UCS
      (setq midp (polar tk_bp (angle tk_bp tk_up) (/ (distance tk_bp tk_up) 2))) ;_图框中心
      ;;测试 Box 是否在屏幕内，不在则缩放并记录最后恢复
      (command ".zoom" "o" tk "") ;_ 2005以上功能, 缩放实体至适合屏幕
      ;;(command ".zoom" "w" tk_bp tk_up);_
    (progn
      (setq d1        (ssget "w" tk_bp tk_up '((8 . "D01A")))
            d2        (ssget "w" tk_bp tk_up '((8 . "D02A")))
            d3        (ssget "w" tk_bp tk_up '((8 . "D03A")))
            d4        (ssget "w" tk_bp tk_up '((8 . "D04A")))
            d5        (ssget "w" tk_bp tk_up '((8 . "D05A")))
            d5B        (ssget "w" tk_bp tk_up '((8 . "D05B")))
            s1        (ssget "w" tk_bp tk_up '((8 . "S01A")))
            s1b        (ssget "w" tk_bp tk_up '((8 . "S01B")))
            s2        (ssget "w" tk_bp tk_up '((8 . "S02A")))
            p5        (ssget "w" tk_bp tk_up '((8 . "P05A")))
            p4        (ssget "w" tk_bp tk_up '((8 . "P04A")))
            p3        (ssget "w" tk_bp tk_up '((8 . "P03A")))
            p2        (ssget "w" tk_bp tk_up '((8 . "P02A")))
            p1        (ssget "w" tk_bp tk_up '((8 . "P01A")))
      )
      (setq box1  (getssoutpl d1)
            box2  (getssoutpl d2)
            box3  (getssoutpl d3)
            box4  (getssoutpl d4)
            box5  (getssoutpl d5)
            box6  (getssoutpl d5b)
            box7  (getssoutpl s1)
            box8  (getssoutpl s1b)
            box9  (getssoutpl s2)
            box10 (getssoutpl p5)
            box11 (getssoutpl p4)
            box12 (getssoutpl p3)
            box13 (getssoutpl p2)
            box13 (getssoutpl p1)
      (princ box1)
      )
    )
  )
)
)

eachy

你的程序起码的括号都不匹配，getssoutpl 也不对，再仔细看看我写的

2. 
   
3. (defun c:tt (/           p1         p2    s1    s2           s3         s4    s5    s6
   
4.              s7           s8         s9    s10   s11   s12         s13   box1  box2
   
5.              box3  box4         box5  box6  box7  box8         box9  box10 box11
   
6.              box12 box13 oldos getssoutpl
   
7.             )
   
8.   (defun getssoutpl (ss / ssl e outpl out_box bp up bp0 up0)
   
9.     (if        ss
   
10.       (progn
    
11.         (setq ssl (sslength ss))
    
12.         (while (> ssl 0)
    
13.           (setq e (ssname ss (setq ssl (1- ssl))))
    
14.           (vla-getboundingbox (vlax-ename->vla-object e) 'bp 'up)
    
15.           (if (not outpl)
    
16.             (setq outpl          e
    
17.                   out_box (list (safearray-value bp) (safearray-value up))
    
18.             )
    
19.             (progn
    
20.               (vla-getboundingbox (vlax-ename->vla-object e) 'bp 'up)
    
21.               (setq bp        (safearray-value bp)
    
22.                     up        (safearray-value up)
    
23.                     bp0        (car out_box)
    
24.                     up0        (cadr out_box)
    
25.               )
    
26.               (if (and (and (< (car bp) (car bp0))
    
27.                             (< (cadr bp) (cadr bp0))
    
28.                        )
    
29.                        (and (> (car up) (car up0))
    
30.                             (> (cadr up) (cadr up0))
    
31.                        )
    
32.                   )
    
33.                 (setq outpl   e
    
34.                       out_box (list bp up)
    
35.                 )
    
36.               )
    
37.             )
    
38.           )
    
39.         )
    
40.       )
    
41.     )
    
42.     out_box
    
43.   )
    
44.   (if (setq tk (entsel "\nPick TK: "))
    
45.     (progn
    
46.       (setq oldos (getvar "osmode"))
    
47.       (setvar "osmode" 0)
    
48.       (setvar "cmdecho" 0)
    
49.       (setq obj (vlax-ename->vla-object (car tk)))
    
50.       (vla-getboundingbox obj 'tk_bp 'tk_up) ;_ 求对角点
    
51.       (setq tk_bp (safearray-value tk_bp) ;_ 转换
    
52.             tk_up (safearray-value tk_up) ;_ 转换
    
53.       ) ;_注意UCS
    
54.       (setq midp (polar        tk_bp
    
55.                         (angle tk_bp tk_up)
    
56.                         (/ (distance tk_bp tk_up) 2)
    
57.                  )
    
58.       ) ;_图框中心
    
59.       ;;测试 Box 是否在屏幕内，不在则缩放并记录最后恢复
    
60.       (command ".zoom" "o" tk "") ;_ 2005以上功能, 缩放实体至适合屏幕
    
61.       (setq oldos (getvar "osmode"))
    
62.       (setvar "osmode" 0)
    
63.       (setvar "cmdecho" 0)
    
64.       ;;(command ".zoom" "w" tk_bp tk_up);_
    
65.       (setq d1        (ssget "w" tk_bp tk_up '((8 . "D01A")))
    
66.             d2        (ssget "w" tk_bp tk_up '((8 . "D02A")))
    
67.             d3        (ssget "w" tk_bp tk_up '((8 . "D03A")))
    
68.             d4        (ssget "w" tk_bp tk_up '((8 . "D04A")))
    
69.             d5        (ssget "w" tk_bp tk_up '((8 . "D05A")))
    
70.             d5B        (ssget "w" tk_bp tk_up '((8 . "D05B")))
    
71.             s1        (ssget "w" tk_bp tk_up '((8 . "S01A")))
    
72.             s1b        (ssget "w" tk_bp tk_up '((8 . "S01B")))
    
73.             s2        (ssget "w" tk_bp tk_up '((8 . "S02A")))
    
74.             p5        (ssget "w" tk_bp tk_up '((8 . "P05A")))
    
75.             p4        (ssget "w" tk_bp tk_up '((8 . "P04A")))
    
76.             p3        (ssget "w" tk_bp tk_up '((8 . "P03A")))
    
77.             p2        (ssget "w" tk_bp tk_up '((8 . "P02A")))
    
78.             p1        (ssget "w" tk_bp tk_up '((8 . "P01A")))
    
79.       )
    
80.       (setq box1  (getssoutpl d1)
    
81.             box2  (getssoutpl d2)
    
82.             box3  (getssoutpl d3)
    
83.             box4  (getssoutpl d4)
    
84.             box5  (getssoutpl d5)
    
85.             box6  (getssoutpl d5b)
    
86.             box7  (getssoutpl s1)
    
87.             box8  (getssoutpl s1b)
    
88.             box9  (getssoutpl s2)
    
89.             box10 (getssoutpl p5)
    
90.             box11 (getssoutpl p4)
    
91.             box12 (getssoutpl p3)
    
92.             box13 (getssoutpl p2)
    
93.             box13 (getssoutpl p1)
    
94.       )
    
95.       ;;测试对角点
    
96.       (mapcar '(lambda (a)
    
97.                  (if a
    
98.                    (command ".line" (car a) (cadr a))
    
99.                  )
    
100.                )
     
101.               (list box1 box2 box3 box4        box5 box6 box7 box8 box9 box10
     
102.                     box11 box12        box13)
     
103.       )
     
104.       ;;后面是你自己的处理程序
     
105.       (setvar "osmode" oldos)
     
106.     )
     
107.   )
     
108.   (princ)
     
109. )
     

<br /> (defun c:tt (/           p1         p2    s1    s2           s3         s4    s5    s6<br />              s7           s8         s9    s10   s11   s12         s13   box1  box2<br />              box3  box4         box5  box6  box7  box8         box9  box10 box11<br />              box12 box13 oldos getssoutpl<br />             )<br />   (defun getssoutpl (ss / ssl e outpl out_box bp up bp0 up0)<br />     (if        ss<br />       (progn<br />         (setq ssl (sslength ss))<br />         (while (> ssl 0)<br />           (setq e (ssname ss (setq ssl (1- ssl))))<br />           (vla-getboundingbox (vlax-ename->vla-object e) 'bp 'up)<br />           (if (not outpl)<br />             (setq outpl          e<br />                   out_box (list (safearray-value bp) (safearray-value up))<br />             )<br />             (progn<br />               (vla-getboundingbox (vlax-ename->vla-object e) 'bp 'up)<br />               (setq bp        (safearray-value bp)<br />                     up        (safearray-value up)<br />                     bp0        (car out_box)<br />                     up0        (cadr out_box)<br />               )<br />               (if (and (and (< (car bp) (car bp0))<br />                             (< (cadr bp) (cadr bp0))<br />                        )<br />                        (and (> (car up) (car up0))<br />                             (> (cadr up) (cadr up0))<br />                        )<br />                   )<br />                 (setq outpl   e<br />                       out_box (list bp up)<br />                 )<br />               )<br />             )<br />           )<br />         )<br />       )<br />     )<br />     out_box<br />   )<br />   (if (setq tk (entsel "\nPick TK: "))<br />     (progn<br />       (setq oldos (getvar "osmode"))<br />       (setvar "osmode" 0)<br />       (setvar "cmdecho" 0)<br />       (setq obj (vlax-ename->vla-object (car tk)))<br />       (vla-getboundingbox obj 'tk_bp 'tk_up) ;_ 求对角点<br />       (setq tk_bp (safearray-value tk_bp) ;_ 转换<br />             tk_up (safearray-value tk_up) ;_ 转换<br />       ) ;_注意UCS<br />       (setq midp (polar        tk_bp<br />                         (angle tk_bp tk_up)<br />                         (/ (distance tk_bp tk_up) 2)<br />                  )<br />       ) ;_图框中心<br />       ;;测试 Box 是否在屏幕内，不在则缩放并记录最后恢复<br />       (command ".zoom" "o" tk "") ;_ 2005以上功能, 缩放实体至适合屏幕<br />       (setq oldos (getvar "osmode"))<br />       (setvar "osmode" 0)<br />       (setvar "cmdecho" 0)<br />       ;;(command ".zoom" "w" tk_bp tk_up);_ <br />       (setq d1        (ssget "w" tk_bp tk_up '((8 . "D01A")))<br />             d2        (ssget "w" tk_bp tk_up '((8 . "D02A")))<br />             d3        (ssget "w" tk_bp tk_up '((8 . "D03A")))<br />             d4        (ssget "w" tk_bp tk_up '((8 . "D04A")))<br />             d5        (ssget "w" tk_bp tk_up '((8 . "D05A")))<br />             d5B        (ssget "w" tk_bp tk_up '((8 . "D05B")))<br />             s1        (ssget "w" tk_bp tk_up '((8 . "S01A")))<br />             s1b        (ssget "w" tk_bp tk_up '((8 . "S01B")))<br />             s2        (ssget "w" tk_bp tk_up '((8 . "S02A")))<br />             p5        (ssget "w" tk_bp tk_up '((8 . "P05A")))<br />             p4        (ssget "w" tk_bp tk_up '((8 . "P04A")))<br />             p3        (ssget "w" tk_bp tk_up '((8 . "P03A")))<br />             p2        (ssget "w" tk_bp tk_up '((8 . "P02A")))<br />             p1        (ssget "w" tk_bp tk_up '((8 . "P01A")))<br />       )<br />       (setq box1  (getssoutpl d1)<br />             box2  (getssoutpl d2)<br />             box3  (getssoutpl d3)<br />             box4  (getssoutpl d4)<br />             box5  (getssoutpl d5)<br />             box6  (getssoutpl d5b)<br />             box7  (getssoutpl s1)<br />             box8  (getssoutpl s1b)<br />             box9  (getssoutpl s2)<br />             box10 (getssoutpl p5)<br />             box11 (getssoutpl p4)<br />             box12 (getssoutpl p3)<br />             box13 (getssoutpl p2)<br />             box13 (getssoutpl p1)<br />       )<br />       ;;测试对角点<br />       (mapcar '(lambda (a)<br />                  (if a<br />                    (command ".line" (car a) (cadr a))<br />                  )<br />                )<br />               (list box1 box2 box3 box4        box5 box6 box7 box8 box9 box10<br />                     box11 box12        box13)<br />       )<br />       ;;后面是你自己的处理程序<br />       (setvar "osmode" oldos)<br />     )<br />   )<br />   (princ)<br /> )<br />

狂刀

再给个思路
在单个ｂｏｘ的基础上求选集ｓｓ的ｂｏｘ
如：　(getssbox ss)
(getssbox (ssget "c" p1 p2 '((8 . "P*A"))))