批选矩形，在上面一条边中点加入文字，有点小问题未完成请高手赐教

zhb236623

2. 
   
3. 
   
4. 
   
5. 
   
6. 
   
7. (defun c:za()
   
8. (VL-LOAD-COM)
   
9. (setq oldcmd (getvar "cmdecho"))
   
10. (setvar "cmdecho" 0)
    
11. (setq oldblip (getvar "blipmode"))
    
12. (setvar "blipmode" 0)
    
13. (setq oldsnap (getvar "osmode"))
    
14. (setvar "osmode" 0)
    
15. (if (not (setq n1 (getint "\n请输入尾数起始顺序号 <1>: ")))
    
16.     (setq n1 1)
    
17. )
    
18. 
    
19. (if (= (tblobjname "layer" "zhb地号图层") nil)
    
20. (progn
    
21.   (princ "图层zhb地号图层不存在，新建图层zhb地号图层完成，导入数据将存放在zhb地号图层")
    
22.   (command ".-layer" "n" "zhb地号图层" "s" "zhb地号图层"  "c" "红色" "" "")
    
23.   
    
24. )
    
25. (progn
    
26. (command ".-layer" "s" "zhb地号图层" "c" "红色" "" "")
    
27.   (princ "zhb地号图层已存在，导入数据将存放在zhb地号图层，完成导入")
    
28. )
    
29. )
    
30. 
    
31. (command ".style" "仿宋体" "仿宋_GB2312" 0.6 1 0 "" "")
    
32. 
    
33. (setq slist nil)
    
34. (setq i 0)
    
35. (setq ss (ssget '((0 . "LWPOLYLINE"))))
    
36. ;; 求矩形上面一条边的中点坐标
    
37. (repeat (sslength ss)
    
38. (setq en (ssname ss i))
    
39. ;(setq en (entget ssn))
    
40. (vla-getboundingbox (vlax-ename->vla-object en) 'minpoint 'maxpoint)
    
41. (setq pmax (vlax-safearray->list maxpoint)
    
42.         pmin (vlax-safearray->list minpoint)
    
43.   )
    
44. (setq xmin (car pmin))
    
45. (setq xmax (car pmax))
    
46. (setq ymin (cadr pmin))
    
47. (setq ymax (cadr pmax))
    
48. (setq xmid ( / ( + xmin xmax) 2))
    
49. ;;(setq ymid ( / ( + ymin ymax) 2))
    
50. (setq xmid_ymax (list xmid ymax))
    
51. (setq slist  (cons xmid_ymax slist))
    
52. (setq i (1+ i))
    
53. )
    
54. (setq tmp_slist (vl-sort slist '(lambda(x1 x2)(< (car x1) (car x2)))));表按x从小到大排序
    
55. ;(setq last_slist (vl-sort tmp_slist '(lambda(x1 x2)(> (cadr x1) (cadr x2)))));表按y从大到小排序
    
56. ;;这里有问题，不知道要怎么写。
    
57. (foreach insertp_mid tmp_slist
    
58. 
    
59. (setq insertp_move (pmove insertp_mid 0 -2))
    
60. (setq wz (strcat  "3-50-411-" (itoa n1)))
    
61. (command ".text" "j" "mc" insertp_move 0  wz)
    
62. ;(command ".text" "j" "mc" insertp_move 0.6 0  wz)
    
63. (setq n1   (+ n1 1))
    
64. )
    
65. (setvar "cmdecho" oldcmd)
    
66. (setvar "blipmode" oldblip)
    
67. (setvar "osmode" oldsnap)
    
68. (princ)
    
69. )
    
70. 
    
71. 
    
72. (defun pmove(point_xy px py);点位，X Y Z
    
73.     (setq point_x(car point_xy))
    
74.     (setq point_y(cadr point_xy))
    
75.     (list (+ point_x  px)(+ point_y py))
    
76. )

<br /> <br /> <br /> <br /> <br /> (defun c:za()<br /> (VL-LOAD-COM)<br /> (setq oldcmd (getvar "cmdecho")) <br /> (setvar "cmdecho" 0) <br /> (setq oldblip (getvar "blipmode")) <br /> (setvar "blipmode" 0) <br /> (setq oldsnap (getvar "osmode")) <br /> (setvar "osmode" 0) <br /> (if (not (setq n1 (getint "\n请输入尾数起始顺序号 <1>: ")))<br />     (setq n1 1)<br /> )<br /> <br /> (if (= (tblobjname "layer" "zhb地号图层") nil)<br /> (progn<br />   (princ "图层zhb地号图层不存在，新建图层zhb地号图层完成，导入数据将存放在zhb地号图层")<br />   (command ".-layer" "n" "zhb地号图层" "s" "zhb地号图层"  "c" "红色" "" "")<br />   <br /> )<br /> (progn<br /> (command ".-layer" "s" "zhb地号图层" "c" "红色" "" "")<br />   (princ "zhb地号图层已存在，导入数据将存放在zhb地号图层，完成导入")<br /> )<br /> )<br /> <br /> (command ".style" "仿宋体" "仿宋_GB2312" 0.6 1 0 "" "")<br /> <br /> (setq slist nil)<br /> (setq i 0)<br /> (setq ss (ssget '((0 . "LWPOLYLINE"))))<br /> ;; 求矩形上面一条边的中点坐标 <br /> (repeat (sslength ss)<br /> (setq en (ssname ss i))<br /> ;(setq en (entget ssn))<br /> (vla-getboundingbox (vlax-ename->vla-object en) 'minpoint 'maxpoint)<br /> (setq pmax (vlax-safearray->list maxpoint)<br />         pmin (vlax-safearray->list minpoint)<br />   )<br /> (setq xmin (car pmin))<br /> (setq xmax (car pmax)) <br /> (setq ymin (cadr pmin))<br /> (setq ymax (cadr pmax))<br /> (setq xmid ( / ( + xmin xmax) 2))<br /> ;;(setq ymid ( / ( + ymin ymax) 2))<br /> (setq xmid_ymax (list xmid ymax))<br /> (setq slist  (cons xmid_ymax slist))<br /> (setq i (1+ i))<br /> )<br /> (setq tmp_slist (vl-sort slist '(lambda(x1 x2)(< (car x1) (car x2)))));表按x从小到大排序<br /> ;(setq last_slist (vl-sort tmp_slist '(lambda(x1 x2)(> (cadr x1) (cadr x2)))));表按y从大到小排序<br /> ;;这里有问题，不知道要怎么写。<br /> (foreach insertp_mid tmp_slist<br /> <br /> (setq insertp_move (pmove insertp_mid 0 -2))<br /> (setq wz (strcat  "3-50-411-" (itoa n1)))<br /> (command ".text" "j" "mc" insertp_move 0  wz)<br /> ;(command ".text" "j" "mc" insertp_move 0.6 0  wz)<br /> (setq n1   (+ n1 1))<br /> )<br /> (setvar "cmdecho" oldcmd) <br /> (setvar "blipmode" oldblip) <br /> (setvar "osmode" oldsnap)<br /> (princ)<br /> )<br /> <br /> <br /> (defun pmove(point_xy px py);点位，X Y Z<br />     (setq point_x(car point_xy))<br />     (setq point_y(cadr point_xy))<br />     (list (+ point_x  px)(+ point_y py))<br /> )

其实作业中同一行的矩形没有上下差别那么大，只上下波动很小的距离。这里有点夸大。想要的效果如图中所示。程序不能实现，望高手指教。如果实在不行，我可以按一行选，只要对X坐标进行排序就可以了。一行一行加。

Andyhon

一个 ZigZag 排序
sorting a list of coordinates:
http://forums.autodesk.com/t5/Vi ... dinates/td-p/904181

zhynt

2. 
   
3. ;;;;取得点集行数，将每行的y坐标列表，lst为点坐标表，rc为容差
   
4. (defun y_lst (lst rc / it lst2)
   
5.   (while (setq lst2 (cons (setq it (cadr (car lst))) lst2)
   
6.                lst  (vl-remove-if '(lambda (x) (equal it (cadr x) rc)) lst)
   
7.          )
   
8.   )
   
9.   (vl-sort lst2 (function (lambda (e1 e2) (> e1 e2))))
   
10. )
    
11. ;;;将点集按从上到下，从左到右的顺序排序。pt_lst为点坐标表，rc为容差
    
12. (defun zhy_sort_pt (pt_lst rc /        pt_y lst1 pt_lst_new n1        n2 m1 m2 pt_y_a        pt_lst_a lst2)
    
13.   (setq pt_y (y_lst pt_lst rc))
    
14.   (setq pt_lst_new '())
    
15.   (setq lst1 '())
    
16.   (setq m1 0)
    
17.   (setq n1 (length pt_y))
    
18.   (setq n2 (length pt_lst))
    
19.   (while (/= m1 n1)
    
20.     (setq pt_y_a (nth m1 pt_y))
    
21.     (setq m2 0)
    
22.     (while (/= m2 n2)
    
23.       (setq pt_lst_a (nth m2 pt_lst))
    
24.       (if (equal pt_y_a (cadr pt_lst_a) rc)
    
25.         (setq lst1 (cons pt_lst_a lst1))
    
26.       )
    
27.       (setq m2 (1+ m2))
    
28.     )
    
29.     (if        (/= (length lst1) 1)
    
30.       (setq lst1 (vl-sort lst1
    
31.                           (function (lambda (e1 e2) (< (car e1) (car e2))))
    
32.                  )
    
33.       )
    
34.     )
    
35.     (setq pt_lst_new (cons lst1 pt_lst_new))
    
36.     (setq lst1 '())
    
37.     (setq m1 (1+ m1))
    
38.   )
    
39.   (setq pt_lst_new (reverse pt_lst_new))
    
40.   (setq n1 (length pt_lst_new))
    
41.   (setq m1 0)
    
42.   (setq lst2 '())
    
43.   (while (/= m1 n1)
    
44.     (setq lst1 (nth m1 pt_lst_new))
    
45.     (setq n2 (length lst1))
    
46.     (setq m2 0)
    
47.     (while (/= m2 n2)
    
48.       (setq lst (nth m2 lst1))
    
49.       (setq lst2 (cons lst lst2))
    
50.       (setq m2 (1+ m2))
    
51.     )
    
52.     (setq m1 (1+ m1))
    
53.   )
    
54.   (reverse lst2)
    
55. )
    
56. 
    
57. (defun c:zzaa ()
    
58.   (VL-LOAD-COM)
    
59.   (setq oldcmd (getvar "cmdecho"))
    
60.   (setvar "cmdecho" 0)
    
61.   (setq oldblip (getvar "blipmode"))
    
62.   (setvar "blipmode" 0)
    
63.   (setq oldsnap (getvar "osmode"))
    
64.   (setvar "osmode" 0)
    
65.   (if (not (setq n1 (getint "\n请输入尾数起始顺序号 <1>: ")))
    
66.     (setq n1 1)
    
67.   )
    
68.   (if (= (tblobjname "layer" "zhb地号图层") nil)
    
69.     (progn (princ
    
70.              "图层zhb地号图层不存在，新建图层zhb地号图层完成，导入数据将存放在zhb地号图层"
    
71.            )
    
72.            (command ".-layer" "n" "zhb地号图层"        "s" "zhb地号图层" "c" 1        "" ""
    
73.                    )
    
74.     )
    
75.     (progn (command ".-layer" "s" "zhb地号图层" "c" 1 "" "")
    
76.            (princ
    
77.              "zhb地号图层已存在，导入数据将存放在zhb地号图层，完成导入"
    
78.            )
    
79.     )
    
80.   )
    
81. 
    
82.   
    
83. ;;;系统的问题我的机子中没有“仿宋_GB2312”字体所以我改了，你可以再改回来
    
84. ;;;(command ".style" "仿宋体" "仿宋_GB2312" 0.6 1 0 "" "")
    
85.   
    
86.   (command ".style" "仿宋体" "仿宋" 600 1 0 "" "")
    
87. 
    
88. 
    
89.   
    
90.   (setq slist nil)
    
91.   (setq i 0)
    
92.   (setq ss (ssget '((0 . "LWPOLYLINE"))))
    
93.   ;; 求矩形上面一条边的中点坐标
    
94.   (repeat (sslength ss)
    
95.     (setq en (ssname ss i))                                    ;(setq en (entget ssn))
    
96.     (vla-getboundingbox        (vlax-ename->vla-object en)
    
97.                         'minpoint
    
98.                         'maxpoint
    
99.     )
    
100.     (setq pmax (vlax-safearray->list maxpoint)
     
101.           pmin (vlax-safearray->list minpoint)
     
102.     )
     
103.     (setq xmin (car pmin))
     
104.     (setq xmax (car pmax))
     
105.     (setq ymin (cadr pmin))
     
106.     (setq ymax (cadr pmax))
     
107.     (setq xmid (/ (+ xmin xmax) 2))
     
108.     ;;(setq ymid ( / ( + ymin ymax) 2))
     
109.     (setq xmid_ymax (list xmid ymax))
     
110.     (setq slist (cons xmid_ymax slist))
     
111.     (setq i (1+ i))
     
112.   )  
     
113. ;;;关键就是这里了，排序，1e-6为容差，意思是1乘以10的负6次方。你可以自己改  
     
114. (setq tmp_slist (zhy_sort_pt slist 1e-6))
     
115.   
     
116.   (foreach insertp_mid tmp_slist
     
117.     (setq insertp_move (pmove insertp_mid 0 -2))
     
118.     (setq wz (strcat "3-50-411-" (itoa n1)))
     
119.     (command ".text" "j" "mc" insertp_move 0 wz)            ;(command ".text" "j" "mc" insertp_move 0.6 0  wz)
     
120.     (setq n1 (+ n1 1))
     
121.   )
     
122.   (setvar "cmdecho" oldcmd)
     
123.   (setvar "blipmode" oldblip)
     
124.   (setvar "osmode" oldsnap)
     
125.   (princ)
     
126. )
     
127. 
     
128. (defun pmove (point_xy px py)                                    ;点位，X Y Z
     
129.   (setq point_x (car point_xy))
     
130.   (setq point_y (cadr point_xy))
     
131.   (list (+ point_x px) (+ point_y py))
     
132. )
     

<br /> ;;;;取得点集行数，将每行的y坐标列表，lst为点坐标表，rc为容差<br /> (defun y_lst (lst rc / it lst2)<br />   (while (setq lst2 (cons (setq it (cadr (car lst))) lst2)<br />                lst  (vl-remove-if '(lambda (x) (equal it (cadr x) rc)) lst)<br />          )<br />   )<br />   (vl-sort lst2 (function (lambda (e1 e2) (> e1 e2))))<br /> )<br /> ;;;将点集按从上到下，从左到右的顺序排序。pt_lst为点坐标表，rc为容差<br /> (defun zhy_sort_pt (pt_lst rc /        pt_y lst1 pt_lst_new n1        n2 m1 m2 pt_y_a        pt_lst_a lst2)<br />   (setq pt_y (y_lst pt_lst rc))<br />   (setq pt_lst_new '())<br />   (setq lst1 '())<br />   (setq m1 0)<br />   (setq n1 (length pt_y))<br />   (setq n2 (length pt_lst))<br />   (while (/= m1 n1)<br />     (setq pt_y_a (nth m1 pt_y))<br />     (setq m2 0)<br />     (while (/= m2 n2)<br />       (setq pt_lst_a (nth m2 pt_lst))<br />       (if (equal pt_y_a (cadr pt_lst_a) rc)<br />         (setq lst1 (cons pt_lst_a lst1))<br />       )<br />       (setq m2 (1+ m2))<br />     )<br />     (if        (/= (length lst1) 1)<br />       (setq lst1 (vl-sort lst1<br />                           (function (lambda (e1 e2) (< (car e1) (car e2))))<br />                  )<br />       )<br />     )<br />     (setq pt_lst_new (cons lst1 pt_lst_new))<br />     (setq lst1 '())<br />     (setq m1 (1+ m1))<br />   )<br />   (setq pt_lst_new (reverse pt_lst_new))<br />   (setq n1 (length pt_lst_new))<br />   (setq m1 0)<br />   (setq lst2 '())<br />   (while (/= m1 n1)<br />     (setq lst1 (nth m1 pt_lst_new))<br />     (setq n2 (length lst1))<br />     (setq m2 0)<br />     (while (/= m2 n2)<br />       (setq lst (nth m2 lst1))<br />       (setq lst2 (cons lst lst2))<br />       (setq m2 (1+ m2))<br />     )<br />     (setq m1 (1+ m1))<br />   )<br />   (reverse lst2)<br /> )<br /> <br /> (defun c:zzaa ()<br />   (VL-LOAD-COM)<br />   (setq oldcmd (getvar "cmdecho"))<br />   (setvar "cmdecho" 0)<br />   (setq oldblip (getvar "blipmode"))<br />   (setvar "blipmode" 0)<br />   (setq oldsnap (getvar "osmode"))<br />   (setvar "osmode" 0)<br />   (if (not (setq n1 (getint "\n请输入尾数起始顺序号 <1>: ")))<br />     (setq n1 1)<br />   )<br />   (if (= (tblobjname "layer" "zhb地号图层") nil)<br />     (progn (princ<br />              "图层zhb地号图层不存在，新建图层zhb地号图层完成，导入数据将存放在zhb地号图层"<br />            )<br />            (command ".-layer" "n" "zhb地号图层"        "s" "zhb地号图层" "c" 1        "" ""<br />                    )<br />     )<br />     (progn (command ".-layer" "s" "zhb地号图层" "c" 1 "" "")<br />            (princ<br />              "zhb地号图层已存在，导入数据将存放在zhb地号图层，完成导入"<br />            )<br />     )<br />   )<br /> <br />   <br /> ;;;系统的问题我的机子中没有“仿宋_GB2312”字体所以我改了，你可以再改回来<br /> ;;;(command ".style" "仿宋体" "仿宋_GB2312" 0.6 1 0 "" "")<br />   <br />   (command ".style" "仿宋体" "仿宋" 600 1 0 "" "")<br /> <br /> <br />   <br />   (setq slist nil)<br />   (setq i 0)<br />   (setq ss (ssget '((0 . "LWPOLYLINE"))))<br />   ;; 求矩形上面一条边的中点坐标 <br />   (repeat (sslength ss)<br />     (setq en (ssname ss i))                                    ;(setq en (entget ssn))<br />     (vla-getboundingbox        (vlax-ename->vla-object en)<br />                         'minpoint<br />                         'maxpoint<br />     )<br />     (setq pmax (vlax-safearray->list maxpoint)<br />           pmin (vlax-safearray->list minpoint)<br />     )<br />     (setq xmin (car pmin))<br />     (setq xmax (car pmax))<br />     (setq ymin (cadr pmin))<br />     (setq ymax (cadr pmax))<br />     (setq xmid (/ (+ xmin xmax) 2))<br />     ;;(setq ymid ( / ( + ymin ymax) 2))<br />     (setq xmid_ymax (list xmid ymax))<br />     (setq slist (cons xmid_ymax slist))<br />     (setq i (1+ i))<br />   )  <br /> ;;;关键就是这里了，排序，1e-6为容差，意思是1乘以10的负6次方。你可以自己改  <br /> (setq tmp_slist (zhy_sort_pt slist 1e-6))<br />   <br />   (foreach insertp_mid tmp_slist<br />     (setq insertp_move (pmove insertp_mid 0 -2))<br />     (setq wz (strcat "3-50-411-" (itoa n1)))<br />     (command ".text" "j" "mc" insertp_move 0 wz)            ;(command ".text" "j" "mc" insertp_move 0.6 0  wz)<br />     (setq n1 (+ n1 1))<br />   )<br />   (setvar "cmdecho" oldcmd)<br />   (setvar "blipmode" oldblip)<br />   (setvar "osmode" oldsnap)<br />   (princ)<br /> )<br /> <br /> (defun pmove (point_xy px py)                                    ;点位，X Y Z<br />   (setq point_x (car point_xy))<br />   (setq point_y (cadr point_xy))<br />   (list (+ point_x px) (+ point_y py))<br /> )<br />

zhb236623

谢谢Andyhon ，看了半天，对我有点难度；zhynt 高人啊。设置好容差，程序能够达到要求，很不错。

xx8202

这个怎么把坐标点输出到excel中