- (defun c:tt ()
- (defun PlPtn (s1)(mapcar 'cdr(vl-remove-if '(lambda (x) (/= (car x) 10)) (entget s1))))
- (if (and (setq p0 (getpoint "\n基点<退出>: "))
- (setq p1 (getcorner p0 "\n对角点<退出>: "))
- )
- (progn
- (setvar "osmode" 0)
- (command "Rectang" p0 p1)
- (setq s1 (entlast)
- ptn (PlPtn s1)
- mode t
- )
- (while mode
- (setq gd15 (grread t 15 0)
- cd (car gd15)
- )
- (cond ((or (= cd 2) (= cd 3) (= cd 25)) (setq mode nil))
- ((= cd 5)
- (redraw)
- (setq pt (cadr gd15)
- ptn (vl-sort ptn '(lambda (x y) (< (distance pt x) (distance pt y))))
- p1 (car ptn)
- )
- (Grvecs (list 1 pt p1))
- )
- )
- )
- (redraw)
- (command "Line" pt p1 "")
- )
- )
- (princ)
- )
|