我是这样想的,把起点,终点也加入到里面,然后,点集排序,利用点集画一条多段线,最后炸开,就行了。但 ...
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)))
(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)
)
感谢大家指点,原来从后往前打断,图元名不变,知道了这个隐藏技巧,就好写了。
xyp1964 发表于 2024-4-29 22:04
这个厉害,收藏 ,学习:lol xyp1964 发表于 2024-4-29 22:04
(BreakE (CAR(ENTSEL)) (LIST(GETPOINT)(GETPOINT)(GETPOINT))){:1_1:} 用当前对象与100个点去打断,直到不产生新图元
页:
1
[2]