把每个矩形离指定点最近的端点与指定点连线
本帖最后由 开心无惧 于 2024-12-6 14:22 编辑请教大家 可以帮忙修改这段代码吗
功能：把每个矩形离指定点最近的端点与指定点连线；
本帖最后由 llsheng_73 于 2024-12-7 13:38 编辑
(defun c:tt(/ p p0 s e a)
(vl-load-com)
(and(setq s(ssget'((0 . "*polyline"))))
(setq p0(mapcar'+'(0 0)(getpoint"指定点")))
(while(setq e(ssname s 0))
(setq a(vlax-curve-getParamAtPoint e(vlax-curve-getclosestpointto e p0))
p(vlax-curve-getpointatparam e(+(if(>(- a(fix a))0.5)1 0)(fix a))))
(ssdel e s)
(entmakex(mapcar'cons'(0 100 100 8 62 90 70 10 10)(list"LWPOLYLINE""AcDbEntity""AcDbPolyline""连线"4 2 0 p p0))))))
带动态效果稍微麻烦些
(defun c:tt(/ p0 s lst pts)
(vl-load-com)
(and(setq s(ssget'((0 . "*polyline"))))
(while(setq e(ssname s 0))(ssdel e s)
(setq lst(cons e lst)))
(or(while(/=(car(setq p0(grread 5)))3)(redraw)
(setq p0(List(caadr p0)(cadadr p0))pts nil)
(vl-some(function(lambda(e / a p)
(setq a(vlax-curve-getParamAtPoint e(vlax-curve-getclosestpointto e p0))
p(vlax-curve-getpointatparam e(+(if(equal(fix a)a 0.5)0 1)(fix a)))
pts(cons(list p p0)pts))
(grdraw p p0 1)))lst))
(redraw)
(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
带动态效果稍微麻烦些
已经很好了，感谢！ llsheng_73 发表于 2024-12-6 15:03
带动态效果稍微麻烦些
利害，学习了。
页:
[1]