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

挪威的森林

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

zml84

2012-10-29框选对象，延伸一次.LSP

---

;;;=================================================================*
;;;问题来源：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)

chinawhy817

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

小小的人

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

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

chinawhy817

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

挪威的森林

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

flytoday

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

chinawhy817

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

chinawhy817

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

chinawhy817

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

挪威的森林

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

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

挪威的森林

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

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