[分享]：给大家贴一个获得POLYLINE在拾取点处的段的起点、终点等信息的函数...

XDSoft

2. 
   
3. [FONT=courier new]
   
4. ;|
   
5.    用法：($XDLSP_PolyLine_getSegAt <多义线实体名> <测试点>)
   
6.    获得一个*POLYLINE线上指定一点处的“段”的信息。
   
7.    对于直线段返回：(顶点索引 "kLine" 起点 终点)
   
8.    对于弧线段返回：(顶点索引 "kArc" 圆心 半径 起始角 终止角)
   
9.    所有返回点在UCS下。
   
10. |;
    
11. (defun $XDLSP_PolyLine_getSegAt (e pt / cNa tf i nNums eTyl eSegData el tf1
    
12.                                    tf2
    
13.                                 )
    
14.   (setq cNa (car (xdrx_Object_ClassName e)))
    
15.   (if (wcmatch cNa "*POLYLINE")
    
16.     (progn
    
17.       (setq tf t)
    
18.       (if (setq tf (= cNa "POLYLINE"))
    
19.         (setq tf (xdrx_polyline_ConvertFrom e)
    
20.               tf2 tf
    
21.         )
    
22.         (setq tf t)
    
23.       )
    
24.       (if tf
    
25.         (progn
    
26.           (setq nNums (xdrx_polyline_numVerts e)
    
27.                 i -1
    
28.           )
    
29.           (setq tf1 t)
    
30.           (while (and
    
31.                    tf1
    
32.                    (< i nNums)
    
33.                  )
    
34.             (if (xdrx_polyline_onSegAt e (setq i (1+ i))
    
35.                                        pt
    
36.                 )
    
37.               (progn
    
38.                 (setq eTyl (xdrx_polyline_segtype e i)
    
39.                       eSegData (cond
    
40.                                  ((= "kLine" eTyl)
    
41.                                    (xdrx_polyline_getLineSegAt e i)
    
42.                                  )
    
43.                                  ((= "kArc")
    
44.                                    (xdrx_polyline_getArcSegAt e i)
    
45.                                  )
    
46.                                )
    
47.                       el (cons i (cons eTyl eSegData))
    
48.                       tf1 nil
    
49.                 )
    
50.               )
    
51.             )
    
52.           )
    
53.         )
    
54.       )
    
55.       (if tf2
    
56.         (xdrx_polyline->2dpolyline e)
    
57.       )
    
58.     )
    
59.   )
    
60.   el
    
61. )[/FONT]

<br /> [FONT=courier new]<br /> ;|<br />    用法：($XDLSP_PolyLine_getSegAt <多义线实体名> <测试点>)<br />    获得一个*POLYLINE线上指定一点处的“段”的信息。<br />    对于直线段返回：(顶点索引 "kLine" 起点 终点)<br />    对于弧线段返回：(顶点索引 "kArc" 圆心 半径 起始角 终止角)<br />    所有返回点在UCS下。<br /> |;<br /> (defun $XDLSP_PolyLine_getSegAt (e pt / cNa tf i nNums eTyl eSegData el tf1<br />                                    tf2<br />                                 )<br />   (setq cNa (car (xdrx_Object_ClassName e)))<br />   (if (wcmatch cNa "*POLYLINE")<br />     (progn<br />       (setq tf t)<br />       (if (setq tf (= cNa "POLYLINE"))<br />         (setq tf (xdrx_polyline_ConvertFrom e)<br />               tf2 tf<br />         )<br />         (setq tf t)<br />       )<br />       (if tf<br />         (progn<br />           (setq nNums (xdrx_polyline_numVerts e)<br />                 i -1<br />           )<br />           (setq tf1 t)<br />           (while (and<br />                    tf1<br />                    (< i nNums)<br />                  )<br />             (if (xdrx_polyline_onSegAt e (setq i (1+ i))<br />                                        pt<br />                 )<br />               (progn<br />                 (setq eTyl (xdrx_polyline_segtype e i)<br />                       eSegData (cond<br />                                  ((= "kLine" eTyl)<br />                                    (xdrx_polyline_getLineSegAt e i)<br />                                  )<br />                                  ((= "kArc")<br />                                    (xdrx_polyline_getArcSegAt e i)<br />                                  )<br />                                )<br />                       el (cons i (cons eTyl eSegData))<br />                       tf1 nil<br />                 )<br />               )<br />             )<br />           )<br />         )<br />       )<br />       (if tf2<br />         (xdrx_polyline->2dpolyline e)<br />       )<br />     )<br />   )<br />   el<br /> )[/FONT]

千寻

没有多大用

god

我看到一段代码，功能好像差不多
这个功能对编程还是有用的

code

对 PolyLine 进行数据分析的基本程序
返回目录
来源：  明经CAD社区 　作(译)者：  陈伯雄 　
上传者：  mccad 　上传时间：2002年9月3日  
(Defun C:PLL ()
       (PrinC "\n这是对 PolyLine 进行数据分析的基本程序...")
       (While (Progn (SetQ pen (Car (EntSel "\n指定一条 PolyLine: ")))
                        (/= "POLYLINE" (Cdr (Assoc 0 (EntGet pen))))
                )
                (Alert "所指对象不是 PolyLine，请重新指定...")
       )                                              ;指定PolyLine
       (SetQ pel (EntGet pen)           ;取出对象表
              ptp (Cdr (Assoc 70 pel))   ;取出结束片段型
              wpl '()                       ;自建的点位数表
           pen (EntNext pen)
       )
       (While (/= "SEQEND" (Cdr (Assoc 0 (EntGet pen)))) ;如果没结束
               (SetQ pel (EntGet pen)           ;取得顶点对象数据表
               plp (Cdr (Assoc 10 pel))    ;取出控制点点位
                      par (Cdr (Assoc 42 pel))     ;取出弓弦比
                      wpl (Cons (List plp par) wpl)    ;将数据加到WPL表中
               )
               (SetQ pen (EntNext pen))                ;搜索下一个对象
       )
       (SetQ ct (If (= 0 (Cadr (Car wpl))) "直线片段封闭" "弧片段封闭"))
       (SetQ wpl (Cons (Last wpl) wpl) ;加入封闭点
       wpl (Reverse wpl)           ;整理WPL表
       rl (Length wpl)
              pn 0
       )            
       (SetQ clk (If (Or (= 0 ptp) (= 128 ptp)) "开口" "封闭"))  
       (SetVar “pdmode” 3)
       (Repeat (1- rl)                 ;逐点分析
               (SetQ al (Nth pn wpl)  ;取出点数据表
                     pt (Car al)        ;取出点位
               )
         (Command "point" pt)
         (PrinC "\n") (PrinC al)   
              (If (And (/= 0.0 (Cadr al)) (Nth pn wpl)) ;如果是弧片断
                   (Progn (SetQ gx (Cadr al)               ;取出弓比
         bj (* (ATAN (ABS gx)) 4) ;计算包角
                                   np (Car (Nth (1+ pn) wpl));取出下一点位
                                   xc (* 0.5 (Distance pt np));半弦长计算
                                   gg (* gx xc)                  ;弓高计算
                                    rr (/ (+ (* xc xc)(* gg gg)) (* 2 gg))
                           )
                           (SetQ cp (Polar pt (SetQ pa (Angle pt np)) xc)  
                                  cp (Polar cp (+ pa (* 0.5 Pi)) (- rr gg))
                           )
                           (Command "text" "m" cp 2 0  
(StrCat "R" (RToS (Abs rr)))
                       "text" "" (AngToS bj)
                       "circle" cp 5
                           )
                    )
               )
               (SetQ pn (1+ pn)) ;搜索序号步进
       )
       (Alert (StrCat "结束段状态:\n"
                  clk
                        (If (= "封闭" clk) ct "")
              )
       )
       (PrinC)
)

XDSoft

最初由 千寻 发布
[B]没有多大用 [/B]

这仅仅是个函数，对你画图肯定是没有太大用了。去看看下面的帖子，是这个函数的一个应用，一个朋友建模时候提出的申请：

http://www.xdcad.net/forum/showthread.php?threadid=14396