矮油这是哪里啊3 发表于 2014-12-8 13:48:35

求帮忙看段代码,关于线段等分的

代码功能,两线段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:33

求小伙伴帮忙

Gu_xl 发表于 2014-12-8 14:04:34

矮油这是哪里啊3 发表于 2014-12-8 13:49 static/image/common/back.gif
求小伙伴帮忙

关闭捕捉试试

矮油这是哪里啊3 发表于 2014-12-8 15:50:45

斑竹好厉害。。果然如此。。是为什么

矮油这是哪里啊3 发表于 2014-12-8 15:52:05

Gu_xl 发表于 2014-12-8 14:04 static/image/common/back.gif
关闭捕捉试试

斑竹好厉害。。果然如此。。是为什么
页: [1]
查看完整版本: 求帮忙看段代码,关于线段等分的