感谢大家的回复，xshrimp的代码存在一点儿小瑕疵，加入是梯形，拉伸梯形的上边，随着拉伸这条变越来越短，最后变成0，再继续拉伸梯形的两条斜边就交叉了，如果能达到类似于cad中stretch的效果是最好的，我的思路点击这条边后可以得到这条变的多边形上的2个端点，然后调用cad的stretch命令，然后通过“F栏选”将这条边包含进去，然后拉伸？
本帖最后由 vormittag 于 2011-11-15 20:08 编辑
我简单写了一个，代码不一定健壮。楼主可以试试看是不是这个效果，只对lwpolyline有效。
(defun c:te(/ ell pename pt obj n ptlist ellpre ellpost pts pte pt1 p linename lineell)
(while (or (not (setq pename (entsel))) (/= (cdr (assoc 0 (setq ell (entget (car pename))))) "LWPOLYLINE"))
);while
(setq pt (cadr pename)
obj (vlax-ename->vla-object (car pename))
n (fix (vlax-curve-getParamAtPoint obj (vlax-curve-getClosestPointTo obj (trans pt 1 0))))
pts (nth n (apply 'append (mapcar '(lambda(x) (if (= 10 (car x)) (list (cdr x)))) ell)))
ellpre(member (cons 10 pts) (reverse ell))
ellpost (cdr (member (cons 10 pts) ell))
pte (cdr (assoc 10 ellpost))
p (grread t 4 0)
pt1 (cadr p)
);setq
(entmake (list '(0 . "LINE") (cons 10 (trans pt 1 0)) (cons 11 (trans pt1 1 0))))
(setq linename (entlast)
lineell(entget linename)
);setq
(while (= 5 (car p))
(setq p (grread t 4 0)
pt1 (cadr p)
vec (mapcar '- (trans pt1 1 0) (trans pt 1 0))
ellpre(subst (cons 10 (mapcar '+ vec pts)) (assoc 10 ellpre) ellpre)
ellpost (subst (cons 10 (mapcar '+ vec pte)) (assoc 10 ellpost) ellpost)
ell (append (reverse ellpre) ellpost)
lineell (subst (cons 11 (trans pt1 1 0)) (assoc 11 lineell) lineell)
);setq
(entmod ell)
(entmod lineell)
);while
(entdel linename)
(princ)
)
menger_8 发表于 2011-11-15 12:55 static/image/common/back.gif
感谢大家的回复，xshrimp的代码存在一点儿小瑕疵，加入是梯形，拉伸梯形的上边，随着拉伸这条变越来越短，最 ...
再写了一个,针对"POLYLINE"的(defun c:te(/ ell1 ell2 pename ename pt pts pte p pt1 lineename lineell)
(while (or (not (setq pename (nentsel))) (/= (cdr (assoc 0 (setq ell1 (entget (car pename))))) "VERTEX")))
(setq pt (cadr pename)
ename(cdr (assoc 330 ell1))
pts (cdr (assoc 10 ell1))
ell2 (entget (entnext (car pename)))
pte (cdr (assoc 10 ell2))
p (grread t 4 0)
pt1 (cadr p)
);setq
(entmake (list '(0 . "LINE") (cons 10 (trans pt 1 0)) (cons 11 (trans pt1 1 0))))
(setq linename (entlast)
lineell(entget linename)
);setq
(while (= 5 (car p))
(setq p (grread t 4 0)
pt1 (cadr p)
vec (mapcar '- (trans pt1 1 0) (trans pt 1 0))
ell1 (subst (cons 10 (mapcar '+ vec pts)) (assoc 10 ell1) ell1)
ell2 (subst (cons 10 (mapcar '+ vec pte)) (assoc 10 ell2) ell2)
lineell (subst (cons 11 (trans pt1 1 0)) (assoc 11 lineell) lineell)
);setq
(entmod ell1)
(entmod ell2)
(entupd ename)
(entmod lineell)
);while
(entdel linename)
(princ)
)图就不贴了，和上面没啥区别。
xshrimp 发表于 2011-11-9 15:22 static/image/common/back.gif
参考
确实可以。真的可以。太好了
每次拉伸能提示输入数值就好
一个矩形然后倒C角，拉伸倒角那边时想把C角一起拉伸，要是有这样程序就好了
xshrimp 发表于 2011-11-9 15:22 static/image/common/back.gif
参考
这个不错，如果能开启捕捉就好了，拉抻到捕捉点
大虾的程序，很好用啊！
8#楼主的 那个要是有捕捉功能就完美。
先收藏了~~~~~~~~~~~~~