- (defun c:ttt( / C E E1 E2 MO N P1 P2 PE SS TMP)
- (vl-load-com)
- (prompt "\n选择平行线条:")
- (if (setq ss(ssget '((0 . "*line"))))
- (progn
- (setq n(sslength ss))
- (setq pe nil)
- (repeat n
- (setq e(ssname ss (setq n(1- n))))
- (setq p1(vlax-curve-getstartpoint e)
- p2(vlax-curve-getEndpoint e))
- (if (< (car p2)(car p1))(setq tmp p2 p2 p1 p1 tmp))
- (setq pe(cons (list p1 p2) pe))
- )
- (setq pe(vl-sort pe '(lambda(e1 e2)(> (cadar e1)(cadar e2)))))
- (setq mo(getint "\n选择连线模式<0-左,1-右>:"))
- (or mo (setq mo 0))
- (if (= mo 0) (setq c 'car)(setq c 'cadr))
- (while (and (setq e1(car pe))
- (setq pe(cdr pe))
- (setq e2(car pe))
- )
- (setq p1((eval c) e1))
- (setq p2((eval c) e2))
- (entmake (list '(0 . "LINE") (cons 10 p1) (cons 11 p2)))
- (if (equal c 'car) (setq c 'cadr)(setq c 'car))
- )
- )
- )
- )
|