求一个自动找出曲线长度和曲线上有交点的代码

kwok

如下图，目的是想取得每段线长度d1,d2...dn,(带弧的要曲线长度，不是2点距离) ,并自动找出每段曲线上的交点并设为p1,p2...pn.
冒似这个挺难，不知怎么弄，求代码学习,谢谢!

牢固

计算每段长度，用vlax-curve-getdistatparam 函数，计算交点，线计算出曲线的顶点坐标表，弧线段需拟合加密一下，然后用(SSGet F plist ‘((0 . "*line")))获得选择集ss,再用(ssnamex ss) 函数取得交点坐标即可！

Lispboy

搜索论坛，好像有大把。

求交点你应该会，求出所有交点后，用我前几天写的那个 点沿着曲线排序的函数，把点 p1 p2 p3...pn排列起来，然后你想要的都能求出来了。

http://bbs.xdcad.net/thread-668455-1-1.html

kwok

Lispboy 发表于 2013-6-5 12:11
搜索论坛，好像有大把。

求交点你应该会，求出所有交点后，用我前几天写的那个 点沿着曲线排序的函数， ...

想不选红线情况下，只选entsel白线，然后自动判断线上是否有其它线，有就取交点，这个弄不明白.

Lispboy

kwok 发表于 2013-6-5 14:29
想不选红线情况下，只选entsel白线，然后自动判断线上是否有其它线，有就取交点，这个弄不明白.

你选完白线，想法得到模拟的顶点表（尤其对于弧线段），然后用 ssget "f" 顶点表 就得到所有白色穿过的红线了，然后你就可以求红线和白色线的交点了。

Lispboy

等我再做完几个函数，就给你写个测试命令，现在准备还不够。不过，你可以根据思路自己先写啊，自己写的过程提高才快。

kwok

谢谢，弄了好久，不行，首先多段线有弧不知怎么拟合，还有要考滤多段线起点和终点如果重叠的或是闭合的。或是不闭合的有开口的.
再就是多段线的长度要独立出来,
最后的效果是每个线段成单独一个的，中间隔开一定距离。
下图左边是要的效果.


这是测试文件:

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:test.zip 
下载次数:2  文件大小:28.09 KB 
下载权限: 不限 以上  [免费赚D豆]

请帮改正完善!
[pcode=cpp,true]
(defun c:tt5 ( / h j en ent p0 pt end ss plst inpt)
  (vl-load-com)
  (setq h (getdist "\n输入高度:"))
  (setq j (getreal "\n输入间距："))
  (setq en (entsel "\n选择多段线"))
  (setq p0 (cadr en)
  en (car en)
  )
   (setq pt (getpoint p0 "\n指定起点位置："))
   (setq end (vlax-curve-getEndParam en)
n 0
  )
  (repeat (fix end)
    (setq d (distance (vlax-curve-getPointAtParam en n)
        (vlax-curve-getPointAtParam en (setq n (1+ n)));;对每段线长度有弧求出不对
     )
    )
     (setvar "osmode" 0)
    (command "_.rectang"
      pt
      (strcat "@" (rtos d 2) "," (rtos h 2))
    )
    (setq pt (polar pt 0 (+ d j)))
  )
;;;求交点
  (setq ent (vlax-ename->vla-object en))
  (setq plst (get_pline-vertexs ent))
  (setq ss (SSGet "f" plst  '((0 . "*line"))) )
   (ssnamex ss)
(setq inpt (Curveinters ent ss ))
;;;这里接下来不知怎么弄，不会了.求不出交点，如果求出交点怎么用pt起点在对应的矩形里画小矩形
  
  (princ)
)
;;;取得曲线端点表
(defun get_pline-vertexs (e / i v lst)
  (setq i -1)
  (while (setq v (vlax-curve-getpointatparam e (setq i (1+ i))))
    (setq lst (cons v lst))
  )
  (reverse lst)
)
;;;;;计算曲线交点
(defun Curveinters (en1 en2 / pl pts)
   (setq pl  (vlax-invoke (vlax-ename->vla-object en2) 'IntersectWith (vlax-ename->vla-object en1) acExtendNone))
   (while pl
     (setq pts (append pts (list (list (car pl) (cadr pl) (caddr pl))))
    pl (cdr (cdr (cdr pl)))
    )
     )
pts
   )



[/pcode]

XDSoft

kwok 发表于 2013-6-5 19:59
谢谢，弄了好久，不行，首先多段线有弧不知怎么拟合，还有要考滤多段线起点和终点如果重叠的或是闭合的。或 ...

都直线段的，你代码完成了吗？先把直线段的完成了，算法就固定了，到时候你找的拟合弧线段的方法的时候修改也很容易。

建议你把模拟多段线顶点写到一个函数里面，方便以后修改。

kwok

XDSoft 发表于 2013-6-5 20:25
都直线段的，你代码完成了吗？先把直线段的完成了，算法就固定了，到时候你找的拟合弧线段的方法的时候修 ...

水平有限，就只能弄7楼那样的，接下来不会了，:(

kwok

牢固 发表于 2013-6-5 12:11
计算每段长度，用vlax-curve-getdistatparam 函数，计算交点，线计算出曲线的顶点坐标表，弧线段需拟合加密 ...

vlax-curve-getDistAtParam不闭合线就能求出每段，但如果多段线是闭合的，就会出现少了一段，还是要把线取断开?
怎么弄才可以求出所有线段的长，请指点一下,如果有码学习一下最好，谢谢!

marting

kwok 发表于 2013-6-6 16:49
vlax-curve-getDistAtParam不闭合线就能求出每段，但如果多段线是闭合的，就会出现少了一段，还是要把线 ...

那你就先判断下是否闭合，然后对最后一段自己处理下不就行了吗？

QiaoCheng

kwok 发表于 2013-6-5 20:30
水平有限，就只能弄7楼那样的，接下来不会了，

看看这个行不

里面部分代码来之Free-Lancer，感谢
[pcode=lisp,true]
(defun c:tt ( / _pi2 an coorlst d elst fobj inpt mptlst ms obj p ptlst str txt v x y L i v)
  (vl-load-com)
  (if (setq obj (vlax-ename->vla-object (car (entsel "\n请选择LWPOLYLINE:"))))
    (progn
       (setq coorlst (vlax-get obj 'Coordinates ))
       (setq ptlst (LstDiv 2 coorlst))
       (setq mptlst (simobj obj))
       (setq Fobj (ssget "F" mptlst '((0 . "LINE"))))
       (setq elst (ssToList Fobj))
       (if Fobj
         (progn
            (setq InPT (Intersections obj elst)) ;交点
            (setq L (length InPT)
                  i 0
            )
            (repeat L
              (setq v (nth i InPT))
              (entmake (list '(0 . "CIRCLE") (cons 10 v) (cons 40 40)))
              (setq i (1+ i))
            )
          )
       )
       (setq _pi2 (* pi 0.5))
       (setq ms (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))))
       (mapcar
         (function
            (lambda (x y / txt p d str an)
              (setq an (angle x y)
                    d  (distance x y)
                    p  (polar x an (* d 0.5))
                    p  (vlax-3D-point (polar p (+ an _pi2) 100.))
              )
              (setq txt (vla-AddText ms (setq str (rtos d 2 0)) p 50))
              (vla-put-Alignment txt acAlignmentBottomCenter)
              (vla-put-TextAlignmentPoint txt p)
              (vla-put-Rotation txt an)
              (if (not (zerop (- d (distof str))))
                (vla-put-Color txt acRed)
              )
              (if (not (ang->hor&ver an))
                (vla-put-Color txt acRed)
              )
              (vla-put-ScaleFactor txt 1)
            )
         )
          ptlst
          (cdr ptlst)
      )
    )
  )
  (princ)
)
(defun LstDiv (n lst / a i ll)
  (setq i 1)
  (mapcar
    '(lambda (x)
      (if (< i n)
        (setq a (cons x a)
              i (1+ i)
        )
        (setq ll (cons (reverse (cons x a)) ll)
               a nil
               i 1
        )
      )
    )
    lst
  )
  (reverse (if a (cons (reverse a) ll) ll))
)
;;单段Pline轮廓模拟
(defun simobj (e / obj sp ep vs p L d d1 sw ew ptl pl)
  (if (setq e (vlax-vla-object->ename e))
    (progn
      (setq obj  (vlax-ename->vla-object e)
            sp  (vlax-curve-getStartPoint e)
            ep  (vlax-curve-getEndPoint e)
            vs  (vlax-curve-getSecondDeriv obj 0.)
            p  (mapcar '+ sp vs) ;_圆心
            L  (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))
            d  (/ l 64.)
            d1  0.
      )
      (vla-getWidth obj 0 'sw 'ew)
      (repeat 65
        (setq ptl (cons (vlax-curve-getPointAtDist e d1) ptl)
              d1  (+ d1 d)
        ) ;_构造等分点
      )
    )
  )
  ptl
)
(defun ssToList (ss / i s)
  (if ss
    (progn
      (setq L (sslength ss))
      (repeat (setq i L)
        (setq s (cons (ssname ss (setq i (1- i))) s))
      )
    )
  )
)
(defun Intersections (a b / L)
  (foreach v b
    (setq L (cons (Inter a (vlax-ename->vla-object v) acextendnone) L))
  )
  (apply 'append (reverse L))
)
(defun Inter (obj1 obj2 mode / L r)
  (setq L (vlax-invoke obj1 'intersectwith obj2 mode))
  (repeat (/ (length L) 3)
    (setq r (cons (list (car L) (cadr L) (caddr L)) r)
          L (cdddr L)
    )
  )
  (reverse r)
)
(defun ang->hor&ver (an)
  (or (zerop an)
    (zerop (rem an (* 0.5 pi)))
  )
)
[/pcode]

Lisphk

630那段感觉不太对呢，比另外两段长多了。

Lisphk

QiaoCheng 发表于 2013-6-6 22:17
看看这个行不

里面部分代码来之Free-Lancer，感谢

630那段感觉不太对呢，比另外两段长多了。

QiaoCheng

Lisphk 发表于 2013-6-6 22:26
630那段感觉不太对呢，比另外两段长多了。

630对的啊，我量了下629.924