由多段线的端点向另一条线求垂足，避免出现无效垂足

arches9

   这几天的工作任务是做一个宗地图的标注，要求把界址线上的点求得与下行线间的垂直距离，因为下行线分了好几条，而界址线贯穿一张图，我现在找到的代码出现的错误就是当界址线的水平长度和下行线长度一致时获得的垂足坐标是对的，但是代码默认是通过与界址点的下行线上最近一个点确定垂足，所以出现了有多个界址点得到的垂足坐标是下行线最末的端点，不知道代码怎么改合适呢？还有这样得到的垂足坐标（即程序中的pd）x和y值是2位或3位小数点，没有规律的，怎么设定一下使得精度能够自己设定呢？

2. (defun c:tes4 ( / pt sl pd ds )
   
3. (if (null vlax-dump-object) (vl-load-com)) ;;加载vlax扩展函数
   
4.   (setq ptd (HH:PTlists(car (entsel))));获得下行线的顶点串行
   
5. (setq ptb (HH:PTlists(car (entsel))));获得界址线的顶点串行
   
6.       (princ "\n点的数量：")(princ (length ptb))
   
7.   (setq sl (entsel "\n选择直线:")) ;;选择点和线)
   
8. (setq i 0)
   
9. (setq sl (vlax-ename->vla-object (car sl))) ;;转换直线为vla对象
   
10. (repeat (length ptb)
    
11.     (setq pt (nth i ptb))
    
12.       (setq pd (vlax-curve-getclosestpointto sl pt)) ;;求出直线上距选择点最近的点
    
13.       (command "_.line" pt pd "") ;;绘制出最短的距离线
    
14.       (setq ds (distance pt pd)) ;;求出两点距离
    
15.       (princ (strcat "\n点到该直线的最短距离是:< " (rtos ds) " >")) ;;输出最短距离
    
16.       (setq i (+ i 1))      
    
17.   )   
    
18. (princ) ;;静默退出
    
19. )

(defun c:tes4 ( / pt sl pd ds )<br /> (if (null vlax-dump-object) (vl-load-com)) ;;加载vlax扩展函数<br />   (setq ptd (HH:PTlists(car (entsel))));获得下行线的顶点串行<br /> (setq ptb (HH:PTlists(car (entsel))));获得界址线的顶点串行<br />       (princ "\n点的数量：")(princ (length ptb))<br />   (setq sl (entsel "\n选择直线:")) ;;选择点和线)<br /> (setq i 0)<br /> (setq sl (vlax-ename->vla-object (car sl))) ;;转换直线为vla对象<br /> (repeat (length ptb)<br />     (setq pt (nth i ptb))<br />       (setq pd (vlax-curve-getclosestpointto sl pt)) ;;求出直线上距选择点最近的点<br />       (command "_.line" pt pd "") ;;绘制出最短的距离线<br />       (setq ds (distance pt pd)) ;;求出两点距离<br />       (princ (strcat "\n点到该直线的最短距离是:< " (rtos ds) " >")) ;;输出最短距离<br />       (setq i (+ i 1))      <br />   )    <br /> (princ) ;;静默退出<br /> )

xyp1964

2. (defun c:tt ()
   
3.   (vl-load-com)
   
4.   (setq s1  (car (entsel "\n选择界址线: "))
   
5.         s2  (car (entsel "\n选择下行线: "))
   
6.         ptn (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget s1))
   
7.   )
   
8.   (foreach pt (mapcar 'cdr ptn)
   
9.     (setq p1 (vlax-curve-getclosestpointto s2 pt t))
   
10.     (command "_.line" "non" pt "non" p1 "")
    
11.   )
    
12.   (princ)
    
13. )

(defun c:tt ()<br />   (vl-load-com)<br />   (setq s1  (car (entsel "\n选择界址线: "))<br />         s2  (car (entsel "\n选择下行线: "))<br />         ptn (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget s1))<br />   )<br />   (foreach pt (mapcar 'cdr ptn)<br />     (setq p1 (vlax-curve-getclosestpointto s2 pt t))<br />     (command "_.line" "non" pt "non" p1 "")<br />   )<br />   (princ)<br /> )

arches9

xyp1964 发表于 2016-3-24 08:21

ptn (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget s1))
  )
请问这句是什么意思呀？
我贴了你的代码，发现界址线所有端点都和下行线外的一点连线了，所以想知道这句的意思

zhhunicorn

返回由所提供表中的所有能通过测试函数的元素组成的表

(vl-remove-if-not  predicate-function list)
参数

predicate-function

测试函数。它可以是任何一个这样的函数：接受单一参数，且对任何用户指定条件均返回 T。predicate-function 的值可以采用如下格式：

符号 (函数名)  
'(LAMBDA (A1 A2) ...)
(FUNCTION (LAMBDA (A1 A2) ...))
list

要测试的表。

返回值

表，其中包含 list 中的所有使 predicate-function 返回非 nil 值的元素。

示例

_$ (vl-remove-if-not 'vl-symbolp (list pi t 0 "abc"))
(T)
引自明经函数参考

arches9

多谢各位的帮助