请教各位大神如何让多段线的节点自动匹配到多边形最近的节点

gduthy

请教各位大神如何让多段线的节点自动匹配到多边形最近的节点

夏生生

试试

2. (defun c:test ( )
   
3.   (defun xty-get-plptlist (en /)
   
4.     (mapcar 'cdr
   
5.             (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget en))
   
6.     )
   
7.   )
   
8.   (setq        en1 (vlax-ename->vla-object (car (entsel "\n原状:")))
   
9.         en2 (car (entsel "\n匹配:"))
   
10.         lst (xty-get-plptlist en2)
    
11.         n   (fix (vlax-curve-getendparam en1))
    
12.         i   0
    
13.   )
    
14.   (repeat n
    
15.     (setq pt (vlax-curve-getpointatparam en1 i)
    
16.           pt (car
    
17.                (vl-sort        lst
    
18.                         '(lambda (x y) (< (distance pt x) (distance pt y)))
    
19.                )
    
20.              )
    
21.     )
    
22.     (vla-put-coordinate
    
23.       en1
    
24.       i
    
25.       (vlax-safearray-fill
    
26.         (vlax-make-safearray vlax-vbDouble '(0 . 1))
    
27.         (list (car pt) (cadr pt))
    
28.       )
    
29.     )
    
30.     (setq i (1+ i))
    
31.   )
    
32. )

(defun c:test ( )<br />   (defun xty-get-plptlist (en /)<br />     (mapcar 'cdr<br />             (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget en))<br />     )<br />   )<br />   (setq        en1 (vlax-ename->vla-object (car (entsel "\n原状:")))<br />         en2 (car (entsel "\n匹配:"))<br />         lst (xty-get-plptlist en2)<br />         n   (fix (vlax-curve-getendparam en1))<br />         i   0<br />   )<br />   (repeat n<br />     (setq pt (vlax-curve-getpointatparam en1 i)<br />           pt (car<br />                (vl-sort        lst<br />                         '(lambda (x y) (< (distance pt x) (distance pt y)))<br />                )<br />              )<br />     )<br />     (vla-put-coordinate<br />       en1<br />       i<br />       (vlax-safearray-fill<br />         (vlax-make-safearray vlax-vbDouble '(0 . 1))<br />         (list (car pt) (cadr pt))<br />       )<br />     )<br />     (setq i (1+ i))<br />   )<br /> )

gduthy

夏生生 发表于 2021-12-18 21:18
试试

完美达到我想要的效果了，非常感谢！

tdl555

沙发我坐！ 学习中！

zhangkui9070

特别棒，很好

小小小学生

xyp1964

1. (defun c:tt ()
   
2. (setq s1  (car (entsel "\n原状线:"))
   
3.        s2  (car (entsel "\n匹配线:"))
   
4.        ptn (xyp-Vertexs s1 0)
   
5. )
   
6. (foreach pt (xyp-Vertexs s2 0)
   
7.   (setq n (vl-position (xyp-PtNearPtn pt ptn) ptn))
   
8.   (xyp-Put-Coordinate s1 n pt)
   
9. )
   
10. (princ)
    
11. )
    

(defun c:tt ()<br /> (setq s1  (car (entsel "\n原状线:"))<br />        s2  (car (entsel "\n匹配线:"))<br />        ptn (xyp-Vertexs s1 0)<br /> )<br /> (foreach pt (xyp-Vertexs s2 0)<br />   (setq n (vl-position (xyp-PtNearPtn pt ptn) ptn))<br />   (xyp-Put-Coordinate s1 n pt)<br /> )<br /> (princ)<br /> )<br />

〓桠枫〓/db

厉害了，很好~~~~