两条线之间画等分线的代码需修正
这是在两条线之间画等分线的代码。我在使用时发现，它时而有效，时而得到混乱的结果，有请大师找出原因并改正;;两曲线等分
(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)
) bai2000 发表于 2014-12-16 21:28
怎么改改，可以输入等分的个数？
要是能实现这个功能，那就太完美了 ...(command "line"...
得考量 补捉效应... 有可能是啊！但短期无法证明，只有等用多了看是不是会出问题。等于这个代码使用时我要设为不捕捉 确实有问题 清风明月名字 发表于 2013-6-25 19:10 static/image/common/back.gif
有可能是啊！但短期无法证明，只有等用多了看是不是会出问题。等于这个代码使用时我要设为不捕捉
以下代码不用考虑捕捉和ucs
(defun c:tt (/ L1 L2 P1 P2 A1 D1 P3 P4 A2 D2 PL1 PL2 PTS)
(while(and
(setq l1 (car(entsel "\n选择直线1:")))
(= "LINE" (cdr (assoc 0 (setq l1 (entget l1)))))
(setq l2 (car(entsel "\n选择直线2:")))
(= "LINE" (cdr (assoc 0 (setq l2 (entget l2)))))
)
(setq p1 (cdr (assoc 10 l1))
p2 (cdr (assoc 11 l1))
a1 (angle p1 p2)
d1 (* 0.1 (distance p1 p2))
p3 (cdr (assoc 10 l2))
p4 (cdr (assoc 11 l2))
a2 (angle p3 p4)
d2 (* 0.1 (distance p3 p4))
pl1 (list p1)
pl2 (list p3)
)
(repeat 9
(setq pl1 (cons (setq p1 (polar p1 a1 d1)) pl1)
pl2 (cons (setq p3 (polar p3 a2 d2)) 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)
) 5楼的与原意不符。原意是针对任意两条线（LINE\SPLIN\多义线等），算出二者N的等分点，再将这些等分点相连（最好用两种可能都提供，一种是顺向相连，一种是反向相连）。
5楼的只对直线有效，适用 范围窄了。
谢谢5楼的回复！ 不知道是不是我只要设定不捕捉，即加上如下代码，就可以改正它的BUG
“; 关闭捕捉的代码，不关闭捕捉本插件会出错.如果再有错误，则很可能是因为没有设定为世界坐标系
(setvar "osmode" 0)”
我加了之后还没有出现过问题 清风明月名字 发表于 2013-6-26 09:55 static/image/common/back.gif
5楼的与原意不符。原意是针对任意两条线（LINE\SPLIN\多义线等），算出二者N的等分点，再将这些等分点相连（ ...
是你自己描述题意不准确！以下代码适用任意曲线！
请准确的描述一下何谓顺向相连，反向相连？是连线要交叉吗？如要交叉相连，只需将下面的代码pl2表reverse一下即可！
(defun c:tt (/ L1 L2 P1 P2 A1 D1 P3 P4 A2 D2 PL1 PL2 PTS)
(while (and (setq l1 (car (entsel "\n选择曲线1:")))
(setq l2 (car (entsel "\n选择曲线2:")))
)
(setq p1(vlax-curve-getStartPoint l1)
p2(vlax-curve-getEndPoint l1)
d1 (* 0.1 (vlax-curve-getDistAtParam l1 (vlax-curve-getEndParam l1)))
p3(vlax-curve-getStartPoint l2)
p4(vlax-curve-getEndPoint l2)
d2 (* 0.1 (vlax-curve-getDistAtParam l2 (vlax-curve-getEndParam l2)))
pl1 (list p1)
pl2 (list p3)
i 0
)
(repeat 9
(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)
) 本帖最后由 kwok 于 2013-6-26 15:27 编辑
G版写的完美。支持一下!
楼主的那个码我记得之前看过，记得有讨论在连线前指定每根线的起点，这样连起来的线就是按你指定的起点连了，所以你想顺连还是反向连就按你指定的起点，不过就是操作上多了要多点几下。
建议直接用G版的，如需反连,G版说代码pl2表reverse,加一下判断是反连或顺连就可以,如:输入F就反连，默认顺连. 怎么改改，可以输入等分的个数？
页:
[1]
2