求一个直线双向增长的程序，最好是LSP，谢谢！

freeok

求一个直线双向增长的程序，最好是LSP，谢谢！CAD只有单向增长的。
我没有币，不知道要怎么发帖，如有发错，请版主高抬贵手！帮我移动下。谢谢

zyhandw

简单写了个，如不合要求，请自行修改下

2. (defun c:dbllen ( / cd en enlst pt10 pt11 ang1 ang2 2pt10 2pt11)
   
3.   (setq cd (getreal"\n请输入要延长的距离:"))
   
4.   (setq en (car (entsel"\n 请选择直线: \n")))
   
5.   (setq enlst (entget en))
   
6.   (setq pt10 (cdr (assoc '10 enlst)))
   
7.   (setq pt11 (cdr (assoc '11 enlst)))
   
8.   (setq ang1 (angle pt10 pt11))
   
9.   (setq ang2 (angle pt11 pt10))
   
10.   (setq 2pt10 (polar pt10 ang2 cd))
    
11.   (setq 2pt11 (polar pt11 ang1 cd))
    
12.   (setq enlst (subst (cons '10 2pt10) (assoc '10 enlst) enlst))
    
13.   (setq enlst (subst (cons '11 2pt11) (assoc '11 enlst) enlst))
    
14.   (entmod enlst)
    
15.   (princ)
    
16. )

(defun c:dbllen ( / cd en enlst pt10 pt11 ang1 ang2 2pt10 2pt11)<br />   (setq cd (getreal"\n请输入要延长的距离:"))<br />   (setq en (car (entsel"\n 请选择直线: \n")))<br />   (setq enlst (entget en))<br />   (setq pt10 (cdr (assoc '10 enlst)))<br />   (setq pt11 (cdr (assoc '11 enlst)))<br />   (setq ang1 (angle pt10 pt11))<br />   (setq ang2 (angle pt11 pt10))<br />   (setq 2pt10 (polar pt10 ang2 cd))<br />   (setq 2pt11 (polar pt11 ang1 cd))<br />   (setq enlst (subst (cons '10 2pt10) (assoc '10 enlst) enlst))<br />   (setq enlst (subst (cons '11 2pt11) (assoc '11 enlst) enlst))<br />   (entmod enlst)<br />   (princ)<br /> )

freeok

谢谢zyhandw，可以使用！向您学习。

freeok

只可惜不能框选。。我试着改下，希望老大能再帮下忙，谢谢！

zyhandw

freeok 发表于 2012-11-10 14:29
只可惜不能框选。。我试着改下，希望老大能再帮下忙，谢谢！

加个repeat循环即可！！
给你个n年前初学lisp时写的能框选延长的：

freeok

今天真是幸运，网页跳个框让我去买彩票。没买，但是遇见一个大好人。真是太感谢了！
看来这彩票还是得去买啊。希望中个大奖，一定好好感谢您！
功能实现。谢谢！

zyhandw

freeok 发表于 2012-11-10 15:34
今天真是幸运，网页跳个框让我去买彩票。没买，但是遇见一个大好人。真是太感谢了！
看来这彩票还是 ...

太客气了，大家相互学习！

流氓兔

zyhandw 发表于 2012-11-10 15:05
加个repeat循环即可！！
给你个n年前初学lisp时写的能框选延长的：

这个有bug 如果你俩条线首尾想接，你会发现bug

仲文玉

可以改进下，这个数量多了就很慢，有bug自己想办法修复、改进下

zyhandw

流氓兔 发表于 2013-3-19 11:00
这个有bug 如果你俩条线首尾想接，你会发现bug

其实前面我已经说到了，加个repeat循环即可！
主函数里写repeat循环，用2楼的函数作子函数，很简单方便的就能实现批量，而且不会有你说的bug了！
你先自行改造下试试，实在弄不来，我可以给你改造源码。