求帮忙看段代码,关于线段等分的
代码功能,两线段N等分并且将各等分点顺序连接起来。目前该段代码在10等分以内功能都正常,超过10等分就会错乱(有时正常有时不正常)。。求解求完善
如下图,6等分情况
如下图,15等分情况(线段都是乱的)
代码情况如下:
(defun C:linkdivide( / s1 ename1 vla_obj1 s2 ename2 vla_obj2 n
points1 points2 p1 p2 d1 d2 start1 end1
start2 end2 k1 j1 k2 j2 link_points i pp1 pp2 )
(setqold_error *error*
*error*error
) ;setq
(setqold_cmdecho (getvar "CMDECHO")) ;setq
(setvar "CMDECHO" 0)
(command "_.UNDO" "_BE")
(princ "\n本程序等分两曲线后将等分点顺序连接。")
(setq s1 nil)
(while (not s1)
(setq s1 (entsel "\n请选取第一条曲线:"))
(if (not s1)
(princ "\n未选中第一条曲线,请重新选取。")
)
)
(setq ename1 (car s1)
vla_obj1 (vlax-ename->vla-object ename1)
)
(setq s0 (ssadd))
(ssadd ename1 s0)
(command "._SELECT" s0)
(setq p1 (getpoint "\n请选取第一条曲线的连接起始位置:"))
(setq s2 nil)
(while (not s2)
(setq s2 (entsel "\n请选取第二条曲线:"))
(if (not s2)
(princ "\n未选中第二条曲线,请重新选取。")
)
)
(setq ename2 (car s2)
vla_obj2 (vlax-ename->vla-object ename2)
)
(ssadd ename2 s0)
(command "" "._SELECT" s0)
(setq p2 (getpoint "\n请选取第二条曲线的连接起始位置:"))
(setq n nil)
(while (not n)
(setq n (getint "\n输入等分数:"))
(if (not n)
(princ "\n等分数输入不正确,请重新输入。")
)
)
(command "")
(setq points1 (get_points vla_obj1 n);;第一条曲线等分点表
points2 (get_points vla_obj2 n);;第二条曲线等分点表
start1 (nth 0 points1);;第一条曲线起点
end1 (nth n points1) ;;第一条曲线终点
start2 (nth 0 points2);;第二条曲线起点
end2 (nth n points2) ;;第二条曲线终点
)
(if p1 ;;如果输入了第一条曲线的连接起始位置
;;根据距离远近判断连接起始位置
(progn
(setq d1 (distance p1 start1)
d2 (distance p1 end1)
)
(if (< d1 d2)
(setq k1 0
j1 1
)
(setq k1 n
j1 -1
)
);;if
);;progn
;;否则取起始点为连接起始位置
(setq k1 0
j1 1
)
)
(if p2 ;;如果输入了第二条曲线的连接起始位置
;;根据距离远近判断连接起始位置
(progn
(setq d1 (distance p2 start2)
d2 (distance p2 end2)
)
(if (< d1 d2)
(setq k2 0
j2 1
)
(setq k2 n
j2 -1
)
);;if
);;progn
;;否则取起始点为连接起始位置
(setq k2 0
j2 1
)
)
(setq pp1 (nth k1 points1);;第一条曲线连接起点
pp2 (nth k2 points2);;第二条曲线连接起点
link_points (list (list pp1 pp2));;将连接点对放入表中
i 1
)
(command "line" pp1 pp2 "")
(while (<= i n)
(setq pp1 (nth (+ k1 (* j1 i)) points1)
pp2 (nth (+ k2 (* j2 i)) points2)
link_points (append link_points (list (list pp1 pp2)));;将连接点对放入表中
i (1+ i)
)
(command "line" pp1 pp2 "")
)
(redraw)
(command "._UNDO" "_E")
(setvar "CMDECHO" old_cmdecho)
(setq *error* old_error)
(princ)
)
;;;得到曲线vla_objn等分后的点表
(defun get_points( vla_obj n / startpoint endpoint obj_length dist points i point )
(setq startpoint (vlax-curve-getStartPoint vla_obj)
endpoint (vlax-curve-getEndPoint vla_obj)
obj_length (vlax-curve-getDistAtPoint vla_obj endpoint)
dist (/ obj_length n)
points (list startpoint)
i 1
)
(princ "\n dist:"
(princ dist)
;;按等分距离依次得到等分点
(while (< i n)
(setq point (vlax-curve-getPointAtDist vla_obj (* dist i))
points (append points (list point))
i (1+ i)
)
)
(setq points (append points (list endpoint)))
points
)
http://bbs.mjtd.com/xwb/images/bgimg/icon_logo.png 该贴已经同步到 矮油这是哪里啊3的微博 求小伙伴帮忙 矮油这是哪里啊3 发表于 2014-12-8 13:49 static/image/common/back.gif
求小伙伴帮忙
关闭捕捉试试 斑竹好厉害。。果然如此。。是为什么 Gu_xl 发表于 2014-12-8 14:04 static/image/common/back.gif
关闭捕捉试试
斑竹好厉害。。果然如此。。是为什么
页:
[1]