封闭多段线智能修剪

wanhongron

工作中经常碰到要对封闭多段线区域进行修剪，修剪后还是保持为封闭多段线，请各位高手多指教

x_s_s_1

这样稳妥一点，但是有“无效的选项关键字”

1. (defun c:tt  (/ md->3d a en1 en2 pt ss v)
   
2.     (defun md->3d  (l) ;_by caoyin
   
3.   (if (> (length l) 3)
   
4.       (cons (list (car l) (cadr l) (caddr l))
   
5.       (md->3d (cdddr l)))
   
6.       (list l)))
   
7.     (setq en1 (car (entsel "\n选择截断线:"))
   
8.     en2 (car (entsel "\n选择被截断:"))
   
9.     a   (md->3d (vlax-invoke (vlax-ename->vla-object en1)
   
10.            "intersectwith"
    
11.            (vlax-ename->vla-object en2)
    
12.            acextendnone))
    
13.     a   (* 0.5
    
14.      (+ (vlax-curve-getparamatpoint en1 (car a))
    
15.         (vlax-curve-getparamatpoint en1 (last a))))
    
16.     pt  (vlax-curve-getpointatparam en1 a)
    
17.     a   (fix a)
    
18.     v   (mapcar '-
    
19.           (vlax-curve-getpointatparam en1 a)
    
20.           (vlax-curve-getpointatparam en1 (1+ a)))
    
21.     v   (mapcar '(lambda (x) (/ x (distance '(0 0 0) v) 1.)) v)
    
22.     v   (mapcar '(lambda (x) (* x 10))
    
23.           (vl-list* (- (cadr v)) (car v) (cddr v)))
    
24.     ss  (ssadd)
    
25.     ss  (ssadd en1 ss)
    
26.     ss  (ssadd en2 ss))
    
27.     (if  (and (bpoly (mapcar '+ pt v) ss '(1 0))
    
28.        (bpoly (mapcar '- pt v) ss '(1 0)))
    
29.   (progn (entdel en1)
    
30.          (entdel en2)
    
31.          (entdel (car (entsel "\n选择需删除:")))))
    
32.     (princ))

(defun c:tt  (/ md->3d a en1 en2 pt ss v)<br />     (defun md->3d  (l) ;_by caoyin<br />   (if (> (length l) 3)<br />       (cons (list (car l) (cadr l) (caddr l))<br />       (md->3d (cdddr l)))<br />       (list l)))<br />     (setq en1 (car (entsel "\n选择截断线:"))<br />     en2 (car (entsel "\n选择被截断:"))<br />     a   (md->3d (vlax-invoke (vlax-ename->vla-object en1)<br />            "intersectwith"<br />            (vlax-ename->vla-object en2)<br />            acextendnone))<br />     a   (* 0.5<br />      (+ (vlax-curve-getparamatpoint en1 (car a))<br />         (vlax-curve-getparamatpoint en1 (last a))))<br />     pt  (vlax-curve-getpointatparam en1 a)<br />     a   (fix a)<br />     v   (mapcar '-<br />           (vlax-curve-getpointatparam en1 a)<br />           (vlax-curve-getpointatparam en1 (1+ a)))<br />     v   (mapcar '(lambda (x) (/ x (distance '(0 0 0) v) 1.)) v)<br />     v   (mapcar '(lambda (x) (* x 10))<br />           (vl-list* (- (cadr v)) (car v) (cddr v)))<br />     ss  (ssadd)<br />     ss  (ssadd en1 ss)<br />     ss  (ssadd en2 ss))<br />     (if  (and (bpoly (mapcar '+ pt v) ss '(1 0))<br />        (bpoly (mapcar '- pt v) ss '(1 0)))<br />   (progn (entdel en1)<br />          (entdel en2)<br />          (entdel (car (entsel "\n选择需删除:")))))<br />     (princ))

lxl217114

boundary命令可以么？

wanhongron

选取红色多段线线对紫色封闭多段线进行修剪

guosheyang

交点处相互打断  再生成两个面域即可

xyp1964

bpoly

wanhongron

院长厉害，可惜没有源码

飞雪神光

wanhongron 发表于 2024-1-15 22:41
院长厉害，可惜没有源码

院长说了 用 bpoly  红线两边各用一次 然后删除原多段线

czb203

xyp1964 发表于 2024-1-15 21:37
bpoly

老大无所不能

x_s_s_1

试试

1. (defun c:tt  (/ md->3d a en1 en2 pt v x)
   
2.     (defun md->3d  (l) ;_by caoyin
   
3.   (if (> (length l) 3)
   
4.       (cons (list (car l) (cadr l) (caddr l))
   
5.       (md->3d (cdddr l)))
   
6.       (list l)))
   
7.     (setq en1 (vlax-ename->vla-object (car (entsel "\n选择截断线:")))
   
8.     en2 (vlax-ename->vla-object (car (entsel "\n选择被截断:")))
   
9.     a   (md->3d (vlax-invoke en1 "intersectwith" en2 acextendnone))
   
10.     a   (* 0.5
    
11.      (+ (vlax-curve-getparamatpoint en1 (car a))
    
12.         (vlax-curve-getparamatpoint en1 (last a))))
    
13.     pt  (vlax-curve-getpointatparam en1 a)
    
14.     a   (fix a)
    
15.     v   (mapcar '-
    
16.           (vlax-curve-getpointatparam en1 a)
    
17.           (vlax-curve-getpointatparam en1 (1+ a)))
    
18.     v   (mapcar '(lambda (x) (/ x (distance '(0 0 0) v) 1.)) v)
    
19.     v   (mapcar '(lambda (x) (* x 10))
    
20.           (vl-list* (- (cadr v)) (car v) (cddr v))))
    
21.     (if  (and (bpoly (mapcar '+ pt v))
    
22.        (bpoly (mapcar '- pt v)))
    
23.   (progn (entdel en1)
    
24.          (entdel en2)
    
25.          (entdel (car (entsel "\n选择需删除:"))))))

(defun c:tt  (/ md->3d a en1 en2 pt v x)<br />     (defun md->3d  (l) ;_by caoyin<br />   (if (> (length l) 3)<br />       (cons (list (car l) (cadr l) (caddr l))<br />       (md->3d (cdddr l)))<br />       (list l)))<br />     (setq en1 (vlax-ename->vla-object (car (entsel "\n选择截断线:")))<br />     en2 (vlax-ename->vla-object (car (entsel "\n选择被截断:")))<br />     a   (md->3d (vlax-invoke en1 "intersectwith" en2 acextendnone))<br />     a   (* 0.5<br />      (+ (vlax-curve-getparamatpoint en1 (car a))<br />         (vlax-curve-getparamatpoint en1 (last a))))<br />     pt  (vlax-curve-getpointatparam en1 a)<br />     a   (fix a)<br />     v   (mapcar '-<br />           (vlax-curve-getpointatparam en1 a)<br />           (vlax-curve-getpointatparam en1 (1+ a)))<br />     v   (mapcar '(lambda (x) (/ x (distance '(0 0 0) v) 1.)) v)<br />     v   (mapcar '(lambda (x) (* x 10))<br />           (vl-list* (- (cadr v)) (car v) (cddr v))))<br />     (if  (and (bpoly (mapcar '+ pt v))<br />        (bpoly (mapcar '- pt v)))<br />   (progn (entdel en1)<br />          (entdel en2)<br />          (entdel (car (entsel "\n选择需删除:"))))))