[LISP函数]： 获得一个*POLYLINE线上指定一点处的“段”的信息。

eachy

2. 
   
3. ;|
   
4.    用法：(xdl-pl-getSegAt <多义线Object> <测试点>)
   
5.    获得一个*POLYLINE线上指定一点处的“段”的信息。
   
6.    对于直线段返回：("kLine" 前后顶点索引 起点 终点)
   
7.    对于弧线段返回：("kArc" 前后顶点索引 圆心 起点 终点) [逆时针方向]
   
8.    所有返回点在WCS下。
   
9. |;
   
10. (defun xdl-pl-GetSegAt (obj p / pn pa p1 p2 pcen v)
    
11.   (setq        pn (vlax-curve-getclosestpointto obj (trans p 1 0))
    
12.         pa (fix (vlax-curve-getparamatpoint obj pn))
    
13.         p1 (vlax-curve-getpointatparam obj pa)
    
14.         p2 (vlax-curve-getpointatparam obj (1+ pa))
    
15.   )
    
16.   (if (zerop (vla-getbulge obj pa))
    
17.     (list "kLine" (list pa (1+ pa)) p1 p2)
    
18.     (progn
    
19.       (setq v         (vlax-curve-getsecondderiv obj pa)
    
20.             pcen (mapcar '+ p1 v)
    
21.       )
    
22.       (if (equal (distance pcen p1) (distance pcen p2) 0.000001)
    
23.         (list "kArc" (list pa (1+ pa)) pcen p1 p2)
    
24.         (list "kArc" (list pa (1+ pa)) (mapcar '- p1 v) p2 p1)       
    
25.       )
    
26.     )
    
27.   )
    
28. )

<br /> ;|<br />    用法：(xdl-pl-getSegAt <多义线Object> <测试点>)<br />    获得一个*POLYLINE线上指定一点处的“段”的信息。<br />    对于直线段返回：("kLine" 前后顶点索引 起点 终点)<br />    对于弧线段返回：("kArc" 前后顶点索引 圆心 起点 终点) [逆时针方向]<br />    所有返回点在WCS下。<br /> |;<br /> (defun xdl-pl-GetSegAt (obj p / pn pa p1 p2 pcen v)<br />   (setq        pn (vlax-curve-getclosestpointto obj (trans p 1 0))<br />         pa (fix (vlax-curve-getparamatpoint obj pn))<br />         p1 (vlax-curve-getpointatparam obj pa)<br />         p2 (vlax-curve-getpointatparam obj (1+ pa))<br />   )<br />   (if (zerop (vla-getbulge obj pa))<br />     (list "kLine" (list pa (1+ pa)) p1 p2)<br />     (progn<br />       (setq v         (vlax-curve-getsecondderiv obj pa)<br />             pcen (mapcar '+ p1 v)<br />       )<br />       (if (equal (distance pcen p1) (distance pcen p2) 0.000001)<br />         (list "kArc" (list pa (1+ pa)) pcen p1 p2)<br />         (list "kArc" (list pa (1+ pa)) (mapcar '- p1 v) p2 p1)        <br />       )<br />     )<br />   )<br /> )

测试

2. 
   
3. (defun c:tt (/ e l)
   
4.   (if (setq e (entsel "\nPick Pline: "))
   
5.     (progn
   
6.       (setq
   
7.         l (xdl-pl-GetSegAt (vlax-ename->vla-object (car e)) (cadr e))
   
8.       )
   
9.       (command ".line" (nth 2 l) (nth 3 l) "")
   
10.     )
    
11.   )
    
12.   (princ)
    
13. )
    

<br /> (defun c:tt (/ e l)<br />   (if (setq e (entsel "\nPick Pline: "))<br />     (progn<br />       (setq<br />         l (xdl-pl-GetSegAt (vlax-ename->vla-object (car e)) (cadr e))<br />       )<br />       (command ".line" (nth 2 l) (nth 3 l) "")<br />     )<br />   )<br />   (princ)<br /> )<br />

狂刀

个人认为，用bulge判断反弧更科学一点。

2. 
   
3. (setq blg (vla-getbulge obj pa))
   
4. (if (zerop  blg)
   
5.    (list "kLine" (list pa (1+ pa)) p1 p2)
   
6.     (progn
   
7.       (setq v         (vlax-curve-getsecondderiv obj pa)
   
8.             pcen (mapcar '+ p1 v)
   
9.       )
   
10.       (if (> blg 0)
    
11.         (list "kArc" (list pa (1+ pa)) pcen p1 p2)
    
12.         (list "kArc" (list pa (1+ pa)) (mapcar '- p1 v) p2 p1)       
    
13.       )
    
14.     )
    
15.   )

<br /> (setq blg (vla-getbulge obj pa))<br /> (if (zerop  blg)<br />    (list "kLine" (list pa (1+ pa)) p1 p2)<br />     (progn<br />       (setq v         (vlax-curve-getsecondderiv obj pa)<br />             pcen (mapcar '+ p1 v)<br />       )<br />       (if (> blg 0)<br />         (list "kArc" (list pa (1+ pa)) pcen p1 p2)<br />         (list "kArc" (list pa (1+ pa)) (mapcar '- p1 v) p2 p1)        <br />       )<br />     )<br />   )

glyxmj

多谢斑竹了，POLYLINE线上指定一点处的“段”的信息这个函数正是我非常需要的，很实用，我的一些小程序可以大为“进化”。本想自已编一个类似函数，但现在不必了，再次感谢！

zb_lou

我根据这个改进了一个我们单位经常用到的小程序，但很多人都在用R14，不知道可不可以用lisp实现同样功能？在R14下运行？非常期待！

hopechan

在AutoCAD2006中，有个“Pick Pline: ; 错误: no function definition: VLAX-ENAME->VLA-OBJECT”这样的错误提示，这是什么原因呢？！

kohi

2. (defun segdetail ()
   
3.   (setq ent (entsel "\nPick Polyline:")
   
4.           p (cadr ent)
   
5.         ent (car ent))  
   
6.   (setq pp (vlax-curve-getclosestpointto ent (trans p 1 0))
   
7.          n (fix (vlax-curve-getparamatpoint ent pp)))
   
8.   (setq ll (acet-pline-segment-list ent))
   
9.   (list (nth n (car ll))(nth (1+ n)(car ll))(nth n (cadr ll))(nth n (caddr ll))(nth n (last ll)))
   
10. )

(defun segdetail ()<br />   (setq ent (entsel "\nPick Polyline:")<br />           p (cadr ent)<br />         ent (car ent))  <br />   (setq pp (vlax-curve-getclosestpointto ent (trans p 1 0))<br />          n (fix (vlax-curve-getparamatpoint ent pp)))<br />   (setq ll (acet-pline-segment-list ent))<br />   (list (nth n (car ll))(nth (1+ n)(car ll))(nth n (cadr ll))(nth n (caddr ll))(nth n (last ll)))<br /> )

lgwlgw

eachy斑竹,有问题，
————当此多段线不是闭合多段线时，获得的此多段线的最后一段的信息有点表不全。

ngc

回的人少，我来小顶一下