两条线之间画等分线的代码需修正

清风明月名字

这是在两条线之间画等分线的代码。我在使用时发现，它时而有效，时而得到混乱的结果，有请大师找出原因并改正

dabingrain

;;两曲线等分
(defun c:tt (/ dis L1 L2 P1 P2 A1 D1 P3 P4 A2 D2 PL1 PL2 PTS)
        (princ "\n两曲线等分：")
  (while (and
                                         (setq l1 (car (entsel "\r选择曲线1:")))
                                         (setq l2 (car (entsel "\r选择曲线2:")))
                                         (setq dis (getint "\r请输入等分份数(≥1):"))
                                 )
    (setq
                        p1  (vlax-curve-getStartPoint l1)
                        p2  (vlax-curve-getEndPoint l1)
                        d1 (* (/ 1.0 dis) (vlax-curve-getDistAtParam l1 (vlax-curve-getEndParam l1)))
                        p3  (vlax-curve-getStartPoint l2)
                        p4  (vlax-curve-getEndPoint l2)
                        d2 (* (/ 1.0 dis)  (vlax-curve-getDistAtParam l2 (vlax-curve-getEndParam l2)))
                        pl1 (list p1)
                        pl2 (list p3)
                        i 0
                )
    (repeat dis
      (setq i (1+ i)
                                pl1 (cons (vlax-curve-getpointatdist l1 (* d1 i)) pl1)
                                pl2 (cons (vlax-curve-getpointatdist l2 (* d2 i)) pl2)
                        )
                )
    (setq pl1 (cons p2 pl1)
                        pl2 (cons p4 pl2)
                )
    (if (inters (car pl1) (car pl2) (last pl1) (last pl2))
      (setq pl2 (reverse pl2))
                )
    (setq pts (mapcar 'list pl1 pl2))
    (mapcar
      '(lambda (x)
         (entmake
           (list '(0 . "line") (cons 10 (car x)) (cons 11 (cadr x)))
                                 )
                         )
      pts
                )
        )
  (princ)
)

20060510412

bai2000 发表于 2014-12-16 21:28
怎么改改，可以输入等分的个数？

要是能实现这个功能，那就太完美了

Andyhon

...(command "line"...

得考量 补捉效应...

清风明月名字

有可能是啊！但短期无法证明，只有等用多了看是不是会出问题。等于这个代码使用时我要设为不捕捉

yaokui25

确实有问题

Gu_xl

清风明月名字 发表于 2013-6-25 19:10
有可能是啊！但短期无法证明，只有等用多了看是不是会出问题。等于这个代码使用时我要设为不捕捉

以下代码不用考虑捕捉和ucs

1. (defun c:tt (/ L1 L2 P1 P2 A1 D1 P3 P4 A2 D2 PL1 PL2 PTS)
   
2.   (while(and
   
3.           (setq l1 (car(entsel "\n选择直线1:")))
   
4.           (= "LINE" (cdr (assoc 0 (setq l1 (entget l1)))))
   
5.           (setq l2 (car(entsel "\n选择直线2:")))
   
6.           (= "LINE" (cdr (assoc 0 (setq l2 (entget l2)))))
   
7.           )
   
8.     (setq p1 (cdr (assoc 10 l1))
   
9.           p2 (cdr (assoc 11 l1))
   
10.           a1 (angle p1 p2)
    
11.           d1 (* 0.1 (distance p1 p2))
    
12.           p3 (cdr (assoc 10 l2))
    
13.           p4 (cdr (assoc 11 l2))
    
14.           a2 (angle p3 p4)
    
15.           d2 (* 0.1 (distance p3 p4))
    
16.           pl1 (list p1)
    
17.           pl2 (list p3)
    
18.           )
    
19.     (repeat 9
    
20.       (setq pl1 (cons (setq p1 (polar p1 a1 d1)) pl1)
    
21.             pl2 (cons (setq p3 (polar p3 a2 d2)) pl2)
    
22.             )
    
23.       )
    
24.     (setq pl1 (cons p2 pl1)
    
25.           pl2 (cons p4 pl2)
    
26.           )
    
27.     (if (inters (car pl1) (car pl2) (last pl1) (last pl2))
    
28.       (setq pl2 (reverse pl2))
    
29.       )
    
30.     (setq pts (mapcar 'list pl1 pl2))
    
31.     (mapcar
    
32.       '(lambda (x)
    
33.          (entmake
    
34.            (list
    
35.              '(0 . "line")
    
36.              (cons 10 (car x))
    
37.              (cons 11 (cadr x))
    
38.              )
    
39.            )
    
40.          )
    
41.       pts
    
42.       )
    
43.     )
    
44. (princ)         
    
45.   )

(defun c:tt (/ L1 L2 P1 P2 A1 D1 P3 P4 A2 D2 PL1 PL2 PTS)<br />   (while(and<br />           (setq l1 (car(entsel "\n选择直线1:")))<br />           (= "LINE" (cdr (assoc 0 (setq l1 (entget l1)))))<br />           (setq l2 (car(entsel "\n选择直线2:")))<br />           (= "LINE" (cdr (assoc 0 (setq l2 (entget l2)))))<br />           )<br />     (setq p1 (cdr (assoc 10 l1))<br />           p2 (cdr (assoc 11 l1))<br />           a1 (angle p1 p2)<br />           d1 (* 0.1 (distance p1 p2))<br />           p3 (cdr (assoc 10 l2))<br />           p4 (cdr (assoc 11 l2))<br />           a2 (angle p3 p4)<br />           d2 (* 0.1 (distance p3 p4))<br />           pl1 (list p1)<br />           pl2 (list p3)<br />           )<br />     (repeat 9<br />       (setq pl1 (cons (setq p1 (polar p1 a1 d1)) pl1)<br />             pl2 (cons (setq p3 (polar p3 a2 d2)) pl2)<br />             )<br />       )<br />     (setq pl1 (cons p2 pl1)<br />           pl2 (cons p4 pl2)<br />           )<br />     (if (inters (car pl1) (car pl2) (last pl1) (last pl2))<br />       (setq pl2 (reverse pl2))<br />       )<br />     (setq pts (mapcar 'list pl1 pl2))<br />     (mapcar<br />       '(lambda (x)<br />          (entmake<br />            (list<br />              '(0 . "line")<br />              (cons 10 (car x))<br />              (cons 11 (cadr x))<br />              )<br />            )<br />          )<br />       pts<br />       )<br />     )<br /> (princ)          <br />   )

清风明月名字

5楼的与原意不符。原意是针对任意两条线（LINE\SPLIN\多义线等），算出二者N的等分点，再将这些等分点相连（最好用两种可能都提供，一种是顺向相连，一种是反向相连）。
5楼的只对直线有效，适用 范围窄了。
谢谢5楼的回复！

清风明月名字

不知道是不是我只要设定不捕捉，即加上如下代码，就可以改正它的BUG
“; 关闭捕捉的代码，不关闭捕捉本插件会出错.如果再有错误，则很可能是因为没有设定为世界坐标系
   (setvar "osmode" 0)”
我加了之后还没有出现过问题

Gu_xl

清风明月名字 发表于 2013-6-26 09:55
5楼的与原意不符。原意是针对任意两条线（LINE\SPLIN\多义线等），算出二者N的等分点，再将这些等分点相连（ ...

是你自己描述题意不准确！以下代码适用任意曲线！
请准确的描述一下何谓顺向相连，反向相连？是连线要交叉吗？如要交叉相连，只需将下面的代码pl2表reverse一下即可！

1. (defun c:tt (/ L1 L2 P1 P2 A1 D1 P3 P4 A2 D2 PL1 PL2 PTS)
   
2.   (while (and (setq l1 (car (entsel "\n选择曲线1:")))
   
3.               (setq l2 (car (entsel "\n选择曲线2:")))
   
4.               )
   
5.     (setq p1  (vlax-curve-getStartPoint l1)
   
6.           p2  (vlax-curve-getEndPoint l1)
   
7.           d1 (* 0.1 (vlax-curve-getDistAtParam l1 (vlax-curve-getEndParam l1)))
   
8.           p3  (vlax-curve-getStartPoint l2)
   
9.           p4  (vlax-curve-getEndPoint l2)
   
10.           d2 (* 0.1 (vlax-curve-getDistAtParam l2 (vlax-curve-getEndParam l2)))
    
11.           pl1 (list p1)
    
12.           pl2 (list p3)
    
13.           i 0
    
14.           )
    
15.     (repeat 9
    
16.       (setq i (1+ i)
    
17.             pl1 (cons (vlax-curve-getpointatdist l1 (* d1 i)) pl1)
    
18.             pl2 (cons (vlax-curve-getpointatdist l2 (* d2 i)) pl2)
    
19.             )
    
20.       )
    
21.     (setq pl1 (cons p2 pl1)
    
22.           pl2 (cons p4 pl2)
    
23.           )
    
24.     (if (inters (car pl1) (car pl2) (last pl1) (last pl2))
    
25.       (setq pl2 (reverse pl2))
    
26.       )
    
27.     (setq pts (mapcar 'list pl1 pl2))
    
28.     (mapcar
    
29.       '(lambda (x)
    
30.          (entmake
    
31.            (list '(0 . "line") (cons 10 (car x)) (cons 11 (cadr x)))
    
32.            )
    
33.          )
    
34.       pts
    
35.       )
    
36.     )
    
37.   (princ)
    
38.   )

(defun c:tt (/ L1 L2 P1 P2 A1 D1 P3 P4 A2 D2 PL1 PL2 PTS)<br />   (while (and (setq l1 (car (entsel "\n选择曲线1:")))<br />               (setq l2 (car (entsel "\n选择曲线2:")))<br />               )<br />     (setq p1  (vlax-curve-getStartPoint l1)<br />           p2  (vlax-curve-getEndPoint l1)<br />           d1 (* 0.1 (vlax-curve-getDistAtParam l1 (vlax-curve-getEndParam l1)))<br />           p3  (vlax-curve-getStartPoint l2)<br />           p4  (vlax-curve-getEndPoint l2)<br />           d2 (* 0.1 (vlax-curve-getDistAtParam l2 (vlax-curve-getEndParam l2)))<br />           pl1 (list p1)<br />           pl2 (list p3)<br />           i 0<br />           )<br />     (repeat 9<br />       (setq i (1+ i)<br />             pl1 (cons (vlax-curve-getpointatdist l1 (* d1 i)) pl1)<br />             pl2 (cons (vlax-curve-getpointatdist l2 (* d2 i)) pl2)<br />             )<br />       )<br />     (setq pl1 (cons p2 pl1)<br />           pl2 (cons p4 pl2)<br />           )<br />     (if (inters (car pl1) (car pl2) (last pl1) (last pl2))<br />       (setq pl2 (reverse pl2))<br />       )<br />     (setq pts (mapcar 'list pl1 pl2))<br />     (mapcar<br />       '(lambda (x)<br />          (entmake<br />            (list '(0 . "line") (cons 10 (car x)) (cons 11 (cadr x)))<br />            )<br />          )<br />       pts<br />       )<br />     )<br />   (princ)<br />   )

kwok

G版写的完美。支持一下!
楼主的那个码我记得之前看过，记得有讨论在连线前指定每根线的起点，这样连起来的线就是按你指定的起点连了，所以你想顺连还是反向连就按你指定的起点，不过就是操作上多了要多点几下。
建议直接用G版的，如需反连,G版说代码pl2表reverse,加一下判断是反连或顺连就可以,如:输入F就反连，默认顺连.

bai2000

怎么改改，可以输入等分的个数？