一对文字加外围方框 73哥函数
本帖最后由 树櫴希德 于 2015-9-14 22:05 编辑(defun get_inpoint (blockname)
(setq in_point(cdr (assoc 10 (entget blockname))))
in_point
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun get_inpointname (blockname)
(setq in_point(cdr(car(entget blockname))))
in_point
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun testlsp(lst / a b d l)
(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))))))
d(distance(get_inpoint(car lst))(get_inpoint(cadr lst))))
(while lst
(if(setq a(car lst)
b(vl-remove-if'(lambda(x)(>(distance (get_inpoint x) ( get_inpoint a))d))(cdr lst)))
(setq b(cons a b)
l(cons b l)
lst(repeat(length b)
(setq a(car b)
b(cdr b)
lst(vl-remove a lst))))
(setq lst(cdr lst))))
l)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun testlsp11(lst / a b d l)
(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))))))
d(distance(get_inpoint(car lst))(get_inpoint(cadr lst))))
(while lst
(if(setq a(car lst)
b(vl-remove-if'(lambda(x)(>(distance (get_inpoint x) ( get_inpoint a))d))(cdr lst)))
(setq l(cons(cons a b)l)
lst(vl-remove-if'(lambda(x)(member x b))lst))
(setq lst(cdr lst))))
l)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:wzjfk ( / ss i lst e insert_name ptlst biao1 ii ptt ptt1)
(setq ss (ssget '((0 . "text"))) )
(setq i 0)
(setq lst '())
(repeat (sslength ss)
(setq insert_name (ssname ss i))
(setq e(get_inpointname insert_name))
(setq lst (append lst (list e)))
(setq i (1+ i))
)
;(setq dist (distance (getpoint "\n请选择起点") (getpoint "\n请选择终点")))
;(setq ptlst (vl-sort lst
;以下根据坐标差对表排序
;'(lambda (e1 e2)
; (and (< (car (get_inpoint e1)) (car (get_inpoint e2)) )
; (< (cadr (get_inpoint e1)) (cadr (get_inpoint e2)) ) (= (distance (get_inpoint e1) (get_inpoint e2) ) ) )
; ) ) )
(setq ptlst(testlsp lst))
(setq biao '())
(setq ii 0)
(repeat (/ (length ptlst) 2)
(setq lst2 (append (list(nth ii ptlst))(list(nth (1+ ii) ptlst) ) ) )
(setq biao (append (list lst2)biao))
(setq ii (+ ii 2))
)
(mapcar'(lambda(x)
(foreach n x
(if (< (cadr(get_inpoint (car n)))(cadr(get_inpoint (cadr n)))
)
(progn(setq ptt (mapcar '+(get_inpoint (car n)) (car(textbox (entget(car n))) )))
(setq ptt1 (mapcar '+(get_inpoint (cadr n)) (cadr(textbox (entget(cadr n))) )))
(command "rectangle" ptt ptt1)
);;;;;;;;;;;;;;;;;;;;;;
(if (> (cadr(get_inpoint (car n)))(cadr(get_inpoint (cadr n))) )
(progn(setq ptt (mapcar '+(get_inpoint (cadr n)) (car(textbox (entget(cadr n))) )))
(setq ptt1 (mapcar '+(get_inpoint (car n)) (cadr(textbox (entget(car n))) )))
(command "rectangle" ptt ptt1)
)
)
;;;;;;;;;;;;;;;;;;;;;;;
)
)
)
biao)
) 谢谢楼主分享好程序
页:
[1]