对直线的起始点重新排序
对直线的起始点重新排序，子程序摘自本论坛，（忘记是哪位老大的了，见谅！）因为画图时无序，导致用图纸下料或导参数时无序，特此整理一下。
请各位老大指点！
(defun c:tt ()
(princ "\n请选择要排序的直线...")
(if (setq ss (ssget '((0 . "LINE"))))
(progn
;; 1、获取点位表
(setq lst '()
i 0 )
(repeat (sslength ss)
(setq en(ssname ss i)
ent (entget en)
pt(cdr (assoc 10 ent))
pt_1(cdr (assoc 11 ent))
lst (list pt pt_1))
;; 2、排序
(setq aa (paixu_zZyYxX lst))
;; 3、重新画线
(command "line" (car aa) (cadr aa) "")
(setq i(1+ i))
);repeat
)
);if
;; 4、删除原来的线
(command "._erase" ss "")
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 1. 判断z,z大在前，如果z相等，判断y
;;; 2. 判断y,y大在前，如果y相等，判断x
;;; 3. 判断x,x大在前，如果x相等，删除重复点。
(defun paixu_ZzYyXx (xyz);;;
(vl-sort (listxx lst)
(function (lambda (e1 e2)
(cond ((/= (caddr e1) (caddr e2))(> (caddr e1) (caddr e2)))
((/= (cadr e1) (cadr e2))(> (cadr e1) (cadr e2)) )
((> (car e1) (car e2)) )
) ))
))
-----------------------------------------------------
;;; 1. 判断z,z小在前，如果z相等，判断y
;;; 2. 判断y,y小在前，如果y相等，判断x
;;; 3. 判断x,x小在前，如果x相等，删除重复点。
(defun paixu_zZyYxX (xyz)
(vl-sort (listxx lst)
(function (lambda (e1 e2)
(cond ((/= (caddr e1) (caddr e2))(< (caddr e1) (caddr e2)))
((/= (cadr e1) (cadr e2))(< (cadr e1) (cadr e2)) )
((< (car e1) (car e2)) )
) ))
))
------------------------------------------------------
(defun listxx ( a / b) ;删除表中重复元素1
(foreach x a (if(not(member x b))(setq b(append b(list x)))))
) 感谢vlisp2012分享程序!
页:
[1]