本帖最后由 llsheng_73 于 2013-11-16 17:29 编辑
- (defun C:trimandextend(/ ss a b c p)
- (defun SstoEs(ss / a en lst)
- (if ss(progn(setq a -1)
- (while(setq en(ssname ss(setq a(1+ a))))(setq lst (cons en lst)))))
- lst)
- (defun array->list(l / i p)
- (if(>(vlax-safearray-get-u-bound l 1)1)
- (progn
- (setq l(vlax-safearray->list l)i 0)
- (repeat(/(length l)3)
- (setq p (cons(list(nth i l)(nth(+ 1 i)l)(nth (+ 2 i)l))p)
- i(+ 3 i))
- ))
- (setq p '()))
- p)
- (setq continue t)
- (while continue
- (prompt"选择要处理的两条线段右键退出")
- (setq ss(sstoes(ssget'((0 . "*line")))))
- (if(=(length ss)2)
- (if(setq a(vlax-ename->vla-object(car ss))
- b(vlax-ename->vla-object(cadr ss))
- c(car(array->list(vlax-variant-value(vla-IntersectWith a b 3)))))
- (progn
- (setq p(car(vl-sort(list(vlax-curve-getStartPoint a)(vlax-curve-getEndPoint a))
- '(lambda (a b)(< (distance c a) (distance c b))))))
- (if(=(vla-get-objectname a)"AcDbLine")
- (entmod(subst(cons 11 c)(cons 11 p)(subst(cons 10 c)(cons 10 p)(entget(vlax-vla-object->ename a)))))
- (entmod(subst(list 10 (car c)(cadr c))(list 10 (car p)(cadr p))(entget(vlax-vla-object->ename a))))
- )
- (setq p(car(vl-sort(list(vlax-curve-getStartPoint b)(vlax-curve-getEndPoint b))
- '(lambda (a b)(< (distance c a) (distance c b))))))
- (if(=(vla-get-objectname b)"AcDbLine")
- (entmod(subst(cons 11 c)(cons 11 p)(subst(cons 10 c)(cons 10 p)(entget(vlax-vla-object->ename b)))))
- (entmod(subst(list 10 (car c)(cadr c))(list 10 (car p)(cadr p))(entget(vlax-vla-object->ename b))))
- )
- )
- (alert"选择对象没有交点"))
- (if ss(alert"选择对象只能两个")(setq continue nil))
- ))
- );;命令可以自己改简单一些以方便你自己使用
郁闷的是不知道浏览器出了什么幺蛾子,传不了附件,自己复制代码吧,虽然会有点乱 |