(XD::Curve:GetPointAtChord) 取得曲线上距给定点指定弦长的点坐标

Lispboy · 发表于 2016-10-9 00:53:16

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

(defun XD::Curve:GetPointAtChord (e spt ept len / chord dis left mid pnt pts
right tol
)
(defun _search (e left right tol)
(setq mid (/ (+ left right) 2.0))
(if (and
(not (or
(equal right mid tol)
(equal left mid tol)
)
)
(setq chord (distance spt (xdrx_curve_getpointatdist e mid)))
(not (equal chord len tol))
)
(progn
(if (> chord len)
(_search e left mid tol)
(_search e mid right tol)
)
)
)
mid
)
(or
spt
(setq spt (xdrx_getpropertyvalue e "startpoint"))
)
(or
ept
(setq ept (xdrx_getpropertyvalue e "endpoint"))
)
(or
(xdrx_point_ison spt e)
(setq spt (xdrx_curve_getclosestpoint e spt))
)
(or
(xdrx_point_ison ept e)
(setq ept (xdrx_curve_getclosestpoint e ept))
)
(setq left (xdrx_curve_getdistatpoint e spt)
right (xdrx_curve_getdistatpoint e ept)
)
(setq tol (car (xdrx_document_getprec))
dis (_search e left right tol)
)
(if (equal (distance spt (xdrx_curve_getpointatdist e dis)) len tol)
(xdrx_curve_getpointatdist e dis)
)
)

(defun XD::Curve:GetPointAtChord (e spt ept len / chord dis left mid pnt pts 
                                    right tol 
                                 ) 
  (defun _search (e left right tol) 
    (setq mid (/ (+ left right) 2.0)) 
    (if (and 
          (not (or 
                 (equal right mid tol) 
                 (equal left mid tol) 
               ) 
          ) 
          (setq chord (distance spt (xdrx_curve_getpointatdist e mid))) 
          (not (equal chord len tol)) 
        ) 
      (progn 
        (if (> chord len) 
          (_search e left mid tol) 
          (_search e mid right tol) 
        ) 
      ) 
    ) 
    mid 
  ) 
  (or 
    spt 
    (setq spt (xdrx_getpropertyvalue e "startpoint")) 
  ) 
  (or 
    ept 
    (setq ept (xdrx_getpropertyvalue e "endpoint")) 
  ) 
  (or 
    (xdrx_point_ison spt e) 
    (setq spt (xdrx_curve_getclosestpoint e spt)) 
  ) 
  (or 
    (xdrx_point_ison ept e) 
    (setq ept (xdrx_curve_getclosestpoint e ept)) 
  ) 
  (setq left (xdrx_curve_getdistatpoint e spt) 
        right (xdrx_curve_getdistatpoint e ept) 
  ) 
  (setq tol (car (xdrx_document_getprec)) 
        dis (_search e left right tol) 
  ) 
  (if (equal (distance spt (xdrx_curve_getpointatdist e dis)) len tol) 
    (xdrx_curve_getpointatdist e dis) 
  ) 
)

yoyoho · 发表于 2016-10-9 07:48:41

学习学习楼主辛苦

liuyj · 发表于 2016-10-9 09:29:18

这么晚还在写，辛苦。是不是没弄好格式？每行结束都有个

Lispboy · 发表于 2016-10-9 11:28:16

liuyj 发表于 2016-10-9 09:29

哪里有 了？我这看正常啊。

lucas3 · 发表于 2016-10-10 09:46:03

Lispboy 发表于 2016-10-9 11:28

确实有问题,要不直接上传lisp附件

2016-10-10 09_45_28-新通知.png

Lispboy · 发表于 2016-10-10 10:15:40

lucas3 发表于 2016-10-10 09:46

先拷贝后，到编辑器里面替换 为空字符吧。

yjch · 发表于 2016-10-11 08:27:24

感谢Lispboy，好好学习天天向上

lcc0532 · 发表于 2020-10-28 14:12:17

感谢Lispboy，好好学习天天向上

ssyfeng · 发表于 2023-8-31 11:32:44

学习一下。。。。

账号		自动登录	找回密码
密码			立即注册

[曲线] (XD::Curve:GetPointAtChord) 取得曲线上距给定点指定弦长的点坐标

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。