返回两曲线间最短距离

qxlonmsn

(defun NearestDist (ent1 ent2 num fzz / pts dislst pt1 pt2 lst)
  (vl-load-com)
  (if (and
        (wcmatch "LINE,LWPOLYLINE,CIRCLE,ARC,HELIX,ELLIPSE,SPLINE,POLYLINE" (strcat "*" (cdr (assoc 0 (entget ent1))) "*"))
        (wcmatch "LINE,LWPOLYLINE,CIRCLE,ARC,HELIX,ELLIPSE,SPLINE,POLYLINE" (strcat "*" (cdr (assoc 0 (entget ent2))) "*"))
        (setq pts (GetPtsAtSptToEpt ent1 num (vlax-curve-getStartPoint ent1) (vlax-curve-getEndPoint ent1)));获取曲线ent1上的num个点
        (setq dislst (mapcar '(lambda (x) (distance (vlax-curve-getClosestPointTo (vlax-ename->vla-object ent2) x) x)) pts));距离列表
        (not (vl-every '(lambda (x) (equal x (car dislst) 0.001)) dislst));列表每个元素不相等==>两曲线不平行
      );两图元都是曲线
      (progn
          (setq pts (vl-sort pts
                      '(lambda (x y)
                         (< (distance (vlax-curve-getClosestPointTo (vlax-ename->vla-object ent2) x) x)
                            (distance (vlax-curve-getClosestPointTo (vlax-ename->vla-object ent2) y) y)
                         )
                       );end lambda
                    );end vl-sort
          );end setq
          (setq pt1 (car pts));最近点
          (setq pt2 (vlax-curve-getClosestPointTo (vlax-ename->vla-object ent2) pt1));pt1距离ent2上最近点
          (while (and
                   (setq pt3 (vlax-curve-getClosestPointTo (vlax-ename->vla-object ent1) pt2));pt2距离ent1上最近点
                   (not (equal pt1 pt3 fzz));两点不在公差内相等就循环
                 );end and
            (setq pt1 pt3)
            (setq pt2 (vlax-curve-getClosestPointTo (vlax-ename->vla-object ent2) pt1));更新pt2
          );end while
          (setq lst (list (distance pt1 pt2) pt1 pt2))
      );end progn
      (princ "\n2曲线平行!")
  );end if
)




;;返回曲线指定开始点到结束点指定数量的点
;;函数名称:  GetPtsAtSptToEpt
;;调用格式:        (GetPtsAtSptToEpt ent1 num spt ept)
;;参数说明:        
;;ent1 ----------- 图元名
;;num  ----------- 取点数
;;spt  ----------- 开始点
;;ept  ----------- 结束点
;;返回值:        点表
(defun GetPtsAtSptToEpt (ent1 num spt ept / pts n entobj dis num_b)
  (vl-load-com)
  (if (wcmatch "LINE,LWPOLYLINE,CIRCLE,ARC,HELIX,ELLIPSE,SPLINE,POLYLINE" (strcat "*" (cdr (assoc 0 (entget ent1))) "*"));图元是曲线
      (progn
        (setq pts '())
        (setq n 1)
        (setq entobj (vlax-ename->vla-object ent1));图元转vla对象
        (setq spt (vlax-curve-getClosestPointTo entobj spt))
        (setq ept (vlax-curve-getClosestPointTo entobj ept))
        (setq dis (-
                    (vlax-curve-getDistAtParam entobj (vlax-curve-getParamAtPoint entobj ept));结束点长度
                    (vlax-curve-getDistAtParam entobj (vlax-curve-getParamAtPoint entobj spt));开始点长度
                  )
        );获取区间总长度
        (setq num_b (/ dis (1+ num)));每份长度
        (repeat num
          (setq pts (cons (vlax-curve-getPointAtParam entobj (vlax-curve-getParamAtDist entobj (+ (vlax-curve-getDistAtPoint entobj spt) (* n num_b)) )) pts))
          (setq n (1+ n))
        );end repeat
        (setq pts (reverse pts));倒置
      );end progn
  );end if
)


;;(progn (setq oldosmode (getvar 'osmode)) (setvar 'osmode 16447) (command "_line" (cadr (setq lst (NearestDist (car (entsel)) (car (entsel)) 10 0.0001))) (caddr lst) "") (setvar 'osmode oldosmode) (setq lst nil oldosmode nil))

HLCAD

感谢楼主分享程序！！！

liu-he

收藏成功66666

tigcat

谢谢楼主分享!

guosheyang2

简洁的代码  感谢分享！

ngc

很简洁的代码，感谢分享！