怎样实现多义线的随意拉伸

menger_8 · 发表于 2011-11-15 12:55:59

感谢大家的回复，xshrimp的代码存在一点儿小瑕疵，加入是梯形，拉伸梯形的上边，随着拉伸这条变越来越短，最后变成0，再继续拉伸梯形的两条斜边就交叉了，如果能达到类似于cad中stretch的效果是最好的，我的思路点击这条边后可以得到这条变的多边形上的2个端点，然后调用cad的stretch命令，然后通过“F栏选”将这条边包含进去，然后拉伸？

vormittag · 发表于 2011-11-15 20:03:24

本帖最后由 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)
)

(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) 
)

vormittag · 发表于 2011-11-16 13:20:58

menger_8 发表于 2011-11-15 12:55
感谢大家的回复，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)
)

(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) 
)

图就不贴了，和上面没啥区别。

434939575 · 发表于 2012-2-18 16:18:02

xshrimp 发表于 2011-11-9 15:22
参考

确实可以。真的可以。太好了

cj52000 · 发表于 2012-2-18 18:50:55

每次拉伸能提示输入数值就好

cj52000 · 发表于 2012-2-18 18:56:24

一个矩形然后倒C角，拉伸倒角那边时想把C角一起拉伸，要是有这样程序就好了

kwok · 发表于 2013-5-13 20:11:18

xshrimp 发表于 2011-11-9 15:22
参考

这个不错，如果能开启捕捉就好了，拉抻到捕捉点

vlisp2012 · 发表于 2013-5-13 20:38:55

大虾的程序，很好用啊！

hehoubin · 发表于 2013-5-16 13:27:17

8#楼主的那个要是有捕捉功能就完美。

baiyier1112 · 发表于 2013-6-6 15:02:08

先收藏了~~~~~~~~~~~~~

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

[已解答] 怎样实现多义线的随意拉伸

本帖子中包含更多资源

浏览过的版块