[求助]：如何获得一条POLYLINE的端点？

xyp1964

如何获得一条POLYLINE线的端点或其DXF码？
或者说
如何任意点取一条多义线，获得拾取点前后顶点的坐标？

lsjjm

REFER TO:
[php]
(defun c:test ()
  (setq ent (entsel "Pick a polyline: "))
  (setq obj (vlax-ename->vla-object (car ent)))
  (setq pt (cadr ent))
  (setq cpt (vlax-curve-getClosestPointTo obj pt T))
  (setq n (fix (vlax-curve-getParamAtPoint obj cpt)))
  (list (vlax-curve-getPointAtParam obj n)
          (vlax-curve-getPointAtParam obj (1+ n)) )
)
[/php]

xyp1964

用lisp还真是实现不了！dxf码好像找不到。
谢谢楼上指教！
终于将一个“坡度坡长”判断程序搞定！

xshrimp

;;看看lsp这样能不能满足要求
[php]
(defun xxx()
(setq pll (entsel))
(setq pll_data (entget (car pll)))
  (setq sx (dxf 0 pll_data))         
  (setq pt (cadr pll))         
  (setq pt (osnap pt "NEA"))         
        (setq pt1 (dxf 10 pll_data))        
        (setq pll_data (member (assoc 10 pll_data) pll_data))  ;从第二个10代码返回剩下的属性列表。
        (setq pt1 (dxf 10 pll_data))
        (setq r 1)
                (while r
                        (setq pll_data (cdr pll_data)                          ;返回除去处第一个10代码后的属性列表。
                        pll_data (member (assoc 10 pll_data) pll_data)   ;从第二个10代码返回剩下的属性列表。
                       pt2      (dxf 10 pll_data)
                 )
                 
                        (setq dt1 (distance pt1 pt)
                          dt2 (distance pt pt2)
                        dt1 (+ dt1 dt2)
;;                       dt1 (rtos dt1 2 1)
;                        dt1 (distof dt1 2)
                        dt2 (distance pt1 pt2)
;                       dt2 (rtos dt2 2 1)
;                       dt2 (distof dt2 2)
                      )
                       (if (= dt1 dt2)  (setq r nil)  (setq pt1 pt2) )
     );end while;;此段判断多义线的某段是不是在一直线上.

     
      (setq ang0 (angle pt1 pt2))
      (if (and (> ang0 (* PI 0.5)) (<= ang0 (* PI 1.5)))
          (setq ang0 (+ ang0 PI))
      );end if
  )

[/php]

舟自横

最初由 xyp1964 发布
[B]用lisp还真是实现不了！dxf码好像找不到。
谢谢楼上指教！
终于将一个“坡度坡长”判断程序搞定！ [/B]

用LSP绝对可以实现的..最简单的办法就是炸开后取得该段的两端点然后UNDO就可以...
其实用DXF组码也是可以判断的,以前我写过一个...我找找看找到就贴上来..

xyp1964

2. [FONT=courier new]
   
3. (load "xyp_lib")
   
4. ;|加载通用函数(可在签名栏直接下载)
   
5. 如果已经下载xyp_lib并放到搜索路径下可以不再下载!
   
6. 利用以下任何一种方式（首选第一种）即可加载和运行通用函数内的所有子程序：
   
7. ★1·在acad.lsp中增加(load"xyp_lib")
   
8. ■2·在每个程序内增加(load"xyp_lib")
   
9. ■3·在command下，输入(load"xyp_lib")
   
10. ■4·在菜单.mnl中增加(load"xyp_lib")
    
11. ■5·将xyp_lib.vlx文件直接拽到cad屏幕
    
12. [COLOR=red] ★通用函数下载地址：[/COLOR]
    
13. [url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url]
    
14. |;
    
15. 
    
16. ;;;多义线顶点标注
    
17. (defun c:test ()
    
18.   (CMDLA0)  
    
19.   (setq        ss (ssget '((0 . "*POLYLINE")))
    
20.         s1 (ssname ss 0)
    
21.         ptn (xyp-get-Vertexes s1 t);有效顶点
    
22.   )
    
23.   (jzhz)
    
24.   (mkla"zbbz"3)
    
25.   (foreach pt ptn (x_zb pt))
    
26.   (CMDLA1)
    
27. )[/FONT]

[FONT=courier new]<br /> (load "xyp_lib")<br /> ;|加载通用函数(可在签名栏直接下载)<br /> 如果已经下载xyp_lib并放到搜索路径下可以不再下载!<br /> 利用以下任何一种方式（首选第一种）即可加载和运行通用函数内的所有子程序：<br /> ★1·在acad.lsp中增加(load"xyp_lib")<br /> ■2·在每个程序内增加(load"xyp_lib")<br /> ■3·在command下，输入(load"xyp_lib")<br /> ■4·在菜单.mnl中增加(load"xyp_lib")<br /> ■5·将xyp_lib.vlx文件直接拽到cad屏幕<br /> [COLOR=red] ★通用函数下载地址：[/COLOR]<br /> [url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url]<br /> |;<br /> <br /> ;;;多义线顶点标注<br /> (defun c:test ()<br />   (CMDLA0)  <br />   (setq        ss (ssget '((0 . "*POLYLINE")))<br />         s1 (ssname ss 0)<br />         ptn (xyp-get-Vertexes s1 t);有效顶点<br />   )<br />   (jzhz)<br />   (mkla"zbbz"3)<br />   (foreach pt ptn (x_zb pt))<br />   (CMDLA1)<br /> )[/FONT]

Underway

For R14
http://groups.google.com/group/a ... en#8821bee98aebf677

Reini Urban   Jun 2 1998, 3:00 pm     show options

Newsgroups: autodesk.autocad.customization
From: Reini Urban <rur...@sbox.tu-graz.ac.at> - Find messages by this author  
Date: 1998/06/02
Subject: Re: I need help with writing a simple lisp function : can you help?
Reply to Author | Forward | Print | Individual Message | Show original | Report Abuse  


have a look in my faq.
the angle of the n-th segment is calculated this way:


(setq segs (pline-segs polyline-entity)); => list of (bulge p1 p2)
(angle (nth n segs) (nth (1+ n) segs))  ; invalid for the last segment


if you have just a point and no segment get the index of the starting
vertex with a helper function from Owen Wengerd: findvrtx.arx
somewhere at http://www.manusoft.com or another copy at
http://xarch.tu-graz.ac.at/autocad/lsp_tools/findvrtx.zip
or solve it by yourself in lisp. quite easy once you've got the
segments.

yunzhong80

;;;多义线（LWPOLYLINE）分析（端点LIST获取）
(DEFUN C:PL()
  (setq xy (ssname (ssget ":s" '((0 . "LWPOLYLINE"))) 0))
  (setq LS (entget xy ))
  (SETQ LSS LS)
  (setq PT  (cdr(assoc 10  LS)))
  (SETQ LST (LIST PT))
  (WHILE ( /= PT NIL)

   (SETQ LS (CDR (MEMBER (assoc 10  LS) LS)))
    (setq PT  (cdr(assoc 10  LS)))
   (SETQ LST (CONS PT LST))
  )
(SETQ LST (CDR LST))
  
  )

(DEFUN C:PLl()
  (setq xy (ssname (ssget ":s" '((0 . "LWPOLYLINE"))) 0))

  (setq LS (entget xy ))
  (SETQ LSS LS)
  (setq PT  (cdr(assoc 10  LS)))
  (SETQ LST (LIST PT))
  (WHILE ( /= PT NIL)

   (SETQ LS (CDR (MEMBER (assoc 10  LS) LS)))
    (setq PT  (cdr(assoc 10  LS)))
   (SETQ LST (CONS PT LST))
  )
   (SETQ LST (CDR LST))
   (setq y1 (cadr (car  lst)))
   (setq y2 (cadr (last lst)))
   (setq x1 (car  (car  lst)))
   (setq x2 (car  (last lst)))
   
  
   (if ( > y1 y2)  ;;y2为大值
     (progn
     (setq aa y2)
     (setq y2 y1)
     (setq y1 aa)
     )
     )
  
   (setq d  (abs  (- x1 x2)))
   (setq lsd      (list d)) ;;;定义回转体直径列表
  
  (setq si (length lst))
  (setq i   1)
  (setq oldpt1 nil)
  (setq oldpt nil)
   (while (< i (- si 1))
     
     (setq pt (nth i lst ))
     (setq i  (+ i 1))
     
     (if (= (cadr pt) y1);;;;取出与放电基准面相平的点
     (progn
     (setq oldpt pt)
     (if (= oldpt1 nil) (setq oldpt1 oldpt))
     )
     )
     )

  (if (and (/= oldpt nil) (/= oldpt1 nil) )
    (progn
     (setq oldpt (cons 10 oldpt))  
     (setq oldpt1 (cons 10 oldpt1))
     (setq newpt (subst (+ y1 5) y1 oldpt));;;加多少待定
     (setq newpt1 (subst (+ y1 5) y1 oldpt1))
     (setq lss (subst newpt1 oldpt1  lss))
     (setq lss (subst newpt   oldpt    lss))
       (entmod lss)
       (entupd xy)
      
    )
    )

   (print)  
  )
;;;向多段线添加顶点
(defun addptenpl(xy pt )
(setq blss (entget xy ))
  (setq blss (reverse blss))
  (setq lastlss (last lss))
  (setq blss (cdr blss))
  (setq blss (reverse blss))
  (setq pt (cons 10 pt))
  (setq newlist (cons pt '((40 . 0.0 ) (41 . 0.0 ) (42 . 0.0 )) ))
  (setq blss (append blss newlist ))
  (setq blss (reverse blss))
  (setq blss (cons lastlss blss))
  (setq blss (reverse blss))
  (entmod blss)
   (entupd xy)
  )
;;;向多段线添加顶点(起点)
(defun addptstpl(xy pt )
  (setq blss (entget xy ))
  (setq pt (cons 10 pt))
  (setq oldlist (member (assoc 10 blss) blss))
  
  (setq newlist (cons pt '((40 . 0.0 ) (41 . 0.0 ) (42 . 0.0 )) ))
  (setq newlist (append newlist oldlist ))
  (setq elelist (car blss))
  (setq stlist (list elelist))
  (setq i 1)
  (while (/= elelist (assoc 10 blss) )
      (setq stlist (cons elelist stlist))
      (setq i (+ i 1))
      (setq elelist (nth i blss))  
   )
  (setq stlist (reverse stlist))
  (setq i (length stlist))
  (while (> i 0)
     (setq i (- i 1))
   (setq newlist (cons (nth i stlist) newlist))
    )
     (entmod newlist)
  (entupd xy  )
  )

狂刀

最初由 舟自横 发布
[B]
用LSP绝对可以实现的..最简单的办法就是炸开后取得该段的?.. [/B]

那是一年前的xyp说的
现在的xyp已经不是一年前的xyp。
他是2005年的xyp
虽然xyp还是xyp，
但是xyp的确已经不是那个xyp
不知道我说清楚了没有

yuer0103

狂刀先生，你很有点古龙了啊！呵呵

xyp1964

最初由 狂刀 发布
[B]

那是一年前的xyp说的
现在的xyp已经不是一年前的xyp。
他是2005年的xyp
虽然xyp还是xyp，
... [/B]

xyp是哪路英雄？！呵呵……

xyp1964

最初由 yunzhong80 发布
[B];;;多义线（LWPOLYLINE）分析（端点LIST获取）
(DEFUN C:PL()
  (setq xy (ssname (ssget ":s" '((0 . "LWPOLYLINE"))) 0))
  (setq LS (entget xy ))
  (SETQ LSS LS)
  (setq PT  (cdr(assoc 10  LS)))
  (S... [/B]

[php]
函数名：xyp-get-Vertexes
语　法：(xyp-get-Vertexes 实体名 模式)
功　能：多义线顶点集
说　明：模式为t获得有效点，其他为全部点
返回值：点表
实　例：
(defun c:test()
  (setq ptn  (xyp-get-Vertexes (car(entsel"\n选择多义线 : ")) t))
  (princ ptn)
  (princ)
  )

命令: test
选择多义线 : ((61121.0 22631.9 0.0) (61544.3 22998.3 0.0) (61802.7 22698.3 0.0)
(62169.5 22956.5 0.0) (62302.4 22459.8 0.0) (62538.7 22695.9 0.0))[/php]

cy956

最初由 lsjjm 发布
[B]REFER TO:
[php]
(defun c:test ()
  (setq ent (entsel "Pick a polyline: "))
  (setq obj (vlax-ename->vla-object (car ent)))
  (setq pt (cadr ent))
  (setq cpt (vlax-curve-getClosestPointTo obj p... [/B]

点在的pl线close段上会出错。

狂刀

有道理，参数可改
(setq m (vlax-curve-getendparam e))
(rem (1+ n) (1+ m))

不对！好像没错阿，不用改