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

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

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

zml84 发表于 2012-10-29 11:17:01

本帖最后由 zml84 于 2012-10-29 11:24 编辑 <center><h1>2012-10-29框选对象，延伸一次.LSP</h1></center>
<script language="JavaScript">document.write("最后修改时间: " + document.lastModified)
</script>
<hr size="5"><pre>;;;=================================================================*
;;;问题来源：http://bbs.mjtd.com/thread-98171-1-1.html *
;;;=================================================================*
;;;功能：框选对象，自动延伸一次。 *
;;;日期：zml84 于 2012-10-29 11:12 *
(defun c:tt (/ ss i en ent pt10 pt11)
(setvar "EDGEMODE" 1) ;_设置系统变量
(setq i 0)
(if (setq ss (ssget))
(repeat (sslength ss)
 (setq en (ssname ss i)
 ent(entget en)
 pt10 (cdr (assoc 10 ent))
 pt11 (cdr (assoc 11 ent))
 )
 ;;调用命令
 (command "_extend" ss "" (list en pt10) "")
 (command "_extend" ss "" (list en pt11) "")
 (setq i (1+ i))
)
)
(princ)
)
;;;=================================================================*
(princ)
</pre>

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

把代码贴上来，有新需求可与我联系，我的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 -1data1 (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:19

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

页: [1] 2 3 4

明经CAD社区's Archiver

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