[求助]***非常神的移动智能调整程序，高手不要错过！

wanhongron

下图中，最左为原图，中间图为本人预期希望实现图，最右边为程序实际结果图。工作中频繁遇到这样的动作，如图移动红色线条，青色线会自动延伸，黑色线会自动剪切，绿色线则不需要进行操作。注意以上线条颜色只是为了问题。

请高手优化以下几点：1.不剪切绿色线条（没被红线截断的线条）。2.红色线条（移动对象）推广至多段线。 3.红色线条（移动对象）推广至可以多选。

程序意图的就是在某些线条移动后，被其截断的线条（原来端点在这些线条上的线条）要保正端点继续在这些线条上，达不到的要延伸，超出的要剪切。

 

coverne

明总写的,标注尺寸驱动程式

ZZXXQQ

不用那么复杂吧？可以直接用stretch指令完成这个操作。

3. (defun c:tt ()
4. (setvar "CMDECHO" 0)
5. (IF (and (setq S1 (ENTSEL "\nSelect a Line :"))
6.           (setq ent (ENTGET(CAR S1)))
7.     (= (cdr(assoc 0 ent)) "LINE")) (progn
8.   (setq p1 (cdr(assoc 10 ent))
9.         p2 (cdr(assoc 11 ent)))
10.   (command ".stretch" "c" p1 p2 "" p1 pause)
11. ))
12. (setvar "CMDECHO" 1)
13. (princ)
14. )

(defun c:tt () (setvar "CMDECHO" 0) (IF (and (setq S1 (ENTSEL "\nSelect a Line :"))           (setq ent (ENTGET(CAR S1)))     (= (cdr(assoc 0 ent)) "LINE")) (progn   (setq p1 (cdr(assoc 10 ent))         p2 (cdr(assoc 11 ent)))   (command ".stretch" "c" p1 p2 "" p1 pause) )) (setvar "CMDECHO" 1) (princ) )

wanhongron

不愧是高手，能否加入以下功能：1.将红色线条（移动对象）推广至多段线；2.红色线条（移动对象）推广至可以多选。

ZZXXQQ

多选？怎么选？给个示意图看看。

wanhongron

请高手不吝赐教！！！两条红色多段线同时一起上移，其它端点在其上面的线条做相应剪切或延伸，以保证端点继续在各红色线条上。

ZZXXQQ

仅对5楼样图有效。

3. (defun c:tt ()
4.   (setvar "CMDECHO" 0)
5.   (IF (and (setq S1 (ENTSEL "\nSelect first Line :"))
6.            (setq ent (ENTGET(CAR S1)))
7.            (= (cdr(assoc 0 ent)) "LINE")
8.         (setq S2 (ENTSEL "\nSelect next line :"))
9.            (setq ent2 (entget(car s2)))
10.            (= (cdr (assoc 0 ent2)) "LINE")) (progn
11.    (setq p1 (cdr(assoc 10 ent))
12.          p2 (cdr(assoc 11 ent))
13.    P3 (cdr(assoc 10 ent2))
14.    p4 (cdr(assoc 11 ent2))
15.    pt1 (list (min (car p1) (car p2) (car p3) (car p4))
16.    (min (cadr p1) (cadr p2) (cadr p3) (cadr p4)))
17.    pt2 (list (max (car p1) (car p2) (car p3) (car p4))
18.    (max (cadr p1) (cadr p2) (cadr p3) (cadr p4))))
19.    (command ".stretch" "c" pt1 pt2 "" pt1 pause)
20.   ))
21.   (setvar "CMDECHO" 1)
22.   (princ)
23. )

(defun c:tt ()   (setvar "CMDECHO" 0)   (IF (and (setq S1 (ENTSEL "\nSelect first Line :"))            (setq ent (ENTGET(CAR S1)))            (= (cdr(assoc 0 ent)) "LINE")         (setq S2 (ENTSEL "\nSelect next line :"))            (setq ent2 (entget(car s2)))            (= (cdr (assoc 0 ent2)) "LINE")) (progn    (setq p1 (cdr(assoc 10 ent))          p2 (cdr(assoc 11 ent))    P3 (cdr(assoc 10 ent2))    p4 (cdr(assoc 11 ent2))    pt1 (list (min (car p1) (car p2) (car p3) (car p4))    (min (cadr p1) (cadr p2) (cadr p3) (cadr p4)))    pt2 (list (max (car p1) (car p2) (car p3) (car p4))    (max (cadr p1) (cadr p2) (cadr p3) (cadr p4))))    (command ".stretch" "c" pt1 pt2 "" pt1 pause)   ))   (setvar "CMDECHO" 1)   (princ) )

wanhongron

以上程序只能选直线，不能选多段线。我想功能应用范围扩大，红色线条如果能推广至能同时选多条直线、多段线及其它图元，其它线条跟着一起调整，就非常完美了。 

请高手重新过目，发挥你的光和热，这对我的工作非常有帮助，经常碰到这样的情况。谢谢！！！

T-bag

我看了半天S命令都可以实现你的要求啊，S一选，把不要拉伸的剔掉不就完事了。

wanhongron

是不是太难了，明经高手让我有点失望！！！

wanhongron

本来我对明经寄了很大希望，但是我觉得这个程序对真正的高手应该不算非常难，为什么那么多人看了都没有留言？