[LISP程序]：如何只读取pline最长的那条直线的端点坐标？

shona521

请教高手，点取一条多义线后，如何只读取pline最长的那条直线的两个端点坐标？并将其坐标值分别付给1个参数？下面这个程序只能读所有的坐标。在此先谢谢各位了。（在线等》》》

czg09180274

给你提个建议，首先如果程序不是太大的话，最好就直接贴到论坛里面而不要用附件的，这样也许会多几个人来帮忙看的了。
要提出最长的那一段的端点坐标，你可以在程序中加入一个“distance pt1 pt2”分别测出相邻点的长度，建立成一个列表，然后再提出列表中最长线段所对应的那个起/端点坐标来完成操作。

舟自横

这个简单....
[PHP]
(defun hy_plinell(en / f ff p1 p2 dmax  p4);;取得直線段中最長的邊p1p2
  (setq f(entget en) ff f f(member(assoc 10 f)f)p1 nil p2 nil dmax 0)
    ;;取得直線段中最長的邊p1p2
    (setq p4(assoc 210 f))
    (if (vlax-curve-isclosed (vlax-ename->vla-object en))
      (setq f(subst(assoc 10 f)(assoc 210 f)f)
            f(append f(list(assoc 40 f)(assoc 41 f)(assoc 42 f) p4)))
      )
      (while(/= (car(nth 4 f)) 210)
        (if(= (cdr(assoc 42 f))0)
          (if (> (distance (cdr(nth 0 f))(cdr(nth 4 f))) dmax)
            (setq dmax (distance (cdr(nth 0 f))(cdr(nth 4 f)))
                  p1 (cdr(nth 0 f))
                  p2 (cdr(nth 4 f)))
          )
        )
        (setq f (cdr f) f (member (assoc 10 f) f))
      )
  (if (and p1 p2) (list p1 p2)
    nil;(alert "\n復線中無直線段!")
   )
  )
返回NIL则说明复线其中无直线段..
如果存在则返回直线两端点的列表
复线可以是封闭也可以不封闭
[/PHP].

xyp1964

试试：
[php];;;加载通用函数
;;;下载：http://www.xdcad.net/forum/showthread.php?s=&threadid=325268
(load "xyp_lib")

;;;功能：多义线逐段长度计算
;;;    显示和标注最长线段两端的坐标
(defun c:test (/ s1 eobj i leng pt0 pt1)
  (cmdla0)
  (setq        s1         (entsel "\n\t选择对象<退出> : ")
        eobj         (vlax-ename->vla-object (car s1))
        i         -1
        Leng-max 0
  )
  (jzhz)
  (while (setq pt0 (vlax-curve-getPointAtParam eobj (setq i (1+ i))))
    (if        (setq pt1 (vlax-curve-getPointAtParam eobj (setq n (1+ i))))
      (progn
        (setq Leng (distance pt0 pt1))
        (if (> leng leng-max)
          (setq        ptmax0 pt0
                ptmax1 pt1
                number i
                leng-max leng
          )
        )
        (princ (strcat "\nLeng" (rtos (+ i 1) 2 0) " = "))
        (princ Leng)
      )
    )
  )
  (setq        txt (strcat "\n第 "
                    (rtos (+ number 1) 2 0)
                                " 条线最长，线长为 : "
                    (rtos leng-max 2)
            )
  )
  (princ "\n")
  (princ txt)
  (princ "\n起点坐标 : ")
  (princ ptmax0)
  (princ "\n终点坐标 : ")
  (princ ptmax1)
  (mkla"坐标标注"3)
  (X_ZB ptmax0)
  (X_ZB ptmax1)
  (cmdla1)
)
[/php]
测试结果：
命令: test
选择对象<退出> :
Leng1 = 4770.1
Leng2 = 4219.35
Leng3 = 4927.87
Leng4 = 4321.49
Leng5 = 8557.61
Leng6 = 4272.06
Leng7 = 3077.06
Leng8 = 2352.32

第 5 条线最长，线长为 : 8557.6149
起点坐标 : (24685.4 12314.8 0.0)
终点坐标 : (28632.3 19907.9 0.0)

狂刀

两位改改,支持曲线段不好么?怎么都是求直线段的?
先提供一个另类版本,之所以说另类,因为调用了cad命令,无法做成透明命令,在编程中看情况使用吧
下面的支持曲线段

[php]
(defun c:tt( / ss i l e len lst)
  (vl-cmdf ".explode" (entsel "\n提取多义线最长线段信息---by 狂刀\n选多义线:") "")
  (setq ss (ssget "p") i -1 l 0)
  (while (setq e (ssname ss (setq i(1+ i))))
    (setq len(-(vlax-curve-getdistatparam e (vlax-curve-getendparam e))
               (vlax-curve-getdistatparam e (vlax-curve-getstartparam e))))
    (if (> len l)(setq l len lst (list i len (vlax-curve-getstartpoint e)(vlax-curve-getendpoint e))))
  )
  (vl-cmdf ".u")
  (mapcar 'princ (list "\n第" (nth 0 lst) "点最长" "  \n长度=" (nth 1 lst) " \n起点=" (nth 2 lst) " \n终点=" (nth 3 lst)))
  (princ)
)[/php]

shona521

谢谢各位大虾。本人初学lisp，一直不得要领。向各位学习。
多谢二楼兄第的建议。