急求一个让直线等间距分布的程序！

theisland

有若干平行的直线长短不一，间距不等，能不能实现框选所有直线，然后两端的直线不动，程序自动移动中间的若干直线，最终实现各平行线之间间距相等？要求直线只在垂线方向移动，两端直线不动，在各种坐标系下均可完美运行，请高手出手相助！谢谢啦！

陈进佳

1. (defun c:tt(/ a b ddy dy i lst n nptlst ptlst ss ssn ylst)
   
2. (if
   
3.   (setq ss (ssget '((0 . "line"))))
   
4.   (progn
   
5.     (setq i   -1
   
6.           lst nil
   
7.     )
   
8.     (while (setq ssn (ssname ss (setq i (1+ i))))
   
9.       (setq lst (cons ssn lst))
   
10.     )
    
11.     (setq lst(vl-sort lst '(lambda(x y)(>(caddr(assoc 10 (entget x)))(caddr(assoc 10 (entget y)))))))
    
12.     (setq ptlst(mapcar '(lambda(x)(cdr(assoc 10 (entget x))))lst))
    
13.     (setq dy(- (setq a(cadr(car ptlst)))(setq b(cadr(last ptlst)))))
    
14.     (setq n(length lst)
    
15.           ddy(/ dy (1- n)))
    
16.    (setq ylst (list b))
    
17. (setq i 1)
    
18.    (repeat (1- n)
    
19.      (setq ylst(cons (+ b (* i ddy))ylst))
    
20.      (setq i (1+ i))
    
21.      )
    
22.     (setq nptlst(mapcar '(lambda(x y) (list (car x)y))ptlst ylst))
    
23.     (setq lst(mapcar 'list lst ptlst nptlst))
    
24.     (foreach a lst(command "move" (car a)""(cadr a)(last a)))
    
25.    
    
26.     )
    
27.   )
    
28. (princ)
    
29. )

(defun c:tt(/ a b ddy dy i lst n nptlst ptlst ss ssn ylst)<br /> (if<br />   (setq ss (ssget '((0 . "line"))))<br />   (progn<br />     (setq i   -1<br />           lst nil<br />     )<br />     (while (setq ssn (ssname ss (setq i (1+ i))))<br />       (setq lst (cons ssn lst))<br />     )<br />     (setq lst(vl-sort lst '(lambda(x y)(>(caddr(assoc 10 (entget x)))(caddr(assoc 10 (entget y)))))))<br />     (setq ptlst(mapcar '(lambda(x)(cdr(assoc 10 (entget x))))lst))<br />     (setq dy(- (setq a(cadr(car ptlst)))(setq b(cadr(last ptlst)))))<br />     (setq n(length lst)<br />           ddy(/ dy (1- n)))<br />    (setq ylst (list b))<br /> (setq i 1)<br />    (repeat (1- n)<br />      (setq ylst(cons (+ b (* i ddy))ylst))<br />      (setq i (1+ i))<br />      )<br />     (setq nptlst(mapcar '(lambda(x y) (list (car x)y))ptlst ylst))<br />     (setq lst(mapcar 'list lst ptlst nptlst))<br />     (foreach a lst(command "move" (car a)""(cadr a)(last a)))<br />     <br />     )<br />   )<br /> (princ)<br /> )

theisland

陈进佳 发表于 2016-3-27 10:54

没反应呢，麻烦再看看，测试图已上传

陈进佳

你一开始能表示清楚点或者给个示意图？

yoyoho

测试对平行X轴的平行线有效

theisland

陈进佳 发表于 2016-3-27 11:14
你一开始能表示清楚点或者给个示意图？

不好意思，测试图中只是世界坐标系的情况，请把其他坐标系的情况考虑进去，谢谢！

菜卷鱼

cad2011 测试，DIV 命令可以

Gray-wolf

查看附件

林小林子

cad2011 测试，DIV 命令可以

437271963

框选直线，等距分布。