biya 发表于 2025-3-12 22:29:22

平分曲线(LISP免费插件)

本帖最后由 biya 于 2025-3-13 08:02 编辑

下载包回复可见





**** Hidden Message *****

hhh454 发表于 2025-3-13 09:03:16

本帖最后由 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)
)


love1030312 发表于 2025-3-13 08:18:06

kexiya123 发表于 2025-3-13 08:03
提个简单要求，把运用的命令名字写简单一点，不要那么长

每个人的命令使用习惯不一样太短会造成别人的重复你要简单的可以自己自定义一下就可以了   版主是照顾大家的使用

biya 发表于 2025-4-13 10:26:19

spp_wall 发表于 2025-4-9 15:16
感谢版主，向版主学习

感谢支持，好用的话多介绍朋友来下载

spp_wall 发表于 2025-4-9 15:16:26

感谢版主，向版主学习

ahsxxu 发表于 2025-4-8 09:49:15

感谢分享，回复下载。

yegucheng0129 发表于 2025-4-7 17:11:55

感谢大佬分享

Maxwell 发表于 2025-4-7 12:52:20

学习一下谢谢

水仙的错 发表于 2025-4-6 17:21:42

hhh454 发表于 2025-3-13 09:03
在论坛里看到的，可以学习借鉴一下，原址找不到了，没有版主的全面
功能：在两条曲线中间建立均分曲线
， ...

这个也非常好！对这个内插期盼已久终于在这里发现，感谢长老！

yufei77258 发表于 2025-4-5 20:17:21

下载备用，谢谢！

gg256 发表于 2025-4-4 00:09:51


每天学习一点，每天进步一点

bing_11 发表于 2025-4-2 12:49:19

非常感谢分享，
页: [1] 2 3 4 5 6 7 8 9 10
查看完整版本: 平分曲线(LISP免费插件)