怎么改改，可以输入等分的个数？
要是能实现这个功能，那就太完美了 ;;两曲线等分
(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)
)
页:
1
[2]