把每个矩形离指定点最近的端点与指定点连线

开心无惧

请教大家 可以帮忙修改这段代码吗
功能：把每个矩形离指定点最近的端点与指定点连线；

llsheng_73

1. (defun c:tt(/ p p0 s e a)
   
2.   (vl-load-com)
   
3.   (and(setq s(ssget'((0 . "*polyline"))))
   
4.       (setq p0(mapcar'+'(0 0)(getpoint"指定点")))
   
5.       (while(setq e(ssname s 0))
   
6.         (setq a(vlax-curve-getParamAtPoint e(vlax-curve-getclosestpointto e p0))
   
7.               p(vlax-curve-getpointatparam e(+(if(>(- a(fix a))0.5)1 0)(fix a))))
   
8.         (ssdel e s)
   
9.         (entmakex(mapcar'cons'(0 100 100 8 62 90 70 10 10)(list"LWPOLYLINE""AcDbEntity""AcDbPolyline""连线"4 2 0 p p0))))))

(defun c:tt(/ p p0 s e a)<br />   (vl-load-com)<br />   (and(setq s(ssget'((0 . "*polyline"))))<br />       (setq p0(mapcar'+'(0 0)(getpoint"指定点")))<br />       (while(setq e(ssname s 0))<br />         (setq a(vlax-curve-getParamAtPoint e(vlax-curve-getclosestpointto e p0))<br />               p(vlax-curve-getpointatparam e(+(if(>(- a(fix a))0.5)1 0)(fix a))))<br />         (ssdel e s)<br />         (entmakex(mapcar'cons'(0 100 100 8 62 90 70 10 10)(list"LWPOLYLINE""AcDbEntity""AcDbPolyline""连线"4 2 0 p p0))))))

带动态效果稍微麻烦些

1. (defun c:tt(/ p0 s lst pts)
   
2.   (vl-load-com)
   
3.   (and(setq s(ssget'((0 . "*polyline"))))
   
4.       (while(setq e(ssname s 0))(ssdel e s)
   
5.   (setq lst(cons e lst)))
   
6.       (or(while(/=(car(setq p0(grread 5)))3)(redraw)
   
7.      (setq p0(List(caadr p0)(cadadr p0))pts nil)
   
8.      (vl-some(function(lambda(e / a p)
   
9.           (setq a(vlax-curve-getParamAtPoint e(vlax-curve-getclosestpointto e p0))
   
10.           p(vlax-curve-getpointatparam e(+(if(equal(fix a)a 0.5)0 1)(fix a)))
    
11.           pts(cons(list p p0)pts))
    
12.           (grdraw p p0 1)))lst))
    
13.    (redraw)
    
14.    (vl-every(function(lambda(x)(entmakex(mapcar'cons'(0 100 100 8 62 90 70 10 10)(list"LWPOLYLINE""AcDbEntity""AcDbPolyline""连线" 3 2 0(car x)(cadr x))))))pts))))

(defun c:tt(/ p0 s lst pts)<br />   (vl-load-com)<br />   (and(setq s(ssget'((0 . "*polyline"))))<br />       (while(setq e(ssname s 0))(ssdel e s)<br />   (setq lst(cons e lst)))<br />       (or(while(/=(car(setq p0(grread 5)))3)(redraw)<br />      (setq p0(List(caadr p0)(cadadr p0))pts nil)<br />      (vl-some(function(lambda(e / a p)<br />           (setq a(vlax-curve-getParamAtPoint e(vlax-curve-getclosestpointto e p0))<br />           p(vlax-curve-getpointatparam e(+(if(equal(fix a)a 0.5)0 1)(fix a)))<br />           pts(cons(list p p0)pts))<br />           (grdraw p p0 1)))lst))<br />    (redraw)<br />    (vl-every(function(lambda(x)(entmakex(mapcar'cons'(0 100 100 8 62 90 70 10 10)(list"LWPOLYLINE""AcDbEntity""AcDbPolyline""连线" 3 2 0(car x)(cadr x))))))pts))))

开心无惧

llsheng_73 发表于 2024-12-6 15:03

这也太棒了，非常感谢！

开心无惧

llsheng_73 发表于 2024-12-6 15:03
带动态效果稍微麻烦些

已经很好了，感谢！

season_88

llsheng_73 发表于 2024-12-6 15:03
带动态效果稍微麻烦些

利害，学习了。