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

aws

如图所示，这是一个图元，上面有两个点，我需要用这两个点给这条线打断成3份。


(vl-cmdf "BREAK" (entsel) "f" p "@")


如果按照上面这行代码，只能打断一次，然后，原本图元就变成两个了，除非再次拾取图元名


如果上面有100个点呢，我该如何去操作呢？请教各位

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)
)
感谢大家指点，原来从后往前打断，图元名不变，知道了这个隐藏技巧，就好写了。

夏生生

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

你有种再说一遍 发表于 2024-4-29 20:23
其实没有打断,有的只是新建了两个图元.完

意思，内部逻辑是重建？

你有种再说一遍

aws 发表于 2024-4-29 20:33
意思，内部逻辑是重建？

是啊,不然会觉得有什么玄学吗?
先克隆一份,再修改两条线数据,克隆那份还得插入数据库.

guosheyang

假如线上有100个点   依次重建 101条线图元 的方法更快些   如果是打断图元的话  你需要从离终点 最近的点开始打断 ，那样  打断的对象才能保证是原来选定那个图元

xyp1964

1. (defun BreakE (e ptn / x y vc abc p0)
   
2.   ;; (BreakE (setq s1(car(entsel"\n选择: "))) ptn)
   
3.   (defun abc (e pt)(vlax-curve-getDistAtParam e(vlax-curve-getParamAtPoint e pt)))
   
4.   (setq vc  vlax-curve-getclosestpointto
   
5.         ptn (mapcar '(lambda (x) (vc e x)) ptn)
   
6.         ptn (vl-sort ptn '(lambda (x y) (> (abc e x) (abc e y))))
   
7.         p0  (vlax-curve-getStartPoint e)
   
8.   )
   
9.   (mapcar '(lambda (x) (vl-cmdf "BREAK" (list e p0) "f" "non" x "non" x)) ptn)
   
10. )

(defun BreakE (e ptn / x y vc abc p0)<br />   ;; (BreakE (setq s1(car(entsel"\n选择: "))) ptn)<br />   (defun abc (e pt)(vlax-curve-getDistAtParam e(vlax-curve-getParamAtPoint e pt)))<br />   (setq vc  vlax-curve-getclosestpointto<br />         ptn (mapcar '(lambda (x) (vc e x)) ptn)<br />         ptn (vl-sort ptn '(lambda (x y) (> (abc e x) (abc e y))))<br />         p0  (vlax-curve-getStartPoint e)<br />   )<br />   (mapcar '(lambda (x) (vl-cmdf "BREAK" (list e p0) "f" "non" x "non" x)) ptn)<br /> )

edsion24

SETQ 中变量名称错误: (MAPCAR (QUOTE (LAMBDA (X) (VC E X))) PTN)

guosheyang

QUOTE   应是  function

aws

guosheyang 发表于 2024-4-29 21:29
假如线上有100个点   依次重建 101条线图元 的方法更快些   如果是打断图元的话  你需要从离终点 最近的点 ...

我是这样想的，把起点，终点也加入到里面，然后，点集排序，利用点集画一条多段线，最后炸开，就行了。但这样只能适用于直线。
多段线，样条曲线，圆弧就又不行了。

自贡黄明儒

1. (defun HH:sortPoint (e pts)
   
2.   (setq pts (mapcar '(lambda (x) (vlax-curve-GetClosestPointTo e x)) pts))
   
3.   (setq pts (mapcar '(lambda (x) (cons (vlax-curve-GetParamAtPoint e x) x)) pts))
   
4.   (setq pts (VL-SORT PTS '(LAMBDA (X y) (> (CAR X) (CAR y)))))
   
5.   (setq pts (mapcar 'cdr pts))
   
6.   (foreach x pts (vl-cmdf "BREAK" (LIST E X) X))
   
7. )
   
8. 
   
9. (defun C:w11 (/ e p pts)
   
10.   (setq e (car (entsel)))
    
11.   (while (setq p (getpoint))
    
12.     (setq pts (cons p pts))
    
13.   )
    
14.   (HH:sortPoint e pts)
    
15.   (princ)
    
16. )
    

(defun HH:sortPoint (e pts)<br />   (setq pts (mapcar '(lambda (x) (vlax-curve-GetClosestPointTo e x)) pts))<br />   (setq pts (mapcar '(lambda (x) (cons (vlax-curve-GetParamAtPoint e x) x)) pts))<br />   (setq pts (VL-SORT PTS '(LAMBDA (X y) (> (CAR X) (CAR y)))))<br />   (setq pts (mapcar 'cdr pts))<br />   (foreach x pts (vl-cmdf "BREAK" (LIST E X) X))<br /> )<br /> <br /> (defun C:w11 (/ e p pts)<br />   (setq e (car (entsel)))<br />   (while (setq p (getpoint))<br />     (setq pts (cons p pts))<br />   )<br />   (HH:sortPoint e pts)<br />   (princ)<br /> )<br />