如何给一个图元，多次打断？

夏生生

aws 发表于 2024-4-30 09:19
我是这样想的，把起点，终点也加入到里面，然后，点集排序，利用点集画一条多段线，最后炸开，就行了。但 ...

spline要用院长那个，椭圆的里面自定义函数太多，懒得找了

1. ;;;=============================================
   
2. ;;;      通用函数  根据线上点重建直线
   
3. ;;;参数： en------直线图元
   
4. ;;;       pts-----线上点表(wcs)
   
5. ;;;返回值：line图元名表
   
6. (defun xty-make-line@pt   (en pts /  ent pt1 pt2)
   
7.     (setq pt1 (vlax-curve-getstartpoint en)
   
8.     pt2 (vlax-curve-getendpoint en)
   
9.     ent (entget en)
   
10.     pts (vl-sort
    
11.       pts
    
12.       (function (lambda (x y)
    
13.         (< (vlax-curve-getparamatpoint en x)
    
14.            (vlax-curve-getparamatpoint en y))))))
    
15.     (if  (null (equal pt1 (car pts) 1e-6))
    
16.   (setq pts (cons pt1 pts)))
    
17.     (if  (null (equal pt2 (last pts) 1e-6))
    
18.   (setq pts (reverse (cons pt2 (reverse pts)))))
    
19.     (mapcar (function
    
20.     (lambda  (x y)
    
21.         (setq ent (subst (cons 10 x) (assoc 10 ent) ent))
    
22.         (setq ent (subst (cons 11 y) (assoc 11 ent) ent))
    
23.         (entmakex ent)))
    
24.       pts
    
25.       (cdr pts)))

;;;=============================================<br /> ;;;      通用函数  根据线上点重建直线<br /> ;;;参数： en------直线图元<br /> ;;;       pts-----线上点表(wcs)<br /> ;;;返回值：line图元名表<br /> (defun xty-make-line@pt   (en pts /  ent pt1 pt2)<br />     (setq pt1 (vlax-curve-getstartpoint en)<br />     pt2 (vlax-curve-getendpoint en)<br />     ent (entget en)<br />     pts (vl-sort<br />       pts<br />       (function (lambda (x y)<br />         (< (vlax-curve-getparamatpoint en x)<br />            (vlax-curve-getparamatpoint en y))))))<br />     (if  (null (equal pt1 (car pts) 1e-6))<br />   (setq pts (cons pt1 pts)))<br />     (if  (null (equal pt2 (last pts) 1e-6))<br />   (setq pts (reverse (cons pt2 (reverse pts)))))<br />     (mapcar (function<br />     (lambda  (x y)<br />         (setq ent (subst (cons 10 x) (assoc 10 ent) ent))<br />         (setq ent (subst (cons 11 y) (assoc 11 ent) ent))<br />         (entmakex ent)))<br />       pts<br />       (cdr pts)))

1. ;;;=============================================
   
2. ;;;      通用函数  根据圆弧上点重建圆弧
   
3. ;;;参数： en------圆弧图元
   
4. ;;;       pts-----圆弧上点表(wcs)
   
5. ;;;返回值：arc图元名表
   
6. (defun xty-make-arc@pt  (en pts / cen ent pt1 pt2)
   
7.     (setq cen (xty-get-dxf 10 en)
   
8.     ent (entget en)
   
9.     pt1 (vlax-curve-getstartpoint en)
   
10.     pt2 (vlax-curve-getendpoint en)
    
11.     pts (vl-sort
    
12.       pts
    
13.       (function (lambda (x y)
    
14.         (< (vlax-curve-getparamatpoint en x)
    
15.            (vlax-curve-getparamatpoint en y))))))
    
16.     (if  (null (equal pt1 (car pts) 1e-6))
    
17.   (setq pts (cons pt1 pts)))
    
18.     (if  (null (equal pt2 (last pts) 1e-6))
    
19.   (setq pts (reverse (cons pt2 (reverse pts)))))
    
20.     (mapcar (function
    
21.     (lambda  (x y)
    
22.         (setq ent
    
23.            (subst (cons 50
    
24.             (angle cen (trans x 0 en)))
    
25.             (assoc 50 ent)
    
26.             ent))
    
27.         (setq ent
    
28.            (subst (cons 51 (angle cen (trans y 0 en)))
    
29.             (assoc 51 ent)
    
30.             ent))
    
31.         (entmakex ent)))
    
32.       pts
    
33.       (cdr pts)))

;;;=============================================<br /> ;;;      通用函数  根据圆弧上点重建圆弧<br /> ;;;参数： en------圆弧图元<br /> ;;;       pts-----圆弧上点表(wcs)<br /> ;;;返回值：arc图元名表<br /> (defun xty-make-arc@pt  (en pts / cen ent pt1 pt2)<br />     (setq cen (xty-get-dxf 10 en)<br />     ent (entget en)<br />     pt1 (vlax-curve-getstartpoint en)<br />     pt2 (vlax-curve-getendpoint en)<br />     pts (vl-sort<br />       pts<br />       (function (lambda (x y)<br />         (< (vlax-curve-getparamatpoint en x)<br />            (vlax-curve-getparamatpoint en y))))))<br />     (if  (null (equal pt1 (car pts) 1e-6))<br />   (setq pts (cons pt1 pts)))<br />     (if  (null (equal pt2 (last pts) 1e-6))<br />   (setq pts (reverse (cons pt2 (reverse pts)))))<br />     (mapcar (function<br />     (lambda  (x y)<br />         (setq ent<br />            (subst (cons 50<br />             (angle cen (trans x 0 en)))<br />             (assoc 50 ent)<br />             ent))<br />         (setq ent<br />            (subst (cons 51 (angle cen (trans y 0 en)))<br />             (assoc 51 ent)<br />             ent))<br />         (entmakex ent)))<br />       pts<br />       (cdr pts)))

1. ;;;=============================================
   
2. ;;;      通用函数  根据圆上点重建打断圆
   
3. ;;;参数： en------圆图元
   
4. ;;;       pts-----圆上点表(wcs)
   
5. ;;;返回值：arc图元名表
   
6. (defun xty-make-circle@pt  (en pts / cen)
   
7.     (setq cen (xty-get-dxf 10 en)
   
8.     pts (vl-sort
   
9.       pts
   
10.       (function (lambda (x y)
    
11.         (< (vlax-curve-getparamatpoint en x)
    
12.            (vlax-curve-getparamatpoint en y)))))
    
13.     pts (cons (last pts) pts))
    
14.     (mapcar
    
15.   (function
    
16.       (lambda (x y)
    
17.     (entmakex
    
18.         (cons
    
19.       (cons 0 "arc")
    
20.       (append
    
21.           (xty-get-dxflf (list -1 0 5 100 330)
    
22.              en)
    
23.           (list
    
24.         (cons 50
    
25.               (angle cen (trans x 0 en)))
    
26.         (cons 51
    
27.               (angle cen (trans y 0 en)))))))))
    
28.   pts
    
29.   (cdr pts)))

;;;=============================================<br /> ;;;      通用函数  根据圆上点重建打断圆<br /> ;;;参数： en------圆图元<br /> ;;;       pts-----圆上点表(wcs)<br /> ;;;返回值：arc图元名表<br /> (defun xty-make-circle@pt  (en pts / cen)<br />     (setq cen (xty-get-dxf 10 en)<br />     pts (vl-sort<br />       pts<br />       (function (lambda (x y)<br />         (< (vlax-curve-getparamatpoint en x)<br />            (vlax-curve-getparamatpoint en y)))))<br />     pts (cons (last pts) pts))<br />     (mapcar<br />   (function<br />       (lambda (x y)<br />     (entmakex<br />         (cons<br />       (cons 0 "arc")<br />       (append<br />           (xty-get-dxflf (list -1 0 5 100 330)<br />              en)<br />           (list<br />         (cons 50<br />               (angle cen (trans x 0 en)))<br />         (cons 51<br />               (angle cen (trans y 0 en)))))))))<br />   pts<br />   (cdr pts)))

aws

(defun c:tt ()
        (setq en(car(entsel "选取一条线：")))
        (setvar "CMDECHO" 0)
        (setq obj(vlax-ename->vla-object en))
        (setq cs nil)
        (while
                (setq p(getpoint "选取一个点："))
                (setq a(vlax-curve-getParamAtPoint obj p));---返回一个点在曲线上的参数
                (setq cs(cons a cs))
        )
        (setq cs(vl-sort cs '>));---从大到小排序参数
        (setq pts(mapcar '(lambda(x)(vlax-curve-getPointAtParam obj x))cs));---把参数表变成点表
        (mapcar '(lambda(x)(vl-cmdf ".break"(list en x)"f" "non" x "non" x))pts)
        (setvar "CMDECHO" 1)
        (princ)
)
感谢大家指点，原来从后往前打断，图元名不变，知道了这个隐藏技巧，就好写了。

chslwj521

xyp1964 发表于 2024-4-29 22:04

这个厉害，收藏 ，学习

chslwj521

xyp1964 发表于 2024-4-29 22:04

(BreakE (CAR(ENTSEL)) (LIST(GETPOINT)(GETPOINT)(GETPOINT)))

菜卷鱼

用当前对象与100个点去打断，直到不产生新图元