如何用lisp实现这样的功能

nayipiantian999

如何用lisp实现断开的部分自动补上，超出的部分自动修剪？

飞雪神光

这是边界为多段线 内部为直线的重画方法

1. (setq
   
2.         ty(car(entsel "\n选择多段线边界:"))
   
3.         obj (vlax-ename->vla-object ty)
   
4.         pts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ty)))
   
5.         ss (ssget "cp" pts '((0 . "LINE")))
   
6. )
   
7. (foreach ty (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex ss)))
   
8.         (setq ptl '())
   
9.         (setq obj1 (vlax-ename->vla-object ty))
   
10.         (setq pts (vlax-invoke obj 'Intersectwith obj1 2))
    
11.         (while pts
    
12.                 (setq ptl (cons (list (car pts) (cadr pts)) ptl))
    
13.                 (setq pts (cdddr pts))
    
14.         )  
    
15.         (if (= (length ptl) 2)
    
16.                 (progn
    
17.                         (entmake (list '(0 . "line") (cons 62 1) (cons 10 (car ptl)) (cons 11 (cadr ptl))))
    
18.                         (entdel ty)
    
19.                 )
    
20.         )
    
21. )

(setq <br />         ty(car(entsel "\n选择多段线边界:"))<br />         obj (vlax-ename->vla-object ty)<br />         pts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ty)))<br />         ss (ssget "cp" pts '((0 . "LINE")))<br /> )<br /> (foreach ty (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex ss)))<br />         (setq ptl '())<br />         (setq obj1 (vlax-ename->vla-object ty))<br />         (setq pts (vlax-invoke obj 'Intersectwith obj1 2))<br />         (while pts<br />                 (setq ptl (cons (list (car pts) (cadr pts)) ptl))<br />                 (setq pts (cdddr pts))<br />         )  <br />         (if (= (length ptl) 2)<br />                 (progn<br />                         (entmake (list '(0 . "line") (cons 62 1) (cons 10 (car ptl)) (cons 11 (cadr ptl))))<br />                         (entdel ty)<br />                 )<br />         )<br /> )

飞雪神光

计算直线上两点 与边界的关系 来确定修剪和延伸 或者用交点去更新原直线点  或者不做判断直接求交点去更新或重画线

你有种再说一遍

需要的条件有点少,例如这是有图层区别?还是纯矩形?想要命令?还是全自动?

soly2006

命令：tt5
本人不缺币，支持论坛发展，无币想要的充币吧。

aws

直接边界内，所有直线延长超过边界线，再统一修剪

xudongchu

厉害了，加油