谢谢分享
多谢分享！！
本帖最后由 hhh454 于 2025-3-13 09:05 编辑
在论坛里看到的，可以学习借鉴一下，原址找不到了，没有版主的全面
功能：在两条曲线中间建立均分曲线
，可以复制，可以下载，一样的
;---曲线按段数等分，返回点表
(defun div_n_crv(obj n / len mm pts)
(setq len(vlax-curve-getdistatparam obj(vlax-curve-getendparam obj)))
(setq mm(/ len n))
(setq pts nil)
(setq pts(cons(vlax-curve-getEndPoint obj)pts));终点加入到点表
(while
(>(setq len(- len mm))0.1)
(setq pts(cons(vlax-curve-getPointAtDist obj len)pts))
)
(setq pts(cons(vlax-curve-getStartPoint obj)pts));起点加入到点表
)
(defun c:tween_curve(/ dis len1 len2 lenmax n obj1 obj2 pts1 pts2 pts3 pts5 tol)
(setq obj1(vlax-ename->vla-object(car(entsel "\n请选取第一根曲线："))))
(setq obj2(vlax-ename->vla-object(car(entsel "\n请选取第二根曲线："))))
(setq n(getint "\n两条曲线中间均分创建几条曲线？<1>"))(or n(setq n 1))
(if(not(and obj1 obj2 n))(quit));防呆措施
(setq len1(vlax-curve-getdistatparam obj1(vlax-curve-getendparam obj1)))
(setq len2(vlax-curve-getdistatparam obj2(vlax-curve-getendparam obj2)))
(setq tol(fix(* 0.01(setq lenmax(max len1 len2)))))
(setq dis(getreal(strcat "\n请设置等分近似值（以长线为准，短线适配，默认百分之一，越小越准确）：<"(rtos tol 2 0)">")))
(or dis(setq dis tol))
(setq pts1(div_n_crv obj1(fix(/ lenmax dis))))
(setq pts2(div_n_crv obj2(fix(/ lenmax dis))))
(if
(>
(distance(car pts1)(car pts2))
(distance(car pts1)(last pts2))
)
(setq pts2(reverse pts2))
)
(setq pts3(mapcar '(lambda(x1 x2)
(setq dist(distance x1 x2))
(setq mm(/ dist(1+ n)))
(setq pts4 nil)
(while
(>(setq dist(- dist mm))0.1)
(setq pts4(cons(polar x1(angle x1 x2)dist)pts4))
)
)pts1 pts2))
(setq pts5(apply 'mapcar(cons 'list pts3)))
(foreach lst pts5
(entmake(append
(list
'(0 . "SPLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbSpline")
'(71 . 3)
'(62 . 6)
)
(mapcar '(lambda(x)(cons 11 x))lst)
)
)
)
(princ)
)
谢谢分享，下载试试!!!!!
谢谢分享，这种2个线中线均分的功能，CAD居然一直没有吸纳进来。
犀牛是自带这种功能好久了
谢谢分享辛苦了楼主
感谢分享
love1030312 发表于 2025-3-13 08:18
每个人的命令使用习惯不一样太短会造成别人的重复你要简单的可以自己自定义一下就可以了 版主是照 ...
正解，短了会冲突，到时用户骂声一片;P
kexiya123 发表于 2025-3-13 08:03
提个简单要求，把运用的命令名字写简单一点，不要那么长
自己写一个引导文件就行，用短命令调用，再就是在PGP文件中写一个快捷键就行，那是官方自带功能
感谢分享，不用弄到犀牛里了