（XD::Curve:GetPointsAtDistGroup）曲线给点定距离组求一系列点

newer

源自 http://bbs.xdcad.net/thread-705968-1-1.html

各位大哥，已知一条样条曲线及线上一点，有没有什么方法可以找到线上这样一组点（如：知道第二个点距离第一个点500，第三个距居第二个点200，第四距第三1500，等等，这些点不等间距，且均在样条曲线上），用CAD定距等分太麻烦了，少数几个点还能等分，数量多了，效率低呢。这个有什么快速方法么？或者小插件么？小弟感激不尽

(defun XD::Curve:GetPointsAtDistGroup (e pt disl / dis1 p1 pts x)
  (if (not (setq dis1 (vlax-curve-getdistatpoint e pt)))
    (setq pt (vlax-curve-getClosestPointTo e pt)
          dis1 (vlax-curve-getdistatpoint e pt)
    )
  )
  (setq pts (list pt))
  (mapcar
    '(lambda (x)
       (if (and (setq p1 (vlax-curve-getpointatdist e (setq dis1 (+ dis1 x))))
                (not (equal p1 (vlax-curve-getstartpoint e)))
           )
         (setq pts (cons p1 pts))
       )
     )
    disl
  )
  (reverse pts)
)

(setq a (XD::CURVE:GETPOINTSATDISTGROUP e p1 '(100 200 300 400)))
((2865.54 773.647 0.0) (2873.57 873.299 0.0) (2964.42 1031.75 0.0) (3210.97
865.563 0.0) (3511.21 931.797 0.0))

测试代码,曲线上指定间隔画圆：

(defun c:tt()
    (if (and (/= "" (setq disl (getstring "\n输入距离间隔（逗号分隔）<退出>:")))
             (setq disl (xdrx_string_regexps "[^,]+" disl))
             (setq e (car (xdrx_entsel "\n选取曲线<退出>:" '((0 . "*LINE,ELLIPSE,CIRCLE,ARC")))))
             (setq pt (getpoint "\n点取开始点<退出>:"))
        )
      (progn
        (setq disl (mapcar 'atof disl))
        (setq pt (xdrx_curve_getclosestpoint e pt))
        (setq pts (XD::Curve:GetPointsAtDistGroup e pt disl)
              r (/ (car disl) 3.0)
        )
        (mapcar '(lambda(x)(xdrx_circle_make x r)) pts)
      )
    )
    (princ)
)

HLCAD

感谢“Newer”的程序，看着亲切。