一对文字加外围方框 73哥函数

树櫴希德

2. (defun get_inpoint (blockname)
   
3.   (setq in_point(cdr (assoc 10 (entget blockname))))
   
4.   in_point
   
5. )
   
6. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   
7. (defun get_inpointname (blockname)
   
8.   (setq in_point(cdr(car(entget blockname))))
   
9.   in_point
   
10. )
    
11. 
    
12. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
13. (defun testlsp(lst / a b d l)
    
14.   (setq lst(vl-sort lst'(lambda(x y)(and(<(car (get_inpoint x))(car (get_inpoint y)))(<(cadr (get_inpoint x))(cadr (get_inpoint y))))))
    
15. d(distance(get_inpoint(car lst))(get_inpoint(cadr lst))))
    
16.   (while lst
    
17.     (if(setq a(car lst)
    
18.      b(vl-remove-if'(lambda(x)(>(distance (get_inpoint x) ( get_inpoint a))d))(cdr lst)))
    
19.       (setq b(cons a b)
    
20.     l(cons b l)
    
21.     lst(repeat(length b)
    
22. (setq a(car b)
    
23.        b(cdr b)
    
24.        lst(vl-remove a lst))))
    
25.       (setq lst(cdr lst))))
    
26.   l)
    
27. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
28. (defun testlsp11(lst / a b d l)
    
29.   (setq lst(vl-sort lst'(lambda(x y)(and(<(car (get_inpoint x))(car (get_inpoint y)))(<(cadr (get_inpoint x))(cadr (get_inpoint y))))))
    
30. d(distance(get_inpoint(car lst))(get_inpoint(cadr lst))))
    
31.   (while lst
    
32.     (if(setq a(car lst)
    
33.      b(vl-remove-if'(lambda(x)(>(distance (get_inpoint x) ( get_inpoint a))d))(cdr lst)))
    
34.       (setq l(cons(cons a b)l)
    
35.     lst(vl-remove-if'(lambda(x)(member x b))lst))
    
36.       (setq lst(cdr lst))))
    
37.   l)
    
38. 
    
39. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
40. (defun c:wzjfk ( / ss i lst e insert_name ptlst biao1 ii ptt ptt1)
    
41. (setq ss (ssget '((0 . "text")))   )
    
42. 
    
43. (setq i 0)
    
44. (setq lst '())
    
45. (repeat (sslength ss)
    
46. (setq insert_name (ssname ss i))
    
47. (setq e(get_inpointname insert_name))
    
48.   (setq lst (append lst (list e)))
    
49. (setq i (1+ i))
    
50. 
    
51. 
    
52.   )
    
53. 
    
54. ;(setq dist (distance (getpoint "\n请选择起点") (getpoint "\n请选择终点")  ))
    
55. 
    
56. ;(setq ptlst (vl-sort lst
    
57.                    ;以下根据坐标差对表排序
    
58.    ;'(lambda (e1 e2)
    
59.          ; (and   (< (car (get_inpoint e1)) (car (get_inpoint e2)) )
    
60.          ; (< (cadr (get_inpoint e1)) (cadr (get_inpoint e2)) ) (= (distance (get_inpoint e1) (get_inpoint e2) ) ) )
    
61.        ; )   )    )
    
62. 
    
63. (setq ptlst(testlsp lst))
    
64. 
    
65. (setq biao '())
    
66. (setq ii 0)
    
67. (repeat (/ (length ptlst) 2)
    
68. 
    
69. (setq lst2 (append (list(nth ii ptlst))  (list(nth (1+ ii) ptlst) ) ) )
    
70. 
    
71. (setq biao (append (list lst2)  biao))
    
72. (setq ii (+ ii 2))
    
73.   
    
74.   )
    
75. 
    
76. (mapcar  '(lambda(x)
    
77. (foreach n x
    
78. 
    
79. (if (< (cadr(get_inpoint (car n)))  (cadr(get_inpoint (cadr n)))
    
80.           )
    
81. (progn  (setq ptt (mapcar '+  (get_inpoint (car n)) (car(textbox (entget(car n))) )  )  )
    
82.   (setq ptt1 (mapcar '+  (get_inpoint (cadr n)) (cadr(textbox (entget(cadr n))) )  )  )
    
83. 
    
84. (command "rectangle" ptt ptt1)
    
85. 
    
86.   );;;;;;;;;;;;;;;;;;;;;;
    
87. (if (> (cadr(get_inpoint (car n)))  (cadr(get_inpoint (cadr n)))          )
    
88. (progn  (setq ptt (mapcar '+  (get_inpoint (cadr n)) (car(textbox (entget(cadr n))) )  )  )
    
89.   (setq ptt1 (mapcar '+  (get_inpoint (car n)) (cadr(textbox (entget(car n))) )  )  )
    
90. 
    
91. (command "rectangle" ptt ptt1)
    
92. 
    
93.   )
    
94.   )
    
95.   ;;;;;;;;;;;;;;;;;;;;;;;
    
96. 
    
97.   )
    
98. )
    
99.   )
    
100.   biao)
     
101. )

(defun get_inpoint (blockname)<br />   (setq in_point(cdr (assoc 10 (entget blockname))))<br />   in_point<br /> )<br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br /> (defun get_inpointname (blockname)<br />   (setq in_point(cdr(car(entget blockname))))<br />   in_point<br /> )<br /> <br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br /> (defun testlsp(lst / a b d l)<br />   (setq lst(vl-sort lst'(lambda(x y)(and(<(car (get_inpoint x))(car (get_inpoint y)))(<(cadr (get_inpoint x))(cadr (get_inpoint y))))))<br /> d(distance(get_inpoint(car lst))(get_inpoint(cadr lst))))<br />   (while lst<br />     (if(setq a(car lst)<br />      b(vl-remove-if'(lambda(x)(>(distance (get_inpoint x) ( get_inpoint a))d))(cdr lst)))<br />       (setq b(cons a b)<br />     l(cons b l)<br />     lst(repeat(length b)<br /> (setq a(car b)<br />        b(cdr b)<br />        lst(vl-remove a lst))))<br />       (setq lst(cdr lst))))<br />   l)<br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br /> (defun testlsp11(lst / a b d l)<br />   (setq lst(vl-sort lst'(lambda(x y)(and(<(car (get_inpoint x))(car (get_inpoint y)))(<(cadr (get_inpoint x))(cadr (get_inpoint y))))))<br /> d(distance(get_inpoint(car lst))(get_inpoint(cadr lst))))<br />   (while lst<br />     (if(setq a(car lst)<br />      b(vl-remove-if'(lambda(x)(>(distance (get_inpoint x) ( get_inpoint a))d))(cdr lst)))<br />       (setq l(cons(cons a b)l)<br />     lst(vl-remove-if'(lambda(x)(member x b))lst))<br />       (setq lst(cdr lst))))<br />   l)<br /> <br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br /> (defun c:wzjfk ( / ss i lst e insert_name ptlst biao1 ii ptt ptt1)<br /> (setq ss (ssget '((0 . "text")))   )<br /> <br /> (setq i 0)<br /> (setq lst '())<br /> (repeat (sslength ss)<br /> (setq insert_name (ssname ss i))<br /> (setq e(get_inpointname insert_name))<br />   (setq lst (append lst (list e)))<br /> (setq i (1+ i))<br /> <br /> <br />   )<br /> <br /> ;(setq dist (distance (getpoint "\n请选择起点") (getpoint "\n请选择终点")  ))<br /> <br /> ;(setq ptlst (vl-sort lst<br />                    ;以下根据坐标差对表排序<br />    ;'(lambda (e1 e2)<br />          ; (and   (< (car (get_inpoint e1)) (car (get_inpoint e2)) )<br />          ; (< (cadr (get_inpoint e1)) (cadr (get_inpoint e2)) ) (= (distance (get_inpoint e1) (get_inpoint e2) ) ) )<br />        ; )   )    )<br /> <br /> (setq ptlst(testlsp lst))<br /> <br /> (setq biao '())<br /> (setq ii 0)<br /> (repeat (/ (length ptlst) 2)<br /> <br /> (setq lst2 (append (list(nth ii ptlst))  (list(nth (1+ ii) ptlst) ) ) )<br /> <br /> (setq biao (append (list lst2)  biao))<br /> (setq ii (+ ii 2))<br />   <br />   )<br /> <br /> (mapcar  '(lambda(x)<br /> (foreach n x<br /> <br /> (if (< (cadr(get_inpoint (car n)))  (cadr(get_inpoint (cadr n)))<br />           )<br /> (progn  (setq ptt (mapcar '+  (get_inpoint (car n)) (car(textbox (entget(car n))) )  )  )<br />   (setq ptt1 (mapcar '+  (get_inpoint (cadr n)) (cadr(textbox (entget(cadr n))) )  )  )<br /> <br /> (command "rectangle" ptt ptt1)<br /> <br />   );;;;;;;;;;;;;;;;;;;;;;<br /> (if (> (cadr(get_inpoint (car n)))  (cadr(get_inpoint (cadr n)))          )<br /> (progn  (setq ptt (mapcar '+  (get_inpoint (cadr n)) (car(textbox (entget(cadr n))) )  )  )<br />   (setq ptt1 (mapcar '+  (get_inpoint (car n)) (cadr(textbox (entget(car n))) )  )  )<br /> <br /> (command "rectangle" ptt ptt1)<br /> <br />   )<br />   )<br />   ;;;;;;;;;;;;;;;;;;;;;;;<br /> <br />   )<br /> )<br />   )<br />   biao)<br /> )

努.力

谢谢楼主分享好程序