社区 › AutoLISP/Visual LISP 编程技术 › 如何给一个图元，多次打断？

aws 发表于 2024-4-29 20:10

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

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


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


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


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

aws 发表于 2024-4-30 11:07

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

夏生生 发表于 2024-4-30 09:56

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

spline要用院长那个，椭圆的里面自定义函数太多，懒得找了
;;;=============================================
;;;      通用函数根据线上点重建直线
;;;参数： en------直线图元
;;;       pts-----线上点表(wcs)
;;;返回值：line图元名表
(defun xty-make-line@pt   (en pts /ent pt1 pt2)
    (setq pt1 (vlax-curve-getstartpoint en)
    pt2 (vlax-curve-getendpoint en)
    ent (entget en)
    pts (vl-sort
      pts
      (function (lambda (x y)
      (< (vlax-curve-getparamatpoint en x)
         (vlax-curve-getparamatpoint en y))))))
    (if(null (equal pt1 (car pts) 1e-6))
(setq pts (cons pt1 pts)))
    (if(null (equal pt2 (last pts) 1e-6))
(setq pts (reverse (cons pt2 (reverse pts)))))
    (mapcar (function
    (lambda(x y)
      (setq ent (subst (cons 10 x) (assoc 10 ent) ent))
      (setq ent (subst (cons 11 y) (assoc 11 ent) ent))
      (entmakex ent)))
      pts
      (cdr pts)))
;;;=============================================
;;;      通用函数根据圆弧上点重建圆弧
;;;参数： en------圆弧图元
;;;       pts-----圆弧上点表(wcs)
;;;返回值：arc图元名表
(defun xty-make-arc@pt(en pts / cen ent pt1 pt2)
    (setq cen (xty-get-dxf 10 en)
    ent (entget en)
    pt1 (vlax-curve-getstartpoint en)
    pt2 (vlax-curve-getendpoint en)
    pts (vl-sort
      pts
      (function (lambda (x y)
      (< (vlax-curve-getparamatpoint en x)
         (vlax-curve-getparamatpoint en y))))))
    (if(null (equal pt1 (car pts) 1e-6))
(setq pts (cons pt1 pts)))
    (if(null (equal pt2 (last pts) 1e-6))
(setq pts (reverse (cons pt2 (reverse pts)))))
    (mapcar (function
    (lambda(x y)
      (setq ent
         (subst (cons 50
            (angle cen (trans x 0 en)))
            (assoc 50 ent)
            ent))
      (setq ent
         (subst (cons 51 (angle cen (trans y 0 en)))
            (assoc 51 ent)
            ent))
      (entmakex ent)))
      pts
      (cdr pts)))
;;;=============================================
;;;      通用函数根据圆上点重建打断圆
;;;参数： en------圆图元
;;;       pts-----圆上点表(wcs)
;;;返回值：arc图元名表
(defun xty-make-circle@pt(en pts / cen)
    (setq cen (xty-get-dxf 10 en)
    pts (vl-sort
      pts
      (function (lambda (x y)
      (< (vlax-curve-getparamatpoint en x)
         (vlax-curve-getparamatpoint en y)))))
    pts (cons (last pts) pts))
    (mapcar
(function
      (lambda (x y)
    (entmakex
      (cons
      (cons 0 "arc")
      (append
          (xty-get-dxflf (list -1 0 5 100 330)
             en)
          (list
      (cons 50
            (angle cen (trans x 0 en)))
      (cons 51
            (angle cen (trans y 0 en)))))))))
pts
(cdr pts)))

你有种再说一遍 发表于 2024-4-29 20:23

其实没有打断,有的只是新建了两个图元.完

aws 发表于 2024-4-29 20:33

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

意思，内部逻辑是重建？

你有种再说一遍 发表于 2024-4-29 20:38

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

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

guosheyang 发表于 2024-4-29 21:29

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

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

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

edsion24 发表于 2024-4-30 07:58

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

guosheyang 发表于 2024-4-30 08:01

QUOTE   应是function

aws 发表于 2024-4-30 09:19

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

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

自贡黄明儒 发表于 2024-4-30 09:51

本帖最后由 自贡黄明儒 于 2024-4-30 15:48 编辑

(defun HH:sortPoint (e pts)
(setq pts (mapcar '(lambda (x) (vlax-curve-GetClosestPointTo e x)) pts))
(setq pts (mapcar '(lambda (x) (cons (vlax-curve-GetParamAtPoint e x) x)) pts))
(setq pts (VL-SORT PTS '(LAMBDA (X y) (> (CAR X) (CAR y)))))
(setq pts (mapcar 'cdr pts))
(foreach x pts (vl-cmdf "BREAK" (LIST E X) X))
)

(defun C:w11 (/ e p pts)
(setq e (car (entsel)))
(while (setq p (getpoint))
    (setq pts (cons p pts))
)
(HH:sortPoint e pts)
(princ)
)

查看完整版本: 如何给一个图元，多次打断？