一条多段线上任意一点距起点的长度 ，请大神，帮忙测试完善。

whophy

现在我想知道每个端点（各个pline、arc、line的端点）距离起点的长度的数值，（选择是否颠倒起点与终点，默认不做调整）并且自动标注到excel当前单元格内。现在已经完成了查询部分，后面部分请大神帮忙完成，谢谢。





(defun C:test ( / &dis1 &k1 &n1 &p1 &ss1)
(if (null vlax-dump-object) (vl-load-com) )
(setq &ss1 '("LINE" "LWPOLYLINE" "CIRCLE" "ARC" "HELIX" "ELLIPSE" "SPLINE" "POLYLINE"))
;曲线有起点：直线，多段线，圆，圆弧，螺旋对象，椭圆，样条曲线，二维多段线
(if (and
  (setq &k1 (entsel "\n请选择曲线"))
  (setq &k1 (car &k1))
  (member (cdr (assoc 0 (entget &k1))) &ss1);确认是曲线
  (setq &p1 (getpoint "\n请选择指定点"))
  (setq &p1 (vlax-curve-getclosestpointto &k1 &p1));取得最近点
  (setq &n1 (vlax-curve-getParamAtPoint &k1 &p1));取得参数
  (setq &dis1 (vlax-curve-getDistAtParam &k1 &n1));到起点距离
     )

whophy

,大神出来帮帮忙，再次感谢！

whophy

大神出来帮帮忙，再次感谢！

xyccf

可惜，现在回答估计你也用不上了，想了想还是留给后来人吧^_^

2. ;获得两个选择集的交集
   
3. (defun ssinter (ss1 ss2)
   
4. (vl-cmdf "_.select" ss1 "r" ss2 "")
   
5. (setq ss (ssget "P"))
   
6. (vl-cmdf "_.select" ss1 "r" ss "")
   
7. (ssget "P")
   
8. )
   
9. ;线上测距 by xyccf
   
10. (defun c:qds (/ pt1 pt2 ss1 ss2 ss obj dist)
    
11.   (setq pt1 (getpoint "选择曲线上一点: ")
    
12.         pt2 (getpoint pt1 "\n选择曲线另上一点: ")
    
13.   )
    
14.   (setq ss1 (ssget "c" pt1 pt1)
    
15.   ss2 (ssget "c" pt2 pt2)
    
16.   ss (ssinter ss1 ss2)
    
17.   )
    
18.   (if (or (< (sslength ss) 0) (> (sslength ss) 1)) (exit))
    
19.   (setq obj (vlax-ename->vla-object  (ssname ss 0)))
    
20.   (setq dist (abs (- (vlax-curve-getDistAtPoint obj pt1) (vlax-curve-getDistAtPoint obj pt2))))
    
21.   (princ (strcat "\n曲线上两点距离为：" (rtos dist 2 4)))
    
22.   (princ)
    
23. )

;获得两个选择集的交集<br /> (defun ssinter (ss1 ss2)<br /> (vl-cmdf "_.select" ss1 "r" ss2 "")<br /> (setq ss (ssget "P"))<br /> (vl-cmdf "_.select" ss1 "r" ss "")<br /> (ssget "P")<br /> )<br /> ;线上测距 by xyccf<br /> (defun c:qds (/ pt1 pt2 ss1 ss2 ss obj dist)<br />   (setq pt1 (getpoint "选择曲线上一点: ")<br />         pt2 (getpoint pt1 "\n选择曲线另上一点: ")<br />   )<br />   (setq ss1 (ssget "c" pt1 pt1) <br />   ss2 (ssget "c" pt2 pt2)<br />   ss (ssinter ss1 ss2)<br />   )<br />   (if (or (< (sslength ss) 0) (> (sslength ss) 1)) (exit))<br />   (setq obj (vlax-ename->vla-object  (ssname ss 0)))<br />   (setq dist (abs (- (vlax-curve-getDistAtPoint obj pt1) (vlax-curve-getDistAtPoint obj pt2))))<br />   (princ (strcat "\n曲线上两点距离为：" (rtos dist 2 4)))<br />   (princ)<br /> )