求助-如何批量延伸到最近点

挪威的森林 · 发表于 2012-10-28 22:11

请教一下各位老师,我希望通过框选直线,让这些选中的直线自动延伸到最近点.能实现吗?
我在工作中经常要对大量的直线进行延伸,一个个选的话太慢了,希望哪位老师帮帮我.谢谢了!

chinawhy817 · 发表于 2012-10-29 07:33

把代码贴上来，有新需求可与我联系，我的QQ：40184454
纯LISP写的，有点拿不出手哦。。。

===============================================
(defun Dk:PtRelateLine (Pt1 Pt2 Pt3 / Dis12 Dis13 Dis23)
(cond ((= (rtos (setq Dis12 (distance Pt1 Pt2)) 2 5) "0.00000") 1)
   ((= (rtos (setq Dis13 (distance Pt1 Pt3)) 2 5) "0.00000") 2)
   ((= (rtos (+ Dis12 Dis13) 2 5) (rtos (setq Dis23 (distance Pt2 Pt3)) 2 5)) 4)
   ((= (rtos (+ Dis13 Dis23) 2 5) (rtos Dis12 2 5)) 8)
   ((= (rtos (+ Dis12 Dis23) 2 5) (rtos Dis13 2 5)) 16)
   (t 32)))

(defun C:EXT (/ n s j dxf_a a10 a11 k data1 data2 dxf_b b10 b11 insect d1 d2 index)
  (setq n (sslength (setq s (ssget '((0 . "LINE"))))))
  (setq j -1)
  (while (< (setq j (1+ j)) n)
(setq dxf_a (entget (ssname s j)))
(setq a10 (cdr (assoc 10 dxf_a)))
(setq a11 (cdr (assoc 11 dxf_a)))
(setq k -1  data1 (list) data2 (list))
(while (< (setq k (1+ k)) n)
   (setq dxf_b (entget (ssname s k)))
   (if (/= (cdr (assoc 5 dxf_a)) (cdr (assoc 5 dxf_b)))
(progn
   (setq b10 (cdr (assoc 10 dxf_b)) b11 (cdr (assoc 11 dxf_b)))
   (if (null (inters a10 a11 b10 b11))
      (progn
      (if (setq insect (inters a10 a11 b10 b11 nil))
(progn
   (if (/= 0 (logand 7 (Dk:PtRelateLine insect b10 b11)))
      (progn
      (cond ((> (setq d1 (distance insect a10))(setq d2 (distance insect a11)))
      (setq data1 (append data1 (list (list d2 insect 11)))))
      ((setq data2 (append data2 (list (list d1 insect 10))))))
      ))
   )) ;end if (setq insect (inters a10 a11 b10 b11 nil))
      )) ;end if (null (inters a10 a11 b10 b11))
   )) ;end if (/= (cdr (assoc 5 dxf_a)) (cdr (assoc 5 dxf_b)))
   ) ;end while

(if (> (length data1) 0)
   (progn
(setq data1 (vl-sort data1 '(lambda (X Y) (< (car X)(car Y)))))
(setq index (last (car data1)))
(entmod (setq dxf_a (subst (cons index (cadr (car data1)))(assoc index dxf_a) dxf_a)))
)
   )

(if (> (length data2) 0)
   (progn
(setq data2 (vl-sort data2 '(lambda (X Y) (< (car X)(car Y)))))
(setq index (last (car data2)))
(entmod (subst (cons index (cadr (car data2)))(assoc index dxf_a) dxf_a))
)
   )
) ;end while
  (princ))

小小的人 · 发表于 2020-5-8 21:41

chinawhy817 发表于 2012-10-29 07:33
把代码贴上来，有新需求可与我联系，我的QQ：40184454
纯LISP写的，有点拿不出手哦。。。

非常感谢哥哥的分享这么好用的程序我现在才找到各家论坛搜了好久终于搜到了太感谢了

999999 · 发表于 2021-5-24 08:59

chinawhy817 发表于 2012-10-29 07:33
把代码贴上来，有新需求可与我联系，我的QQ：40184454
纯LISP写的，有点拿不出手哦。。。

大神，我这边用了您写的插件，很好用，请问是否可以增加一个，外框可以是多段线，内部线段也可以是多段线也能实现这个功能呢

chinawhy817 · 发表于 2012-10-28 22:45

延伸到最近点，“最近点”做如何解？？？
弄个图示意一下，应该不难。。
写个LISP遍历处理一下即可。

挪威的森林 · 发表于 2012-10-28 23:01

自己不会做图,论坛里找来的图片,类似于这个效果,我只需要中间这些线延伸到离它最近的线就可以了,四周的导角不需要

flytoday · 发表于 2012-10-29 00:01

这个功能好伸至最近点最好…

chinawhy817 · 发表于 2012-10-29 01:09

所选的对象只限直线是吧？数量会不会很大？
用嵌套遍历,不过算法比较复杂。。
迫切需要此功能？

chinawhy817 · 发表于 2012-10-29 01:11

既然论坛能找来此图片，相关的代码应该早有了，你找此图的主子求助呗

chinawhy817 · 发表于 2012-10-29 06:51

我用纯LISP写了一个，如果所选的对象只限直线，效果如下图，如果满意请联系我...

挪威的森林 · 发表于 2012-10-29 07:08

chinawhy817 发表于 2012-10-29 06:51
我用纯LISP写了一个，如果所选的对象只限直线，效果如下图，如果满意请联系我...

真的非常感谢,一大早就给我回复,你做的这个效果很好,适合我需要,能分享一下你的程序吗

挪威的森林 · 发表于 2012-10-29 08:30

chinawhy817 发表于 2012-10-29 07:33
把代码贴上来，有新需求可与我联系，我的QQ：40184454
纯LISP写的，有点拿不出手哦。。。

虽然看不懂代码内容,但是经过测试已经符合我的目的,再次谢谢你

账号		自动登录	找回密码
密码			注册

求助-如何批量延伸到最近点

相关帖子

评分

本帖子中包含更多资源

本帖子中包含更多资源