采集PL线上各顶点的坐标

zzl9105

如题，哪位有这样的小lisp呀，想学习下，
以及我想判断一个点在不在这个闭合PL线之内，如何判断呀？
或者说我想取一个该闭合线内一点，以供函数使用，这点取点
恭请高手出招，谢谢！


该贴已经同步到 zzl9105的微博

xiaxiang

---

采集PL线上各顶点的坐标

2. ;;;****************************************************
   
3. ;;; 返回多段线(*POLYLINE)的所有顶点坐标  函数  
   
4. ;;;****************************************************
   
5. (defun GetPLineVTX (EntName1 / Obj1 vtx vtxlst PtsList i)
   
6.   (cond
   
7.     ((= (cdr (assoc 0 (entget EntName1))) "LWPOLYLINE")
   
8.      (setq PtsList (ayGetLWPolyLineVTX EntName1))
   
9.     );end_switch
   
10.     ((= (cdr (assoc 0 (entget EntName1))) "POLYLINE")
    
11.      (setq PtsList (ayGetPolyLineVTX EntName1))
    
12.     );end_switch
    
13.   );end_cond
    
14.   (setq PtsList PtsList)
    
15. );end_defun
    
16. 
    
17. ;;;-----------------------------------------------
    
18. ;;; 获取 LWPOLYLINE 对象所有顶点坐标   
    
19. ;;;-----------------------------------------------
    
20. (defun GetLWPolyLineVTX (EntName1 / Obj1 vtx vtxlst PtsList i)
    
21.   (vl-load-com)
    
22.   (setq Obj1 (vlax-ename->vla-object EntName1))
    
23.   (setq vtx (vla-get-Coordinates Obj1))
    
24.   (setq vtxLst (vlax-safearray->list (vlax-variant-value vtx)))
    
25.   (setq i 0)
    
26.   (setq PtsList nil)
    
27.   (repeat (/ (length vtxLst) 2)
    
28.     (setq PtsList (append PtsList (list (list (nth i vtxLst) (nth (1+ i) vtxLst)))))
    
29.     (setq i (+ i 2))
    
30.   );end_repeat
    
31.   (setq PtsList PtsList)
    
32. );end_defun
    
33. 
    
34. ;;;---------------------------------------------
    
35. ;;; 获取 POLYLINE 对象所有顶点坐标   
    
36. ;;;---------------------------------------------
    
37. (Defun GetPolyLineVTX (LwPolyEntName / entData1 entName1 pel ptp wpl wpll plp par ct
    
38.                                        pen rl pn clk pt al gx bj np xc gg rr cp retList)
    
39.   (setq entName1 LwPolyEntName)
    
40.   (setq retList nil)
    
41.   (setq entData1 (entget entName1))
    
42.   (if (= "POLYLINE" (Cdr (Assoc 0 entData1)))
    
43.     (progn
    
44.       (setq pel  entData1             ;取出对象表.
    
45.             ptp  (Cdr (Assoc 70 pel)) ;取出结束片段型.
    
46.             wpl  '()                  ;自建的点位数表.
    
47.             wpll '()
    
48.             entName1 (EntNext entName1)
    
49.             pen entName1
    
50.       );end_setq
    
51.       (While (/= "SEQEND" (Cdr (Assoc 0 (entget pen))));如果没束.
    
52.         (setq pel (entget pen)               ;取得顶点对象数据表.
    
53.               plp (Cdr (Assoc 10 pel))       ;取出控制点点位.
    
54.               par (Cdr (Assoc 42 pel))       ;取出弓弦比.
    
55.               wpl (Cons (List plp par) wpl)  ;将数据加到WPL表中.
    
56.               wpll (cons plp wpll)
    
57.         );end_setq
    
58.         (setq pen (EntNext pen));搜索下一个对象.
    
59.       );end_while
    
60.       (setq wpll (Reverse wpll))
    
61.       (setq ct (If (= 0 (Cadr (Car wpl))) "直线片段封闭" "弧片段封闭"))
    
62.       (setq wpl (Cons (Last wpl) wpl);加入封闭点.
    
63.             wpl (Reverse wpl)        ;整理WPL表.
    
64.             rl (Length wpl)
    
65.             pn 0
    
66.       );end_setq
    
67.       (setq clk (If (Or (= 0 ptp) (= 128 ptp)) "开口" "封闭"))  
    
68.       (Repeat (1- rl)          ;逐点分析.
    
69.         (setq al (Nth pn wpl)  ;取出点数据表.
    
70.               pt (Car al)      ;取出点位.
    
71.         );end_setq
    
72.         (If (And (/= 0.0 (Cadr al)) (Nth pn wpl)) ;如果是断.
    
73.            (Progn (setq gx (Cadr al)               ;取出弓比.
    
74.                        bj (* (ATAN (ABS gx)) 4)   ;计算包角.
    
75.                        np (Car (Nth (1+ pn) wpl)) ;取出下一点位.
    
76.                        xc (* 0.5 (Distance pt np));半弦长计算.
    
77.                        gg (* gx xc)               ;弓高计算.
    
78.                        rr (/ (+ (* xc xc)(* gg gg)) (* 2 gg))
    
79.                   );end_setq  
    
80.                   (setq cp (Polar pt (setq pa (Angle pt np)) xc)  
    
81.                         cp (Polar cp (+ pa (* 0.5 PI)) (- rr gg))
    
82.                   );end_setq
    
83.           );end_progn
    
84.         );end_if
    
85.         (setq pn (1+ pn))
    
86.       );end_repeat
    
87.       
    
88.       (setq retList wpll)
    
89.     );end_progn
    
90.   );end_if
    
91. );end_defun
    

;;;****************************************************<br /> ;;; 返回多段线(*POLYLINE)的所有顶点坐标  函数  <br /> ;;;****************************************************<br /> (defun GetPLineVTX (EntName1 / Obj1 vtx vtxlst PtsList i)<br />   (cond<br />     ((= (cdr (assoc 0 (entget EntName1))) "LWPOLYLINE")<br />      (setq PtsList (ayGetLWPolyLineVTX EntName1))<br />     );end_switch<br />     ((= (cdr (assoc 0 (entget EntName1))) "POLYLINE")<br />      (setq PtsList (ayGetPolyLineVTX EntName1))<br />     );end_switch<br />   );end_cond<br />   (setq PtsList PtsList)<br /> );end_defun<br /> <br /> ;;;-----------------------------------------------<br /> ;;; 获取 LWPOLYLINE 对象所有顶点坐标    <br /> ;;;-----------------------------------------------<br /> (defun GetLWPolyLineVTX (EntName1 / Obj1 vtx vtxlst PtsList i)<br />   (vl-load-com)<br />   (setq Obj1 (vlax-ename->vla-object EntName1))<br />   (setq vtx (vla-get-Coordinates Obj1))<br />   (setq vtxLst (vlax-safearray->list (vlax-variant-value vtx)))<br />   (setq i 0)<br />   (setq PtsList nil)<br />   (repeat (/ (length vtxLst) 2)<br />     (setq PtsList (append PtsList (list (list (nth i vtxLst) (nth (1+ i) vtxLst)))))<br />     (setq i (+ i 2))<br />   );end_repeat<br />   (setq PtsList PtsList)<br /> );end_defun<br /> <br /> ;;;---------------------------------------------<br /> ;;; 获取 POLYLINE 对象所有顶点坐标    <br /> ;;;---------------------------------------------<br /> (Defun GetPolyLineVTX (LwPolyEntName / entData1 entName1 pel ptp wpl wpll plp par ct<br />                                        pen rl pn clk pt al gx bj np xc gg rr cp retList)<br />   (setq entName1 LwPolyEntName)<br />   (setq retList nil)<br />   (setq entData1 (entget entName1))<br />   (if (= "POLYLINE" (Cdr (Assoc 0 entData1)))<br />     (progn<br />       (setq pel  entData1             ;取出对象表.<br />             ptp  (Cdr (Assoc 70 pel)) ;取出结束片段型.<br />             wpl  '()                  ;自建的点位数表.<br />             wpll '()<br />             entName1 (EntNext entName1)<br />             pen entName1<br />       );end_setq<br />       (While (/= "SEQEND" (Cdr (Assoc 0 (entget pen))));如果没束.<br />         (setq pel (entget pen)               ;取得顶点对象数据表.<br />               plp (Cdr (Assoc 10 pel))       ;取出控制点点位.<br />               par (Cdr (Assoc 42 pel))       ;取出弓弦比.<br />               wpl (Cons (List plp par) wpl)  ;将数据加到WPL表中.<br />               wpll (cons plp wpll)<br />         );end_setq <br />         (setq pen (EntNext pen));搜索下一个对象.<br />       );end_while<br />       (setq wpll (Reverse wpll))<br />       (setq ct (If (= 0 (Cadr (Car wpl))) "直线片段封闭" "弧片段封闭")) <br />       (setq wpl (Cons (Last wpl) wpl);加入封闭点.<br />             wpl (Reverse wpl)        ;整理WPL表.<br />             rl (Length wpl) <br />             pn 0 <br />       );end_setq <br />       (setq clk (If (Or (= 0 ptp) (= 128 ptp)) "开口" "封闭"))  <br />       (Repeat (1- rl)          ;逐点分析.<br />         (setq al (Nth pn wpl)  ;取出点数据表.<br />               pt (Car al)      ;取出点位.<br />         );end_setq <br />         (If (And (/= 0.0 (Cadr al)) (Nth pn wpl)) ;如果是断.<br />            (Progn (setq gx (Cadr al)               ;取出弓比.<br />                        bj (* (ATAN (ABS gx)) 4)   ;计算包角.<br />                        np (Car (Nth (1+ pn) wpl)) ;取出下一点位.<br />                        xc (* 0.5 (Distance pt np));半弦长计算.<br />                        gg (* gx xc)               ;弓高计算.<br />                        rr (/ (+ (* xc xc)(* gg gg)) (* 2 gg)) <br />                   );end_setq  <br />                   (setq cp (Polar pt (setq pa (Angle pt np)) xc)  <br />                         cp (Polar cp (+ pa (* 0.5 PI)) (- rr gg)) <br />                   );end_setq <br />           );end_progn <br />         );end_if<br />         (setq pn (1+ pn))<br />       );end_repeat<br />       <br />       (setq retList wpll)<br />     );end_progn<br />   );end_if<br /> );end_defun<br />

判断一个点在不在这个闭合PL线之内

2. 
   
3. ;;;******************************************************************************
   
4. ;;; 判断点是否在多边形内                                    
   
5. ;;;xPt是要判断的点坐标(x y z ), Points是多边形顶点列表((x1 y1 z1) (x2 y2 z2)...)
   
6. ;;;******************************************************************************
   
7. (defun isPtinPM (xPt Points)
   
8. (equal PI (abs (apply '+ (mapcar '(lambda (x y)  (rem (- (angle xPt x) (angle xPt y)) PI))
   
9.                 (reverse (cdr (reverse (cons (last Points) Points)))) Points)))
   
10.         1e-6
    
11. );end_equal
    
12. );end_defun

<br /> ;;;******************************************************************************<br /> ;;; 判断点是否在多边形内                                     <br /> ;;;xPt是要判断的点坐标(x y z ), Points是多边形顶点列表((x1 y1 z1) (x2 y2 z2)...) <br /> ;;;******************************************************************************<br /> (defun isPtinPM (xPt Points) <br /> (equal PI (abs (apply '+ (mapcar '(lambda (x y)  (rem (- (angle xPt x) (angle xPt y)) PI))<br />                 (reverse (cdr (reverse (cons (last Points) Points)))) Points)))<br />         1e-6<br /> );end_equal<br /> );end_defun

zzl9105

xiaxiang 发表于 2011-10-20 14:42

---

采集PL线上各顶点的坐标

非常感谢xiaxiang
命令: (LOAD "F:/LISP加载/练习/采集PL线上各顶点的坐标.lsp") GETPOLYLINEVTX
命令: GETPOLYLINEVTX
未知命令“GETPOLYLINEVTX”。按 F1 查看帮助。
命令: GetLWPolyLineVTX
未知命令“GETLWPOLYLINEVTX”。按 F1 查看帮助。
命令: GetPLineVTX
未知命令“GETPLINEVTX”。按 F1 查看帮助。

怎么都是未知命令，是不是不完全呀？