批选矩形，在上面一条边中点加入文字，有点小问题未完成请高手赐教
本帖最后由 zhb236623 于 2011-7-10 22:13 编辑(defun c:za()
(VL-LOAD-COM)
(setq oldcmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq oldblip (getvar "blipmode"))
(setvar "blipmode" 0)
(setq oldsnap (getvar "osmode"))
(setvar "osmode" 0)
(if (not (setq n1 (getint "\n请输入尾数起始顺序号 <1>: ")))
(setq n1 1)
)
(if (= (tblobjname "layer" "zhb地号图层") nil)
(progn
(princ "图层zhb地号图层不存在，新建图层zhb地号图层完成，导入数据将存放在zhb地号图层")
(command ".-layer" "n" "zhb地号图层" "s" "zhb地号图层""c" "红色" "" "")
)
(progn
(command ".-layer" "s" "zhb地号图层" "c" "红色" "" "")
(princ "zhb地号图层已存在，导入数据将存放在zhb地号图层，完成导入")
)
)
(command ".style" "仿宋体" "仿宋_GB2312" 0.6 1 0 "" "")
(setq slist nil)
(setq i 0)
(setq ss (ssget '((0 . "LWPOLYLINE"))))
;; 求矩形上面一条边的中点坐标
(repeat (sslength ss)
(setq en (ssname ss i))
;(setq en (entget ssn))
(vla-getboundingbox (vlax-ename->vla-object en) 'minpoint 'maxpoint)
(setq pmax (vlax-safearray->list maxpoint)
pmin (vlax-safearray->list minpoint)
)
(setq xmin (car pmin))
(setq xmax (car pmax))
(setq ymin (cadr pmin))
(setq ymax (cadr pmax))
(setq xmid ( / ( + xmin xmax) 2))
;;(setq ymid ( / ( + ymin ymax) 2))
(setq xmid_ymax (list xmid ymax))
(setq slist(cons xmid_ymax slist))
(setq i (1+ i))
)
(setq tmp_slist (vl-sort slist '(lambda(x1 x2)(< (car x1) (car x2)))));表按x从小到大排序
;(setq last_slist (vl-sort tmp_slist '(lambda(x1 x2)(> (cadr x1) (cadr x2)))));表按y从大到小排序
;;这里有问题，不知道要怎么写。
(foreach insertp_mid tmp_slist
(setq insertp_move (pmove insertp_mid 0 -2))
(setq wz (strcat"3-50-411-" (itoa n1)))
(command ".text" "j" "mc" insertp_move 0wz)
;(command ".text" "j" "mc" insertp_move 0.6 0wz)
(setq n1 (+ n1 1))
)
(setvar "cmdecho" oldcmd)
(setvar "blipmode" oldblip)
(setvar "osmode" oldsnap)
(princ)
)
(defun pmove(point_xy px py);点位，X Y Z
(setq point_x(car point_xy))
(setq point_y(cadr point_xy))
(list (+ point_xpx)(+ point_y py))
)其实作业中同一行的矩形没有上下差别那么大，只上下波动很小的距离。这里有点夸大。想要的效果如图中所示。程序不能实现，望高手指教。如果实在不行，我可以按一行选，只要对X坐标进行排序就可以了。一行一行加。 一个 ZigZag 排序
sorting a list of coordinates:
http://forums.autodesk.com/t5/Visual-LISP-AutoLISP-and-General/sorting-a-list-of-coordinates/td-p/904181
;;;;取得点集行数，将每行的y坐标列表，lst为点坐标表，rc为容差
(defun y_lst (lst rc / it lst2)
(while (setq lst2 (cons (setq it (cadr (car lst))) lst2)
lst(vl-remove-if '(lambda (x) (equal it (cadr x) rc)) lst)
)
)
(vl-sort lst2 (function (lambda (e1 e2) (> e1 e2))))
)
;;;将点集按从上到下，从左到右的顺序排序。pt_lst为点坐标表，rc为容差
(defun zhy_sort_pt (pt_lst rc / pt_y lst1 pt_lst_new n1 n2 m1 m2 pt_y_a pt_lst_a lst2)
(setq pt_y (y_lst pt_lst rc))
(setq pt_lst_new '())
(setq lst1 '())
(setq m1 0)
(setq n1 (length pt_y))
(setq n2 (length pt_lst))
(while (/= m1 n1)
(setq pt_y_a (nth m1 pt_y))
(setq m2 0)
(while (/= m2 n2)
(setq pt_lst_a (nth m2 pt_lst))
(if (equal pt_y_a (cadr pt_lst_a) rc)
(setq lst1 (cons pt_lst_a lst1))
)
(setq m2 (1+ m2))
)
(if (/= (length lst1) 1)
(setq lst1 (vl-sort lst1
(function (lambda (e1 e2) (< (car e1) (car e2))))
)
)
)
(setq pt_lst_new (cons lst1 pt_lst_new))
(setq lst1 '())
(setq m1 (1+ m1))
)
(setq pt_lst_new (reverse pt_lst_new))
(setq n1 (length pt_lst_new))
(setq m1 0)
(setq lst2 '())
(while (/= m1 n1)
(setq lst1 (nth m1 pt_lst_new))
(setq n2 (length lst1))
(setq m2 0)
(while (/= m2 n2)
(setq lst (nth m2 lst1))
(setq lst2 (cons lst lst2))
(setq m2 (1+ m2))
)
(setq m1 (1+ m1))
)
(reverse lst2)
)
(defun c:zzaa ()
(VL-LOAD-COM)
(setq oldcmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq oldblip (getvar "blipmode"))
(setvar "blipmode" 0)
(setq oldsnap (getvar "osmode"))
(setvar "osmode" 0)
(if (not (setq n1 (getint "\n请输入尾数起始顺序号 <1>: ")))
(setq n1 1)
)
(if (= (tblobjname "layer" "zhb地号图层") nil)
(progn (princ
"图层zhb地号图层不存在，新建图层zhb地号图层完成，导入数据将存放在zhb地号图层"
)
(command ".-layer" "n" "zhb地号图层" "s" "zhb地号图层" "c" 1 "" ""
)
)
(progn (command ".-layer" "s" "zhb地号图层" "c" 1 "" "")
(princ
"zhb地号图层已存在，导入数据将存放在zhb地号图层，完成导入"
)
)
)
;;;系统的问题我的机子中没有“仿宋_GB2312”字体所以我改了，你可以再改回来
;;;(command ".style" "仿宋体" "仿宋_GB2312" 0.6 1 0 "" "")
(command ".style" "仿宋体" "仿宋" 600 1 0 "" "")
(setq slist nil)
(setq i 0)
(setq ss (ssget '((0 . "LWPOLYLINE"))))
;; 求矩形上面一条边的中点坐标
(repeat (sslength ss)
(setq en (ssname ss i)) ;(setq en (entget ssn))
(vla-getboundingbox (vlax-ename->vla-object en)
'minpoint
'maxpoint
)
(setq pmax (vlax-safearray->list maxpoint)
pmin (vlax-safearray->list minpoint)
)
(setq xmin (car pmin))
(setq xmax (car pmax))
(setq ymin (cadr pmin))
(setq ymax (cadr pmax))
(setq xmid (/ (+ xmin xmax) 2))
;;(setq ymid ( / ( + ymin ymax) 2))
(setq xmid_ymax (list xmid ymax))
(setq slist (cons xmid_ymax slist))
(setq i (1+ i))
)
;;;关键就是这里了，排序，1e-6为容差，意思是1乘以10的负6次方。你可以自己改
(setq tmp_slist (zhy_sort_pt slist 1e-6))
(foreach insertp_mid tmp_slist
(setq insertp_move (pmove insertp_mid 0 -2))
(setq wz (strcat "3-50-411-" (itoa n1)))
(command ".text" "j" "mc" insertp_move 0 wz) ;(command ".text" "j" "mc" insertp_move 0.6 0wz)
(setq n1 (+ n1 1))
)
(setvar "cmdecho" oldcmd)
(setvar "blipmode" oldblip)
(setvar "osmode" oldsnap)
(princ)
)
(defun pmove (point_xy px py) ;点位，X Y Z
(setq point_x (car point_xy))
(setq point_y (cadr point_xy))
(list (+ point_x px) (+ point_y py))
)
谢谢Andyhon ，看了半天，对我有点难度；zhynt 高人啊。设置好容差，程序能够达到要求，很不错。 这个怎么把坐标点输出到excel中
页:
[1]